From c484d01955cc47f78efe984e4ddf81046bd3c5c0 Mon Sep 17 00:00:00 2001 From: Tyler Chan Date: Sun, 4 Oct 2026 18:43:00 +0800 Subject: [PATCH 01/77] 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 02/77] 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 03/77] 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 04/77] 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 05/77] 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 06/77] 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 07/77] 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 08/77] 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 09/77] 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 10/77] 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 11/77] 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 12/77] 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 13/77] 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 14/77] 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 15/77] 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 16/77] 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 17/77] 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 18/77] 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 19/77] 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 20/77] 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 21/77] 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 22/77] 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 23/77] 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 24/77] 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 25/77] 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 26/77] 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 27/77] 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 28/77] 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 29/77] 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 30/77] 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 31/77] 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 32/77] 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 33/77] 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 34/77] 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 35/77] 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 36/77] 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 37/77] 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 38/77] 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 39/77] 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 40/77] 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 41/77] 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 42/77] 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 43/77] 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 44/77] 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 45/77] 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 46/77] 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 47/77] 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 48/77] 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 49/77] 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 50/77] 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 51/77] 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 52/77] 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 53/77] 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 54/77] 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 55/77] 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 56/77] 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 57/77] 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 58/77] 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 59/77] 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 60/77] 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 61/77] 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 62/77] 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 63/77] 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 64/77] 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 65/77] 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 66/77] 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 67/77] 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 68/77] 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 69/77] 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 70/77] 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 71/77] 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 72/77] 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 73/77] 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 74/77] 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 75/77] 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 76/77] 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 77/77] 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" }