polytropos-core (empty) → 0.1.0.2

raw patch · 7 files changed

+3250/−0 lines, 7 filesdep +basedep +polytropos-coredep +primitive

Dependencies added: base, polytropos-core, primitive, tasty, tasty-hunit

Files

• CHANGELOG.md +23/−0
• LICENSE +391/−0
• README.md +56/−0
• polytropos-core.cabal +66/−0
• src/Polytropos.hs +1079/−0
• src/Polytropos/Core.hs +1201/−0
• test/Main.hs +434/−0

@@ -0,0 +1,23 @@+# Changelog for polytropos-core++## 0.1.0.2 — 2026-10-21++- Coordinated release across all 20 Polytropos packages, benchmarks, and examples.+- Comprehensive worked examples added to `polytropos-docrecords` and `polytropos-reader-soup`.+- Inclusion of `polytropos-dhall` package in ecosystem release.++## 0.1.0.1 — 2026-10-20++- Performance optimization: eliminate lingering list conversions in peeling, projection and injection.+- Repertoire expansion: coordinate release with `polytropos-profunctors` and `polytropos-reader-soup`.++## 0.1.0.0 — Initial Release++- Core row vocabulary: `Row`, `SumRow`, `ProductRow`, `Pair((:=))`+- Unified flat runtime representation: `Rep (f :: Type -> Type) a` combining a runtime tag and `SmallArray` payload+- First-class evidence classes: `FieldIndex`, `ConstructorIndex`, `RowEq`, `RowShow`, `RowEqSum`, `RowShowSum`, `AllFields`+- Primitive operations: `emptyRecord`, `insertField`, `getField`, `setField`, `injectVariant`, `matchVariant`, `projectRecord`, `restrictRecord`+- Hybrid monadic and pure eliminators with $O(1)$ jump table dispatch: `eliminateUniform`, `eliminateUniformM`, `eliminate`, `eliminateM`, `peel`, `peelF`+- Higher-Kinded Data support: `RecordF`, `VariantF`+- SIMD and unrolled copy operations for record updates+- Re-exported front-door module `Polytropos`

@@ -0,0 +1,391 @@+Polytropos Dual Licensing++Copyright (c) 2026, Nadia Yvette Chambers <nadia.yvette.chambers@ik.me>+All rights reserved.++SPDX-License-Identifier: EUPL-1.2 OR Apache-2.0++Polytropos is dual-licensed: you may use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the software under the terms+of EITHER:++1. The European Union Public Licence, version 1.2 (EUPL-1.2), as published by+   the European Commission (available in 23 authentic language versions); OR+2. The Apache License, Version 2.0 (Apache-2.0).++You may choose whichever license best fits your requirements and compliance+environment.++Individual license files are available in the LICENSES/ directory:+- LICENSES/EUPL-1.2.txt+- LICENSES/Apache-2.0.txt++================================================================================+1. European Union Public Licence v. 1.2 (EUPL-1.2)+================================================================================++                      EUROPEAN UNION PUBLIC LICENCE v. 1.2+                      EUPL © the European Union 2007, 2016++This European Union Public Licence (the ‘EUPL’) applies to the Work (as defined+below) which is provided under the terms of this Licence. Any use of the Work,+other than as authorised under this Licence is prohibited (to the extent such+use is covered by a right of the copyright holder of the Work).++The Work is provided under the terms of this Licence when the Licensor (as+defined below) has placed the following notice immediately following the+copyright notice for the Work:++        Licensed under the EUPL++or has expressed by any other means his willingness to license under the EUPL.++1. Definitions++In this Licence, the following terms have the following meaning:++- ‘The Licence’: this Licence.++- ‘The Original Work’: the work or software distributed or communicated by the+  Licensor under this Licence, available as Source Code and also as Executable+  Code as the case may be.++- ‘Derivative Works’: the works or software that could be created by the+  Licensee, based upon the Original Work or modifications thereof. This Licence+  does not define the extent of modification or dependence on the Original Work+  required in order to classify a work as a Derivative Work; this extent is+  determined by copyright law applicable in the country mentioned in Article 15.++- ‘The Work’: the Original Work or its Derivative Works.++- ‘The Source Code’: the human-readable form of the Work which is the most+  convenient for people to study and modify.++- ‘The Executable Code’: any code which has generally been compiled and which is+  meant to be interpreted by a computer as a program.++- ‘The Licensor’: the natural or legal person that distributes or communicates+  the Work under the Licence.++- ‘Contributor(s)’: any natural or legal person who modifies the Work under the+  Licence, or otherwise contributes to the creation of a Derivative Work.++- ‘The Licensee’ or ‘You’: any natural or legal person who makes any usage of+  the Work under the terms of the Licence.++- ‘Distribution’ or ‘Communication’: any act of selling, giving, lending,+  renting, distributing, communicating, transmitting, or otherwise making+  available, online or offline, copies of the Work or providing access to its+  essential functionalities at the disposal of any other natural or legal+  person.++2. Scope of the rights granted by the Licence++The Licensor hereby grants You a worldwide, royalty-free, non-exclusive,+sublicensable licence to do the following, for the duration of copyright vested+in the Original Work:++- use the Work in any circumstance and for all usage,+- reproduce the Work,+- modify the Work, and make Derivative Works based upon the Work,+- communicate to the public, including the right to make available or display+  the Work or copies thereof to the public and perform publicly, as the case may+  be, the Work,+- distribute the Work or copies thereof,+- lend and rent the Work or copies thereof,+- sublicense rights in the Work or copies thereof.++Those rights can be exercised on any media, supports and formats, whether now+known or later invented, as far as the applicable law permits so.++In the countries where moral rights apply, the Licensor waives his right to+exercise his moral right to the extent allowed by law in order to make effective+the licence of the economic rights here above listed.++The Licensor grants to the Licensee royalty-free, non-exclusive usage rights to+any patents held by the Licensor, to the extent necessary to make use of the+rights granted on the Work under this Licence.++3. Communication of the Source Code++The Licensor may provide the Work either in its Source Code form, or as+Executable Code. If the Work is provided as Executable Code, the Licensor+provides in addition a machine-readable copy of the Source Code of the Work+along with each copy of the Work that the Licensor distributes or indicates, in+a notice following the copyright notice attached to the Work, a repository where+the Source Code is easily and freely accessible for as long as the Licensor+continues to distribute or communicate the Work.++4. Limitations on copyright++Nothing in this Licence is intended to deprive the Licensee of the benefits from+any exception or limitation to the exclusive rights of the rights owners in the+Work, of the exhaustion of those rights or of other applicable limitations+thereto.++5. Obligations of the Licensee++The grant of the rights mentioned above is subject to some restrictions and+obligations imposed on the Licensee. Those obligations are the following:++Attribution right: The Licensee shall keep intact all copyright, patent or+trademarks notices and all notices that refer to the Licence and to the+disclaimer of warranties. The Licensee must include a copy of such notices and a+copy of the Licence with every copy of the Work he/she distributes or+communicates. The Licensee must cause any Derivative Work to carry prominent+notices stating that the Work has been modified and the date of modification.++Copyleft clause: If the Licensee distributes or communicates copies of the+Original Works or Derivative Works, this Distribution or Communication will be+done under the terms of this Licence or of a later version of this Licence+unless the Original Work is expressly distributed only under this version of the+Licence — for example by communicating ‘EUPL v. 1.2 only’. The Licensee+(becoming Licensor) cannot offer or impose any additional terms or conditions on+the Work or Derivative Work that alter or restrict the terms of the Licence.++Compatibility clause: If the Licensee Distributes or Communicates Derivative+Works or copies thereof based upon both the Work and another work licensed under+a Compatible Licence, this Distribution or Communication can be done under the+terms of this Compatible Licence. For the sake of this clause, ‘Compatible+Licence’ refers to the licences listed in the appendix attached to this Licence.+Should the Licensee's obligations under the Compatible Licence conflict with+his/her obligations under this Licence, the obligations of the Compatible+Licence shall prevail.++Provision of Source Code: When distributing or communicating copies of the Work,+the Licensee will provide a machine-readable copy of the Source Code or indicate+a repository where this Source will be easily and freely available for as long+as the Licensee continues to distribute or communicate the Work.++Legal Protection: This Licence does not grant permission to use the trade names,+trademarks, service marks, or names of the Licensor, except as required for+reasonable and customary use in describing the origin of the Work and+reproducing the content of the copyright notice.++6. Chain of Authorship++The original Licensor warrants that the copyright in the Original Work granted+hereunder is owned by him/her or licensed to him/her and that he/she has the+power and authority to grant the Licence.++Each Contributor warrants that the copyright in the modifications he/she brings+to the Work are owned by him/her or licensed to him/her and that he/she has the+power and authority to grant the Licence.++Each time You accept the Licence, the original Licensor and subsequent+Contributors grant You a licence to their contributions to the Work, under the+terms of this Licence.++7. Disclaimer of Warranty++The Work is a work in progress, which is continuously improved by numerous+Contributors. It is not a finished work and may therefore contain defects or+‘bugs’ inherent to this type of development.++For the above reason, the Work is provided under the Licence on an ‘as is’ basis+and without warranties of any kind concerning the Work, including without+limitation merchantability, fitness for a particular purpose, absence of defects+or errors, accuracy, non-infringement of intellectual property rights other than+copyright as stated in Article 6 of this Licence.++This disclaimer of warranty is an essential part of the Licence and a condition+for the grant of any rights to the Work.++8. Disclaimer of Liability++Except in the cases of wilful misconduct or damages directly caused to natural+persons, the Licensor will in no event be liable for any direct or indirect,+material or moral, damages of any kind, arising out of the Licence or of the use+of the Work, including without limitation, damages for loss of goodwill, work+stoppage, computer failure or malfunction, loss of data or any commercial+damage, even if the Licensor has been advised of the possibility of such damage.+However, the Licensor will be liable under statutory product liability laws as+far such laws apply to the Work.++9. Additional agreements++While distributing the Work, You may choose to conclude an additional agreement,+defining obligations or services consistent with this Licence. However, if+accepting obligations, You may act only on your own behalf and on your sole+responsibility, not on behalf of the original Licensor or any other Contributor,+and only if You agree to indemnify, defend, and hold each Contributor harmless+for any liability incurred by, or claims asserted against such Contributor by+the fact You have accepted any warranty or additional liability.++10. Acceptance of the Licence++The provisions of this Licence can be accepted by clicking on an icon ‘I agree’+placed under the bottom of a window displaying the text of this Licence or by+affirming consent in any other similar way, in accordance with the rules of+applicable law. Clicking on that icon indicates your clear and irrevocable+acceptance of this Licence and all of its terms and conditions.++Similarly, you irrevocably accept this Licence and all of its terms and+conditions by exercising any rights granted to You by Article 2 of this Licence,+such as the use of the Work, the creation by You of a Derivative Work or the+Distribution or Communication by You of the Work or copies thereof.++11. Information to the public++In case of any Distribution or Communication of the Work by means of electronic+communication by You (for example, by offering to download the Work from a+remote location) the distribution channel or media (for example, a website) must+at least provide to the public the information requested by the applicable law+regarding the Licensor, the Licence and the way it may be accessible, concluded,+stored and reproduced by the Licensee.++12. Termination of the Licence++The Licence and the rights granted hereunder will terminate automatically upon+any breach by the Licensee of the terms of the Licence.++Such a termination will not terminate the licences of any person who has+received the Work from the Licensee under the Licence, provided such persons+remain in full compliance with the Licence.++13. Miscellaneous++Without prejudice of Article 9 above, the Licence represents the complete+agreement between the Parties as to the Work.++If any provision of the Licence is invalid or unenforceable under applicable+law, this will not affect the validity or enforceability of the Licence as a+whole. Such provision will be construed or reformed so as necessary to make it+valid and enforceable.++The European Commission may publish other linguistic versions or new versions of+this Licence or updated versions of the Appendix, so far this is required and+reasonable, without reducing the scope of the rights granted by the Licence. New+versions of the Licence will be published with a unique version number.++All linguistic versions of this Licence, approved by the European Commission,+have identical value. Parties can take advantage of the linguistic version of+their choice.++14. Jurisdiction++Without prejudice to specific agreement between parties,++- any litigation resulting from the interpretation of this License, arising+  between the European Union institutions, bodies, offices or agencies, as a+  Licensor, and any Licensee, will be subject to the jurisdiction of the Court+  of Justice of the European Union, as laid down in article 272 of the Treaty on+  the Functioning of the European Union,++- any litigation arising between other parties and resulting from the+  interpretation of this License, will be subject to the exclusive jurisdiction+  of the competent court where the Licensor resides or conducts its primary+  business.++15. Applicable Law++Without prejudice to specific agreement between parties,++- this Licence shall be governed by the law of the European Union Member State+  where the Licensor has his seat, resides or has his registered office,++- this licence shall be governed by Belgian law if the Licensor has no seat,+  residence or registered office inside a European Union Member State.++Appendix++‘Compatible Licences’ according to Article 5 EUPL are:++- GNU General Public License (GPL) v. 2, v. 3+- GNU Affero General Public License (AGPL) v. 3+- Open Software License (OSL) v. 2.1, v. 3.0+- Eclipse Public License (EPL) v. 1.0+- CeCILL v. 2.0, v. 2.1+- Mozilla Public Licence (MPL) v. 2+- GNU Lesser General Public Licence (LGPL) v. 2.1, v. 3+- Creative Commons Attribution-ShareAlike v. 3.0 Unported (CC BY-SA 3.0) for+  works other than software+- European Union Public Licence (EUPL) v. 1.1, v. 1.2+- Québec Free and Open-Source Licence — Reciprocity (LiLiQ-R) or Strong+  Reciprocity (LiLiQ-R+).++The European Commission may update this Appendix to later versions of the above+licences without producing a new version of the EUPL, as long as they provide+the rights granted in Article 2 of this Licence and protect the covered Source+Code from exclusive appropriation.++All other changes or additions to this Appendix require the production of a new+EUPL version.++================================================================================+2. Apache License, Version 2.0 (Apache-2.0)+================================================================================++Apache License+Version 2.0, January 2004+http://www.apache.org/licenses/++TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION++1. Definitions.++"License" shall mean the terms and conditions for use, reproduction, and distribution as defined by Sections 1 through 9 of this document.++"Licensor" shall mean the copyright owner or entity authorized by the copyright owner that is granting the License.++"Legal Entity" shall mean the union of the acting entity and all other entities that control, are controlled by, or are under common control with that entity. For the purposes of this definition, "control" means (i) the power, direct or indirect, to cause the direction or management of such entity, whether by contract or otherwise, or (ii) ownership of fifty percent (50%) or more of the outstanding shares, or (iii) beneficial ownership of such entity.++"You" (or "Your") shall mean an individual or Legal Entity exercising permissions granted by this License.++"Source" form shall mean the preferred form for making modifications, including but not limited to software source code, documentation source, and configuration files.++"Object" form shall mean any form resulting from mechanical transformation or translation of a Source form, including but not limited to compiled object code, generated documentation, and conversions to other media types.++"Work" shall mean the work of authorship, whether in Source or Object form, made available under the License, as indicated by a copyright notice that is included in or attached to the work (an example is provided in the Appendix below).++"Derivative Works" shall mean any work, whether in Source or Object form, that is based on (or derived from) the Work and for which the editorial revisions, annotations, elaborations, or other modifications represent, as a whole, an original work of authorship. For the purposes of this License, Derivative Works shall not include works that remain separable from, or merely link (or bind by name) to the interfaces of, the Work and Derivative Works thereof.++"Contribution" shall mean any work of authorship, including the original version of the Work and any modifications or additions to that Work or Derivative Works thereof, that is intentionally submitted to Licensor for inclusion in the Work by the copyright owner or by an individual or Legal Entity authorized to submit on behalf of the copyright owner. For the purposes of this definition, "submitted" means any form of electronic, verbal, or written communication sent to the Licensor or its representatives, including but not limited to communication on electronic mailing lists, source code control systems, and issue tracking systems that are managed by, or on behalf of, the Licensor for the purpose of discussing and improving the Work, but excluding communication that is conspicuously marked or otherwise designated in writing by the copyright owner as "Not a Contribution."++"Contributor" shall mean Licensor and any individual or Legal Entity on behalf of whom a Contribution has been received by Licensor and subsequently incorporated within the Work.++2. Grant of Copyright License. Subject to the terms and conditions of this License, each Contributor hereby grants to You a perpetual, worldwide, non-exclusive, no-charge, royalty-free, irrevocable copyright license to reproduce, prepare Derivative Works of, publicly display, publicly perform, sublicense, and distribute the Work and such Derivative Works in Source or Object form.++3. Grant of Patent License. Subject to the terms and conditions of this License, each Contributor hereby grants to You a perpetual, worldwide, non-exclusive, no-charge, royalty-free, irrevocable (except as stated in this section) patent license to make, have made, use, offer to sell, sell, import, and otherwise transfer the Work, where such license applies only to those patent claims licensable by such Contributor that are necessarily infringed by their Contribution(s) alone or by combination of their Contribution(s) with the Work to which such Contribution(s) was submitted. If You institute patent litigation against any entity (including a cross-claim or counterclaim in a lawsuit) alleging that the Work or a Contribution incorporated within the Work constitutes direct or contributory patent infringement, then any patent licenses granted to You under this License for that Work shall terminate as of the date such litigation is filed.++4. Redistribution. You may reproduce and distribute copies of the Work or Derivative Works thereof in any medium, with or without modifications, and in Source or Object form, provided that You meet the following conditions:++     (a) You must give any other recipients of the Work or Derivative Works a copy of this License; and++     (b) You must cause any modified files to carry prominent notices stating that You changed the files; and++     (c) You must retain, in the Source form of any Derivative Works that You distribute, all copyright, patent, trademark, and attribution notices from the Source form of the Work, excluding those notices that do not pertain to any part of the Derivative Works; and++     (d) If the Work includes a "NOTICE" text file as part of its distribution, then any Derivative Works that You distribute must include a readable copy of the attribution notices contained within such NOTICE file, excluding those notices that do not pertain to any part of the Derivative Works, in at least one of the following places: within a NOTICE text file distributed as part of the Derivative Works; within the Source form or documentation, if provided along with the Derivative Works; or, within a display generated by the Derivative Works, if and wherever such third-party notices normally appear. The contents of the NOTICE file are for informational purposes only and do not modify the License. You may add Your own attribution notices within Derivative Works that You distribute, alongside or as an addendum to the NOTICE text from the Work, provided that such additional attribution notices cannot be construed as modifying the License.++     You may add Your own copyright statement to Your modifications and may provide additional or different license terms and conditions for use, reproduction, or distribution of Your modifications, or for any such Derivative Works as a whole, provided Your use, reproduction, and distribution of the Work otherwise complies with the conditions stated in this License.++5. Submission of Contributions. Unless You explicitly state otherwise, any Contribution intentionally submitted for inclusion in the Work by You to the Licensor shall be under the terms and conditions of this License, without any additional terms or conditions. Notwithstanding the above, nothing herein shall supersede or modify the terms of any separate license agreement you may have executed with Licensor regarding such Contributions.++6. Trademarks. This License does not grant permission to use the trade names, trademarks, service marks, or product names of the Licensor, except as required for reasonable and customary use in describing the origin of the Work and reproducing the content of the NOTICE file.++7. Disclaimer of Warranty. Unless required by applicable law or agreed to in writing, Licensor provides the Work (and each Contributor provides its Contributions) on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied, including, without limitation, any warranties or conditions of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A PARTICULAR PURPOSE. You are solely responsible for determining the appropriateness of using or redistributing the Work and assume any risks associated with Your exercise of permissions under this License.++8. Limitation of Liability. In no event and under no legal theory, whether in tort (including negligence), contract, or otherwise, unless required by applicable law (such as deliberate and grossly negligent acts) or agreed to in writing, shall any Contributor be liable to You for damages, including any direct, indirect, special, incidental, or consequential damages of any character arising as a result of this License or out of the use or inability to use the Work (including but not limited to damages for loss of goodwill, work stoppage, computer failure or malfunction, or any and all other commercial damages or losses), even if such Contributor has been advised of the possibility of such damages.++9. Accepting Warranty or Additional Liability. While redistributing the Work or Derivative Works thereof, You may choose to offer, and charge a fee for, acceptance of support, warranty, indemnity, or other liability obligations and/or rights consistent with this License. However, in accepting such obligations, You may act only on Your own behalf and on Your sole responsibility, not on behalf of any other Contributor, and only if You agree to indemnify, defend, and hold each Contributor harmless for any liability incurred by, or claims asserted against, such Contributor by reason of your accepting any such warranty or additional liability.++END OF TERMS AND CONDITIONS++APPENDIX: How to apply the Apache License to your work.++To apply the Apache License to your work, attach the following boilerplate notice, with the fields enclosed by brackets "[]" replaced with your own identifying information. (Don't include the brackets!)  The text should be enclosed in the appropriate comment syntax for the file format. We also recommend that a file or class name and description of purpose be included on the same "printed page" as the copyright notice for easier identification within third-party archives.++Copyright [yyyy] [name of copyright owner]++Licensed under the Apache License, Version 2.0 (the "License");+you may not use this file except in compliance with the License.+You may obtain a copy of the License at++http://www.apache.org/licenses/LICENSE-2.0++Unless required by applicable law or agreed to in writing, software+distributed under the License is distributed on an "AS IS" BASIS,+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+See the License for the specific language governing permissions and+limitations under the License.

@@ -0,0 +1,56 @@+# polytropos-core++Row-polymorphic / open algebraic data types (ADTs) and high-performance matching generics for Haskell.++`polytropos-core` collapses the four quadrants of nominal vs. structural products and sums into a single generic runtime representation (`Rep`: an unpacked tag plus a flat `SmallArray` of payload slots). Moving between nominal and structural data becomes an erased choice at the type level rather than an impedance mismatch at runtime.++## Key Features++- **Unified Flat Representation**: A single representation for records and variants (`Rep`) backed by contiguous primitive arrays.+- **$O(1)$ Field Access and Update**: Literal slot indexing without runtime inductive dictionary walks or pointer chasing.+- **Pattern Matching & Hybrid Eliminators**: Zero-overhead variant elimination (`eliminateUniform`, `eliminateUniformM`, `eliminate`, `peel`) executing through unrolled jump tables.+- **Higher-Kinded Data (HKD)**: Native support for functor-wrapped records (`RecordF f r`) and variants (`VariantF f r`).+- **Ergonomic Front Door**: Re-exports convenient record syntax, pattern synonyms, and lens-friendly helpers in `Polytropos`.++## Quick Example++```haskell+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE OverloadedRecordDot #-}+{-# OPTIONS_GHC -fplugin=Polytropos.Plugin #-}++import Polytropos++type UserRow = '[ "id" := Int, "name" := String, "active" := Bool ]+type User = Record UserRow++-- 1. Construction without ($) grouping:+alice :: User+alice = REC { id = 42, name = "Alice", active = True }++-- 2. Direct field access via record dot syntax:+userId :: Int+userId = alice.id++-- 3. Functional record update without parentheses:+alicePromoted :: User+alicePromoted = REC_UPD alice { active = False }++-- 4. Passing record expressions without ($):+describeUser :: User -> String+describeUser u = u.name ++ " (ID: " ++ show u.id ++ ")"++summary :: String+summary = describeUser REC { id = 101, name = "Bob", active = True }+```++## Documentation & Repository++- **Main Repository**: [https://github.com/NadiaYvette/polytropos](https://github.com/NadiaYvette/polytropos)+- **Design Specification**: [POLYTROPOS_DESIGN.md](https://github.com/NadiaYvette/polytropos/blob/master/docs/notes/POLYTROPOS_DESIGN.md)+- **Tutorial**: [TUTORIAL.md](https://github.com/NadiaYvette/polytropos/blob/master/docs/TUTORIAL.md)++## License++Dual-licensed under the **European Union Public Licence v1.2** (`EUPL-1.2`) OR the **Apache License, Version 2.0** (`Apache-2.0`).

@@ -0,0 +1,66 @@+cabal-version:      3.0+name:               polytropos-core+version: 0.1.0.2+synopsis:           Row-polymorphic / open ADTs: rows, generic representation, evidence+description:+  Core engine and consumer surface of <https://hackage.haskell.org/package/polytropos polytropos>:+  row-polymorphic extensible records and variants for Haskell.++  The package collapses the four quadrants of the design space (nominal products,+  structural products, nominal sums, and structural sums) into one uniform generic+  representation ('Polytropos.Core.Rep'): a runtime integer tag plus a contiguous, flat+  'Data.Primitive.SmallArray.SmallArray' of payload slots.++  For application development and daily usage, start at the front door module+  "Polytropos", which exposes ergonomic constructors, pattern synonyms, and+  worked examples. For compiler plugins and low-level substrate primitives, see+  "Polytropos.Core".++  For design decisions, memory physics, and background on the OCaml polymorphic variant+  heritage, see <https://github.com/NadiaYvette/polytropos/blob/master/docs/notes/POLYTROPOS_DESIGN.md POLYTROPOS_DESIGN.md>.++license:            EUPL-1.2 OR Apache-2.0+license-file:       LICENSE+author:             Nadia Yvette Chambers+maintainer:         nadia.yvette.chambers@ik.me+category:           Data+homepage:           https://github.com/NadiaYvette/polytropos+bug-reports:        https://github.com/NadiaYvette/polytropos/issues+extra-doc-files:    README.md+                  , CHANGELOG.md++source-repository head+  type:     git+  location: https://github.com/NadiaYvette/polytropos+  subdir:   packages/polytropos-core++common warnings+  ghc-options:+      -Wall+      -Wcompat+      -Widentities+      -Wincomplete-record-updates+      -Wincomplete-uni-patterns+      -Wredundant-constraints+      -Wunused-packages++library+  import:           warnings+  exposed-modules:  Polytropos+                  , Polytropos.Core+  hs-source-dirs:   src+  default-language: GHC2021+  build-depends:    base       >= 4.18 && < 4.23+                  , primitive  >= 0.9  && < 0.10++test-suite polytropos-core-test+  import:           warnings+  type:             exitcode-stdio-1.0+  main-is:          Main.hs+  hs-source-dirs:   test+  default-language: GHC2021+  build-depends:    base+                  , polytropos-core+                  , primitive+                  , tasty         >= 1.4  && < 1.6+                  , tasty-hunit   >= 0.10 && < 0.11

@@ -0,0 +1,1079 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE Trustworthy #-}++{-|+Module      : Polytropos+Description : High-level consumer-facing API for Polytropos open records and variants+Copyright   : (c) 2026 The Polytropos Authors+License     : EUPL-1.2 OR Apache-2.0+Maintainer  : nadia.yvette.chambers@ik.me+Stability   : experimental+Portability : non-portable (GHC extensions)++High-level, consumer-facing API for @polytropos@: row-polymorphic open records+and open variants for Haskell.++This module is the primary entry point for application developers and library+authors. It encapsulates low-level representation primitives (such as+'Data.Primitive.SmallArray.SmallArray' and @t'Polytropos.Core.Rep'@) behind ergonomic,+human-friendly type aliases, constructors, and pattern synonyms.++= Architectural Overview & Rationale++== Conceptual Primer: What Are Row-Polymorphic Open ADTs?++For developers without a background in type theory, the terminology can seem daunting.+In practice, it directly solves the rigidity of traditional data types:++1. __Algebraic Data Types (ADTs):__ The two universal building blocks of typed data—/Product types/+   (structs/records where data has field A /and/ field B) and /Sum types/ (enums/variants where data is+   constructor A /or/ constructor B).+2. __Closed vs. Open:__ Traditional Haskell data types are /closed/—declared once with a fixed set+   of fields or constructors. Adding a field (like an authentication token to a @User@) or adding+   a variant branch (like a new AST error node) requires defining a brand-new type and writing+   tedious conversion boilerplate. /Open/ types can be constructed, extended, and narrowed on the fly+   without intermediate wrapper types.+3. __Row Polymorphism:__ A "row" is an unordered collection of named fields (like database columns).+   /Row polymorphism/ allows writing functions that operate on /any/ record containing at least+   certain fields (or any variant handling at least certain cases), while the compiler statically tracks+   and preserves all the /other/ remaining fields (@r@). Unlike OOP inheritance, no fields are sliced or+   erased, and no runtime downcasts are needed.+4. __The Polytropos Difference:__ Historically, row polymorphism in Haskell was either painfully slow+   to compile (quadratic \(O(N^{2.8})\) typeclass search) or memory-inefficient (nested @Either@ pointer+   trees). @polytropos@ solves this by collapsing products and sums into a __single flat runtime representation__+   (a tag plus a contiguous 'Data.Primitive.SmallArray.SmallArray') and using a GHC typechecker plugin+   (@polytropos-plugin@) to resolve field indices into literal numbers at compile time in \(O(1)\).++== The Four-Quadrant Design Space Collapse++Traditional Haskell architectures treat records (products) and variants (sums)+as entirely distinct mechanisms, further bifurcated into nominal and structural+approaches:++1. Nominal Products: Standard Haskell @data@ records (e.g. @data Person = Person { name :: String, age :: Int }@)+2. Structural Products: Anonymous extensible records (e.g. @Record '["name" ':= String, "age" ':= Int]@)+3. Nominal Sums: Multi-constructor ADTs (e.g. @data Shape = Circle Double | Rectangle Double Double@)+4. Structural Sums: Extensible variants (e.g. @Variant '["Circle" ':= '["radius" ':= Double], ...]@)++@polytropos@ collapses all four quadrants into __one uniform generic representation__:+a runtime integer tag plus a contiguous, flat 'Data.Primitive.SmallArray.SmallArray' of+payload slots (@t'Polytropos.Core.Rep'@). For a product, the tag is always @0@ and known+statically. For a sum, the tag is the constructor index.++== Heritage & Precedent++The row typing discipline in @polytropos@ draws inspiration from OCaml's polymorphic+variants and extensible rows (Garrigue 1998), adapted to modern GHC with first-class+type-level symbol labels (@":="@).++== The Typechecker Plugin++Rather than paying for \(O(N)\) or \(O(N^2)\) type-level search at compile time or+traversing binary trees at runtime, @polytropos@ delegates evidence resolution to+@polytropos-plugin@. The plugin computes literal zero-based slot indices, tags, and+dictionary vectors directly in Core AST during compilation, giving \(O(1)\) runtime+indexing with zero runtime overhead.++= When to Use This Module++* Use this module (@Polytropos@) for almost all daily programming with extensible+  records, open sums, effect carrier types, and dynamic configuration schemas.+* Use satellite packages for domain-specific integrations:+  * "Polytropos.Generics": whole-data structural equality, comparisons, and generic map/fold+  * "Polytropos.Optics", "Polytropos.Lens", or "Polytropos.Microlens": optics and labels+  * "Polytropos.Aeson": JSON serialization+  * "Polytropos.CBOR": binary CBOR serialization+  * "Polytropos.Cassava": CSV serialization+  * "Polytropos.QuickCheck": property test generators and shrinkers+  * "Polytropos.Hasql", "Polytropos.Rel8", "Polytropos.Beam", "Polytropos.Persistent": database storage++= When Not to Use This Module++* Do not use this module if you are developing custom typechecker plugins, primitive+  runtime memory layouts, or low-level Core synthesizers; import "Polytropos.Core" instead.++= Relationship to Ecosystem Prior Art++@polytropos@ builds upon extensive historical explorations of extensible records,+anonymous products, and open variants in Haskell:++* __@vinyl@__: Pioneered type-level list indexing for extensible records and universes,+  proving the value of structural data while wrestling with superlinear compile-time+  scaling (\(O(N^{2.8})\)) and deeply abstract type machinery.+* __@superrecord@__: Introduced compile-time field offset computation and compact array+  representations, demonstrating the performance benefits of avoiding nested pointer trees.+* __@row-types@__: Established a formal row calculus based on Leijen's work with first-class+  type equality, though encountering stuck type families during type inference failure.+* __@extensible@__: Offered a comprehensive framework unifying records, variants, and effects+  under custom type-level combinators.+* __@open-adt@ & @world-peace@__: Explored open coproducts and tagged variant unions (@OpenUnion@),+  aiming to avoid nested @Either@ trees.++@polytropos@ acknowledges these libraries as valuable predecessors striving toward similar goals.+It advances their work by collapsing products and sums into a single flat representation+('Data.Primitive.SmallArray.SmallArray' with an unboxed tag) and delegating all symbol-to-slot+resolution to a dedicated GHC typechecker plugin (@polytropos-plugin@), achieving \(O(1)\) runtime+indexing, linear \(O(N)\) compile times, and human-readable compiler error diagnostics.++= Worked Examples++== 1. Open Records (Structural Products)++With the @polytropos-plugin@ enabled in your project, open records are constructed,+accessed, and functionally updated using native record syntax desugared at compile time:++> {-# LANGUAGE DataKinds #-}+> {-# LANGUAGE OverloadedRecordDot #-}+>+> import Polytropos+>+> -- 1a. Idiomatic construction using REC syntax:+> myRec :: Record '["x" ':= Int, "y" ':= Bool]+> myRec = REC { x = 10, y = True }+>+> -- 1b. Reading fields via OverloadedRecordDot (or getField):+> valX :: Int+> valX = myRec.x  -- 10+>+> -- 1c. Functional record update using REC_UPD (or setField):+> myRec' :: Record '["x" ':= Int, "y" ':= Bool]+> myRec' = REC_UPD myRec { x = 42 }+>+> -- 1d. Record pattern matching with field punning:+> formatRec :: Record '["x" ':= Int, "y" ':= Bool] -> String+> formatRec (REC { x, y }) = "x=" ++ show x ++ ", y=" ++ show y+>+> -- 1e. Underlying combinator fallback (usable without plugins):+> myRecFallback :: Record '["x" ':= Int, "y" ':= Bool]+> myRecFallback = insertField (Field @"x") (10 :: Int)+>               $ insertField (Field @"y") True+>               $ emptyRecord++== 2. Open Variants (Structural Sums)++Extensible variants represent open coproducts and are injected and pattern matched+using idiomatic v'VAR' syntax:++> {-# LANGUAGE DataKinds #-}+>+> import Polytropos+>+> type Event = Variant '["Click" ':= '["x" ':= Int, "y" ':= Int], "Quit" ':= '[]]+>+> -- 2a. Injecting into an open variant using VAR syntax:+> clickEvent :: Event+> clickEvent = VAR { Click = REC { x = 100, y = 200 } }+>+> quitEvent :: Event+> quitEvent = VAR { Quit = emptyRecord }+>+> -- 2b. Pattern matching with VAR view patterns:+> handleEvent :: Event -> String+> handleEvent (VAR { Click = REC { x, y } }) =+>   "Clicked at: " ++ show x ++ "," ++ show y+> handleEvent (VAR { Quit = _ }) =+>   "Exiting application"+>+> -- 2c. Underlying combinator fallback:+> clickEventFallback :: Event+> clickEventFallback = injectVariant (Field @"Click") (insertField (Field @"x") 100 (insertField (Field @"y") 200 emptyRecord))++== 3. Higher-Kinded Records (HKD)++Polytropos provides first-class support for functorial / Higher-Kinded Data rows,+where every field type @a@ is parameterized by an outer type constructor @f a@+(e.g. 'Maybe' for partial forms or 'Identity' for validated domain entities):++> {-# LANGUAGE DataKinds #-}+>+> import Polytropos+>+> type PartialConfig = RecordF Maybe '["host" ':= String, "port" ':= Int]+>+> -- 3a. Constructing HKD records using REC_F:+> configTemplate :: PartialConfig+> configTemplate = REC_F { host = Just "localhost", port = Nothing }+>+> -- 3b. Functional updates on HKD records using REC_UPD_F:+> activeConfig :: PartialConfig+> activeConfig = REC_UPD_F configTemplate { port = Just 8080 }+>+> -- 3c. Underlying HKD combinator fallback:+> configFallback :: PartialConfig+> configFallback = insertFieldF (Field @"host") (Just "localhost")+>                $ insertFieldF (Field @"port") Nothing+>                $ emptyRecordF+-}+module Polytropos+  ( -- * Ergonomic Types & Patterns+    type Record+  , type RecordF+  , type Variant+  , type VariantF+    -- * Row Vocabulary & Types+  , type Row+  , type SumRow+  , type ProductRow+#if __GLASGOW_HASKELL__ >= 914+  , data Variant+  , data VariantF+#else+  , pattern Variant+  , pattern VariantF+#endif+    -- * Construction+  , emptyRecord+  , emptyRecordF+  , insertField+  , insertFieldF+  , injectVariant+  , injectVariantF+  , projectVariant+  , projectVariantF+  , type ConstructorPayload+  , type ConstructorPayloadHKD+    -- * Sub-row & Sub-variant operations+  , SubRow(..)+  , SubSum(..)+  , projectRecord+  , projectRecordF+  , widenVariant+  , widenVariantF+  , narrowVariant+  , narrowVariantF+    -- * Elimination & Peeling+  , peel+  , peelF+  , type Delete+  , type HandlerRecordRow+  , type HandlerRecordRowM+  , type HandlerRecordRowHetero+  , type HandlerRecordRowHeteroM+  , eliminateUniform+  , eliminateUniformM+  , eliminate+  , eliminateM+  , matchVariant+    -- * Re-exports+  , Pair(..)+  , HasField(..)+  , RowEq(..)+  , RowShow(..)+  , RowFlavour(..)+  , Field(..)+  , AllFields(..)+  , DictAllFields+  , FieldNames+  , SimpleFieldTypes+  , FieldTypes+    -- * Label Hashing+  , KnownHash(..)+  , labelHash+  , hashVal+  , fnv1a64+    -- * Syntactic Devices (Source Plugin)+  , REC(..)+  , REC_F(..)+  , VAR(..)+  , type VARIANT+#if __GLASGOW_HASKELL__ >= 914+  , data VARIANT+#else+  , pattern VARIANT+#endif+  , REC_UPD(..)+  , REC_UPD_F(..)+  , OpenRecord+  , OpenVariant+  , recordField+  , setField+  , setFieldF+    -- * Generic Row Operations (§1.7)+  , cmapRecord+  , cfoldMapRecord+  , czipWithRecord+  , cmapRecordF+  , cfoldMapRecordF+  ) where++import Polytropos.Core+import Data.Functor.Identity (Identity(..))+import Data.Kind (Type)+import Data.Primitive.SmallArray (copySmallArray, indexSmallArray, newSmallArray, runSmallArray, sizeofSmallArray, thawSmallArray, writeSmallArray)+import GHC.Exts (Any)+import GHC.Records (HasField(..))+import GHC.TypeLits (Symbol)+import Unsafe.Coerce (unsafeCoerce)++{- Note [Consumer API Layering: The Ergonomic Facade]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+[tag:note-consumer-facade]+`Polytropos.hs` serves as the user-facing frontend of the polytropos engine.+While `Polytropos.Core` provides unchecked primitive manipulations over+`Rep f a = Rep Word# (SmallArray# (f Any))`, direct consumption of `Polytropos.Core`+would require application developers to write manual type coercions, instantiate+`RowRep` phantom parameters, and manually compute slot indices.++The role of this module is to provide a zero-cost, type-safe ergonomic facade:+  1. High-Level Types:+     - `type Record r = RowRep Identity ProductRowT r ()`+     - `type RecordF f r = RowRep f ProductRowHKDT r ()`+     - `type Variant s = RowRep Identity SumRowT s ()`+     - `type VariantF f s = RowRep f SumRowHKDT s ()`+  2. Syntactic Ergonomics:+     - First-class pattern synonyms (`Variant`, `VariantF`) that allow pattern matching+       on open sums as if they were ordinary Haskell ADT constructors.+     - Source plugin markers (`REC`, `VAR`, `REC_UPD`) that lower standard Haskell+       record syntax to flat runtime representations before typechecking.+  3. Safe Combinators:+     - Projection (`projectRecord`), widening (`widenVariant`), narrowing (`narrowVariant`),+       peeling (`peel`), and elimination (`eliminateUniform`).+All of these combinators maintain complete type safety, ensuring that raw memory+coercions (`noInlineUnsafeCo`, `unsafeCoerce`) are strictly encapsulated inside+proven plugin-driven invariants.+-}++{- Note [Pattern Synonyms and View Patterns for Open Rows]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+[tag:note-patterns-view-patterns]+In traditional Haskell ADTs, pattern matching is built directly into the language syntax+(`case shape of Circle r -> ...`). For open variants, the set of constructors is not fixed,+so compiler-baked constructor symbols do not exist.++Polytropos solves this without requiring custom GHC language extensions by combining+`PatternSynonyms` with `ViewPatterns`:++  pattern Variant :: forall (n :: Symbol) (s :: SumRow).+                     ConstructorIndex n s+                  => Field n -> Record (ConstructorPayload n s) -> Variant s+  pattern Variant f r <- ( (\v -> (Field :: Field n, projectVariant (Field :: Field n) v)) -> (f, Just r) )+    where Variant f r = injectVariant f r++Algorithmic Mechanics:+  1. Pattern Matching (Deconstruction):+     When the user writes:+       `handle (Variant (Field @"Click") r) = ...`+     GHC applies the view pattern function to the incoming `Variant s`.+     `projectVariant` checks if the runtime tag `repTag` matches `constructorIndex @"Click" s`.+     - If it matches: It returns `Just (Record payload)` in O(1) time. The pattern binds `r`.+     - If it does not match: It returns `Nothing`. The pattern fails to match, allowing GHC's+       pattern match engine to proceed to the next branch.+  2. Construction (Injection):+     When used as an expression:+       `Variant (Field @"Click") myPayload`+     GHC invokes the `where` clause: `injectVariant (Field @"Click") myPayload`, which+     queries `constructorIndex @"Click" s` at compile time and injects the payload into+     `Rep tag payload` with zero runtime tag search.+-}++{- Note [Subrow and Subsum API Combinators: Projections and Slicing]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+[tag:note-subtyping-combinators]+Open data structures support structural subtyping relationships that are impossible+with nominal Haskell data types:++1. Record Width Subtyping (Projection):+   If record `super` has fields {x, y, z} and record `sub` has fields {x, z}, then+   `sub` is a sub-row of `super` (`SubRow sub super`).+   The function `projectRecord @sub super` extracts exactly the fields required by `sub`.+   - Mechanics: The `TcPlugin` resolves `SubRow sub super` into a permutation index list+     `subRowIndices @sub @super = [0, 2]`.+   - Runtime: `projectRecord` allocates a new `SmallArray` of size |sub| and copies+     `indexSmallArray src i` for each `i` in the permutation vector. Total complexity:+     strictly linear in the size of the projected sub-record, O(|sub|).++2. Variant Width Subtyping (Widening and Narrowing):+   If variant `sub` has constructors {A, B} and variant `super` has constructors {A, B, C},+   then `sub` can be widened to `super` totally, or `super` can be narrowed to `sub` partially:+   - Widening (`widenVariant`):+     Because every case in `sub` is handled by `super`, widening is TOTAL.+     The active tag `t` in `sub` is remapped to `subSumInjectIndices !! t` in `super`.+     The underlying payload `SmallArray` is REUSED directly without copying.+     Runtime complexity: O(1).+   - Narrowing (`narrowVariant`):+     Because `super` may contain constructors not present in `sub` (e.g. C), narrowing+     is PARTIAL (returns `Maybe (Variant sub)`).+     The runtime checks `subSumNarrowIndices !! t`. If `Just subTag`, it returns+     `Just (Rep subTag arr)` reusing `arr`; otherwise `Nothing`.+     Runtime complexity: O(1).+-}++{- Note [O(1) Array Jump Table Elimination]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+[tag:note-array-jump-table-elimination]+How should an open variant be consumed?+Traditional functional languages use linear pattern matching (`match` or `case`),+which compiles to a cascade of conditional jumps or binary search comparisons:+  if tag == 0 then h0 else if tag == 1 then h1 else ...++For large variants (e.g. ASTs with 60 node types), linear cascading causes severe+CPU branch mispredictions and code bloat.++Polytropos introduces true O(1) jump table elimination via `eliminateUniform`:+  `eliminateUniform :: Record (HandlerRecordRow s a) -> Variant s -> a`++Algorithmic Mechanics:+  1. Handlers as a Record:+     The set of handler functions for all constructors in `s` is packed into an+     ordinary Polytropos `Record`:+       `handlers = REC { Click = \r -> ..., Quit = \_ -> ... }`+     At runtime, this record is stored as a flat `SmallArray` of function pointers.+  2. O(1) Direct Indexed Dispatch:+     Given the variant `RowRep (Rep tag vals)`:+     - The function pointer for the active constructor is fetched directly from the+       handler array at index `fromIntegral tag`:+         `Identity hAny = indexSmallArray hVals (fromIntegral tag)`+     - The function is coerced to `Record '[] -> a` via `unsafeCoerce`.+     - The payload array is wrapped into a zero-cost `Record '[]` and passed to `h`.+  3. Hardware Physics:+     - Zero conditional branches.+     - Single memory read from the handler array (L1 cache hit).+     - Direct indirect call instruction (`call *%rax` on x86-64).+     - Execution time is completely invariant to the number of constructors in the variant!+-}++-- | An open record type, parametrised by a functor @f@ and a row @r@.+--+-- [ref:note-consumer-facade] [ref:note-rep-memory-physics]+-- A 'RecordF' is a flat, contiguous array of fields where each field slot+-- contains a value wrapped in @f@.+type RecordF (f :: Type -> Type) (r :: ProductRow f) = RowRep f ProductRowHKDT r ()++-- | An open record type, parametrised by a row @r@ with bare field values (@f ~ Identity@).+--+-- [ref:note-consumer-facade] [ref:note-rep-memory-physics]+-- A 'Record' is a flat, contiguous array of fields. Its memory layout is a+-- single pointer to a small array of payload slots, plus an erased constructor+-- tag (which is always 0 for products).+type Record (r :: Row) = RowRep Identity ProductRowT r ()++-- | An open variant type, parametrised by a functor @f@ and a sum row @s@.+--+-- [ref:note-consumer-facade] [ref:note-rep-memory-physics]+-- A t'VariantF' is a single value that can be any one of the constructors+-- defined in the sum row @s@, with each field slot wrapped in @f@.+type VariantF (f :: Type -> Type) (s :: SumRowHKD f) = RowRep f SumRowHKDT s ()++-- | An open variant type, parametrised by a sum row @s@ with bare field values (@f ~ Identity@).+--+-- [ref:note-consumer-facade] [ref:note-rep-memory-physics]+-- A t'Variant' is a single value that can be any one of the constructors+-- defined in the sum row @s@. Its memory layout is exactly identical to a+-- 'Record', except the tag distinguishes which constructor is currently active.+type Variant (s :: SumRow) = RowRep Identity SumRowT s ()++-- | Construct an empty HKD record.+emptyRecordF :: RecordF f '[]+emptyRecordF = RowRep (productRep [])++-- | Insert a new field wrapped in @f@ into an HKD record.+insertFieldF :: forall n f a r. Field n -> f a -> RecordF f r -> RecordF f ((n ':= f a) ': r)+insertFieldF _ fa (RowRep (Rep _ v)) =+  let !n = sizeofSmallArray v+      !val = unsafeCoerce fa+      !v' = runSmallArray $ do+        m <- newSmallArray (n + 1) val+        copySmallArray m 1 v 0 n+        pure m+  in RowRep (Rep 0 v')++-- | Construct an empty record.+--+-- The empty record has no fields and an arity of 0.+emptyRecord :: Record '[]+emptyRecord = RowRep (productRep [])++-- | Insert a new field at the beginning of a record.+--+-- This extends the record's row type by prepending the new field. At runtime,+-- this copies the underlying array using vectorized block copy and adds the new value+-- with zero intermediate list allocations.+--+-- /Invariant/: This function expects the type-level field list to match the+-- runtime representation. Using it sequentially correctly builds up a record+-- in standard layout format.+insertField :: forall n a r. Field n -> a -> Record r -> Record ((n ':= a) ': r)+insertField _ a (RowRep (Rep _ v)) =+  let !n = sizeofSmallArray v+      !val = Identity (unsafeCoerce a)+      !v' = runSmallArray $ do+        m <- newSmallArray (n + 1) val+        copySmallArray m 1 v 0 n+        pure m+  in RowRep (Rep 0 v')++-- | Compute the payload product row of a constructor @n@ in a sum row @s@.+type family ConstructorPayload (n :: Symbol) (s :: SumRow) :: Row where+  ConstructorPayload n ((n ':= fs) ': rest) = fs+  ConstructorPayload n ((m ':= fs) ': rest) = ConstructorPayload n rest++-- | Compute the HKD payload product row of a constructor @n@ in an HKD sum row @s@.+type family ConstructorPayloadHKD (f :: Type -> Type) (n :: Symbol) (s :: SumRowHKD f) :: ProductRow f where+  ConstructorPayloadHKD f n ((n ':= fs) ': rest) = fs+  ConstructorPayloadHKD f n ((m ':= fs) ': rest) = ConstructorPayloadHKD f n rest++-- | Inject an HKD record into an HKD variant for a specific constructor.+injectVariantF :: forall (n :: Symbol) (f :: Type -> Type) (s :: SumRowHKD f) (fs :: ProductRow f).+                  ConstructorIndex n s => Field n -> RecordF f fs -> VariantF f s+injectVariantF _ (RowRep (Rep _ v)) =+  RowRep (Rep (constructorIndex @_ @n @s) v)++-- | Project an HKD record from an HKD variant in \(\mathcal{O}(1)\) time.+projectVariantF :: forall (n :: Symbol) (f :: Type -> Type) (s :: SumRowHKD f).+                   ConstructorIndex n s+                => Field n -> VariantF f s -> Maybe (RecordF f (ConstructorPayloadHKD f n s))+projectVariantF _ (RowRep r) =+  case projectRep (constructorIndex @_ @n @s) r of+    Just prodRep -> Just (RowRep prodRep)+    Nothing      -> Nothing++-- | Pattern synonym for matching and constructing HKD variants safely.+--+-- [ref:note-patterns-view-patterns]+pattern VariantF :: forall (n :: Symbol) (f :: Type -> Type) (s :: SumRowHKD f).+                    ConstructorIndex n s+                 => Field n -> RecordF f (ConstructorPayloadHKD f n s) -> VariantF f s+pattern VariantF f r <- ( (\v -> (Field :: Field n, projectVariantF (Field :: Field n) v)) -> (f, Just r) )+  where VariantF f r = injectVariantF f r++-- | Inject a record of fields into a variant for a specific constructor in \(\mathcal{O}(1)\) time.+injectVariant :: forall n s fs. ConstructorIndex n s => Field n -> Record fs -> Variant s+injectVariant _ (RowRep (Rep _ v)) =+  RowRep (Rep (constructorIndex @_ @n @s) v)++-- | Project a specific constructor from a variant in \(\mathcal{O}(1)\) time.+projectVariant :: forall (n :: Symbol) (s :: SumRow).+                  ConstructorIndex n s+               => Field n -> Variant s -> Maybe (Record (ConstructorPayload n s))+projectVariant _ (RowRep r) =+  case projectRep (constructorIndex @_ @n @s) r of+    Just prodRep -> Just (RowRep prodRep)+    Nothing      -> Nothing++-- | A pattern synonym for matching and constructing variants safely.+--+-- [ref:note-patterns-view-patterns]+pattern Variant :: forall (n :: Symbol) (s :: SumRow).+                   ConstructorIndex n s+                => Field n -> Record (ConstructorPayload n s) -> Variant s+pattern Variant f r <- ( (\v -> (Field :: Field n, projectVariant (Field :: Field n) v)) -> (f, Just r) )+  where Variant f r = injectVariant f r++-- | Project a sub-record from a super-record (HKD).+--+-- Extracts only the fields present in @sub@ in the order specified by @sub@.+--+-- [ref:note-subtyping-combinators] [ref:note-subrow-subsum] [ref:note-subrow-subsum-mechanics]+-- Algorithmic Mechanics:+-- The @TcPlugin@ statically proves that @sub@ is a subset of @super@ and emits+-- the projection permutation vector @subRowIndices @sub @super@. At runtime,+-- this function reads each slot from the source array and constructs a new flat+-- array of size @|sub|@ in a single linear pass.+projectRecordF :: forall (f :: Type -> Type) (sub :: ProductRow f) (super :: ProductRow f).+                  SubRow sub super => RecordF f super -> RecordF f sub+projectRecordF (RowRep (Rep _ vals)) =+  let idxs = subRowIndices @sub @super+      !n = length idxs+      !newArr = runSmallArray $ do+        m <- newSmallArray n (error "projectRecordF: uninitialized slot")+        let loop !_ [] = pure ()+            loop !dst (src : rest) = do+              writeSmallArray m dst (indexSmallArray vals src)+              loop (dst + 1) rest+        loop 0 idxs+        pure m+  in RowRep (Rep 0 newArr)++-- | Project a sub-record from a super-record (bare).+--+-- Extracts only the fields present in @sub@ in the order specified by @sub@.+--+-- [ref:note-subtyping-combinators] [ref:note-subrow-subsum] [ref:note-subrow-subsum-mechanics]+-- Complexity: \(\mathcal{O}(|sub|)\) array copy, with literal projection indices+-- precomputed at compile-time by the @Polytropos.Plugin@ and zero intermediate list allocations.+--+-- @+-- let fullRec = REC { id = 1 :: Int, name = "Alice", role = "Admin" }+--     subRec  = projectRecord @'["name" ':= String] fullRec+-- @+projectRecord :: forall sub super. SubRow sub super => Record super -> Record sub+projectRecord (RowRep (Rep _ vals)) =+  let idxs = subRowIndices @sub @super+      !n = length idxs+      !newArr = runSmallArray $ do+        m <- newSmallArray n (error "projectRecord: uninitialized slot")+        let loop !_ [] = pure ()+            loop !dst (src : rest) = do+              writeSmallArray m dst (indexSmallArray vals src)+              loop (dst + 1) rest+        loop 0 idxs+        pure m+  in RowRep (Rep 0 newArr)++-- | Widen a variant from a sub-row to a super-row (HKD).+--+-- [ref:note-subtyping-combinators] [ref:note-subrow-subsum] [ref:note-subrow-subsum-mechanics]+-- Widening is total and constant time: the active constructor tag in @sub@ is+-- remapped to its corresponding tag in @super@, preserving payload slots.+widenVariantF :: forall (f :: Type -> Type) (sub :: SumRowHKD f) (super :: SumRowHKD f).+                 SubSum sub super => VariantF f sub -> VariantF f super+widenVariantF (RowRep rep) =+  let tag = fromIntegral (repTag rep) :: Int+      superTag = (subSumInjectIndices @sub @super) !! tag+  in RowRep (Rep superTag (repVals rep))++-- | Widen a variant from a sub-row to a super-row (bare).+--+-- [ref:note-subtyping-combinators] [ref:note-subrow-subsum] [ref:note-subrow-subsum-mechanics]+-- Widening is total and constant time (\(\mathcal{O}(1)\)): the active constructor+-- tag in @sub@ is remapped to its corresponding tag in @super@ via a compile-time+-- synthesized literal tag lookup table, requiring zero payload array allocations.+--+-- @+-- let smallVar = VAR { Ok = REC { val = 200 :: Int } } :: Variant '["Ok" ':= '["val" ':= Int]]+--     wideVar  = widenVariant @'["Ok" ':= '["val" ':= Int], "Err" ':= '["msg" ':= String]] smallVar+-- @+widenVariant :: forall sub super. SubSum sub super => Variant sub -> Variant super+widenVariant (RowRep rep) =+  let tag = fromIntegral (repTag rep) :: Int+      superTag = (subSumInjectIndices @sub @super) !! tag+  in RowRep (Rep superTag (repVals rep))++-- | Narrow a variant from a super-row to a sub-row (HKD).+--+-- [ref:note-subtyping-combinators] [ref:note-subrow-subsum] [ref:note-subrow-subsum-mechanics]+-- Returns 'Just' with the active tag remapped to @sub@ if the constructor belongs+-- to @sub@, or 'Nothing' if the constructor is not in @sub@.+narrowVariantF :: forall (f :: Type -> Type) (sub :: SumRowHKD f) (super :: SumRowHKD f).+                  SubSum sub super => VariantF f super -> Maybe (VariantF f sub)+narrowVariantF (RowRep rep) =+  let tag = fromIntegral (repTag rep) :: Int+      narrowMap = subSumNarrowIndices @sub @super+  in case drop tag narrowMap of+    (Just subTag : _) -> Just (RowRep (Rep subTag (repVals rep)))+    _                 -> Nothing++-- | Narrow a variant from a super-row to a sub-row (bare).+--+-- [ref:note-subtyping-combinators] [ref:note-subrow-subsum] [ref:note-subrow-subsum-mechanics]+-- Returns 'Just' with the active tag remapped to @sub@ if the active constructor belongs+-- to @sub@, or 'Nothing' if the constructor is not a member of @sub@.+--+-- Complexity: \(\mathcal{O}(1)\) time. Reuses the underlying payload array directly.+narrowVariant :: forall sub super. SubSum sub super => Variant super -> Maybe (Variant sub)+narrowVariant (RowRep rep) =+  let tag = fromIntegral (repTag rep) :: Int+      narrowMap = subSumNarrowIndices @sub @super+  in case drop tag narrowMap of+    (Just subTag : _) -> Just (RowRep (Rep subTag (repVals rep)))+    _                 -> Nothing++{-------------------------------------------------------------------------------+  Elimination & Peeling+-------------------------------------------------------------------------------}++-- | Delete a constructor @n@ from a sum row @s@.+--+-- Type-level subtraction for open variant rows, enabling type refinement during+-- sequential peeling passes.+type family Delete (n :: Symbol) (s :: [Pair Symbol k]) :: [Pair Symbol k] where+  Delete n ((n ':= fs) ': rest) = rest+  Delete n ((m ':= fs) ': rest) = (m ':= fs) ': Delete n rest+  Delete n '[]                  = '[]++-- | Peel a single constructor @n@ from an open variant in \(\mathcal{O}(1)\) time.+--+-- [ref:note-peeling-elimination]+-- If the variant's active constructor is @n@, returns @Right (Record fs)@.+-- Otherwise, returns @Left (Variant (Delete n s))@ with the runtime tag+-- decremented if \(t > target\) and preserved if \(t < target\), requiring+-- __zero__ heap reallocation or payload copying.+--+-- This is the core primitive enabling single-construct compiler passes (Nanopass):+--+-- @+-- desugarStmt :: Variant ("While" ':= fs ': CoreRow) -> Variant CoreRow+-- desugarStmt v = case peel \@"While" v of+--   Right (REC { cond, body }) -> desugarWhile cond body+--   Left rest                  -> rest  -- O(1) pass-through for all other constructs!+-- @+peel :: forall (n :: Symbol) (s :: SumRow).+        ConstructorIndex n s+     => Variant s+     -> Either (Variant (Delete n s)) (Record (ConstructorPayload n s))+peel (RowRep r) =+  case peelRep (constructorIndex @_ @n @s) r of+    Right prodRep -> Right (RowRep prodRep)+    Left remR     -> Left (RowRep remR)++-- | Peel a constructor @n@ from an open HKD variant in \(\mathcal{O}(1)\) time.+--+-- [ref:note-peeling-elimination]+peelF :: forall (n :: Symbol) (f :: Type -> Type) (s :: SumRowHKD f).+         ConstructorIndex n s+      => VariantF f s+      -> Either (VariantF f (Delete n s)) (RecordF f (ConstructorPayloadHKD f n s))+peelF (RowRep r) =+  case peelRep (constructorIndex @_ @n @s) r of+    Right prodRep -> Right (RowRep prodRep)+    Left remR     -> Left (RowRep remR)++-- | Row of handler functions for a sum row @s@ returning a uniform result @res@.+type family HandlerRecordRow (s :: SumRow) (res :: Type) :: Row where+  HandlerRecordRow '[] _ = '[]+  HandlerRecordRow ((n ':= fs) ': rest) res = (n ':= (Record fs -> res)) ': HandlerRecordRow rest res++-- | Row of monadic handler functions for a sum row @s@ returning @m res@.+type family HandlerRecordRowM (s :: SumRow) (m :: Type -> Type) (res :: Type) :: Row where+  HandlerRecordRowM '[] _ _ = '[]+  HandlerRecordRowM ((n ':= fs) ': rest) m res = (n ':= (Record fs -> m res)) ': HandlerRecordRowM rest m res++-- | Row of heterogeneous handler functions mapping constructors in @s@ to results in @resRow@.+type family HandlerRecordRowHetero (s :: SumRow) (resRow :: SumRow) :: Row where+  HandlerRecordRowHetero '[] _ = '[]+  HandlerRecordRowHetero ((n ':= fs) ': rest) ((n ':= rfs) ': rrest) =+    (n ':= (Record fs -> Record rfs)) ': HandlerRecordRowHetero rest rrest++-- | Row of heterogeneous monadic handler functions mapping constructors in @s@ to monadic results in @m (Record rfs)@.+type family HandlerRecordRowHeteroM (s :: SumRow) (resRow :: SumRow) (m :: Type -> Type) :: Row where+  HandlerRecordRowHeteroM '[] _ _ = '[]+  HandlerRecordRowHeteroM ((n ':= fs) ': rest) ((n ':= rfs) ': rrest) m =+    (n ':= (Record fs -> m (Record rfs))) ': HandlerRecordRowHeteroM rest rrest m++-- | Eliminate a closed variant uniformly with \(\mathcal{O}(1)\) array jump table dispatch.+--+-- [ref:note-array-jump-table-elimination]+-- Handlers are provided as a 'Record' where each field corresponds to a constructor+-- in @s@. The runtime reads the variant's tag \(t\) and directly indexes slot \(t\)+-- of the handler array, executing without linear branch cascades.+--+-- @+-- let res = eliminateUniform handlers myVariant+--   where+--     handlers = REC+--       { Ok  = \\(REC { code, body }) -> "Status " ++ show code+--       , Err = \\(REC { reason })     -> "Error: " ++ reason+--       }+-- @+eliminateUniform :: forall (s :: SumRow) a.+                    Record (HandlerRecordRow s a)+                 -> Variant s+                 -> a+eliminateUniform (RowRep (Rep _ hVals)) (RowRep (Rep tag vals)) =+  let Identity hAny = indexSmallArray hVals (fromIntegral tag)+      h = unsafeCoerce hAny :: Record '[] -> a+      payload = RowRep (Rep 0 vals) :: Record '[]+  in h payload++-- | Eliminate a closed variant uniformly inside a monad @m@ with \(\mathcal{O}(1)\) array jump table dispatch.+--+-- [ref:note-array-jump-table-elimination]+eliminateUniformM :: forall (s :: SumRow) m a.+                     Record (HandlerRecordRowM s m a)+                  -> Variant s+                  -> m a+eliminateUniformM (RowRep (Rep _ hVals)) (RowRep (Rep tag vals)) =+  let Identity hAny = indexSmallArray hVals (fromIntegral tag)+      h = unsafeCoerce hAny :: Record '[] -> m a+      payload = RowRep (Rep 0 vals) :: Record '[]+  in h payload++-- | Full hybrid eliminator: eliminate a closed variant into an open variant of per-constructor results.+--+-- [ref:note-array-jump-table-elimination]+-- Each handler in @s@ transforms that constructor's payload into a corresponding result in @resRow@.+-- The resulting variant retains the original constructor tag and payload in \(\mathcal{O}(1)\) time.+eliminate :: forall (s :: SumRow) (resRow :: SumRow).+             Record (HandlerRecordRowHetero s resRow)+          -> Variant s+          -> Variant resRow+eliminate (RowRep (Rep _ hVals)) (RowRep (Rep tag vals)) =+  let Identity hAny = indexSmallArray hVals (fromIntegral tag)+      h = unsafeCoerce hAny :: Record '[] -> Record '[]+      payload = RowRep (Rep 0 vals) :: Record '[]+      RowRep (Rep _ resVals) = h payload+  in RowRep (Rep tag resVals)++-- | Full monadic hybrid eliminator: eliminate a closed variant into an open variant of per-constructor results inside @m@.+--+-- [ref:note-array-jump-table-elimination]+eliminateM :: forall (s :: SumRow) (resRow :: SumRow) m.+              Monad m+           => Record (HandlerRecordRowHeteroM s resRow m)+           -> Variant s+           -> m (Variant resRow)+eliminateM (RowRep (Rep _ hVals)) (RowRep (Rep tag vals)) =+  let Identity hAny = indexSmallArray hVals (fromIntegral tag)+      h = unsafeCoerce hAny :: Record '[] -> m (Record '[])+      payload = RowRep (Rep 0 vals) :: Record '[]+  in do+    RowRep (Rep _ resVals) <- h payload+    pure (RowRep (Rep tag resVals))++-- | Syntactic synonym for 'eliminateUniform' taking the variant value first.+--+-- [ref:note-array-jump-table-elimination]+-- Convenient for direct pattern matching expressions resembling Swift or Rust @match@:+--+-- @+-- matchVariant expr REC+--   { lit = \\(REC { val }) -> val+--   , add = \\(REC { left, right }) -> left + right+--   }+-- @+matchVariant :: forall (s :: SumRow) a.+                Variant s+             -> Record (HandlerRecordRow s a)+             -> a+matchVariant = flip eliminateUniform++{-------------------------------------------------------------------------------+  Syntactic Devices & Helpers (Source Plugin)++  [ref:note-source-plugin-arch]+  The data types below serve as syntactic anchors for the Polytropos GHC source+  plugin ('Polytropos.Plugin.Source'). In standard Haskell source code, record+  syntax @REC { x = 10, y = True }@ or variant patterns @VAR { Ok = REC { val } }@+  would be rejected by the parser or typechecker because @REC@ and @VAR@ do not+  declare fields @x@ or constructors @Ok@.++  Before GHC's typechecker runs, the source plugin intercepts these expressions+  and rewrites them into flat @productRep@, @injectRep@, and view pattern trees.+  These markers are never evaluated at runtime; their sole purpose is to provide+  syntactic anchors for the source desugarer.+-------------------------------------------------------------------------------}++-- | Syntactic marker for anonymous record construction and pattern matching.+-- Desugared by the @Polytropos@ source plugin.+--+-- [ref:note-source-plugin-arch]+data REC = REC+  deriving (Show, Eq)++-- | Syntactic marker for anonymous functorial/HKD record construction.+-- Desugared by the @Polytropos@ source plugin.+--+-- [ref:note-source-plugin-arch]+data REC_F = REC_F+  deriving (Show, Eq)++-- | Syntactic marker for anonymous variant injection and pattern matching.+-- Desugared by the @Polytropos@ source plugin.+--+-- [ref:note-source-plugin-arch]+data VAR = VAR+  deriving (Show, Eq)++-- | Syntactic alias for v'VAR'.+type VARIANT = VAR++-- | Pattern synonym alias for v'VAR'.+pattern VARIANT :: VAR+pattern VARIANT = VAR++-- | Marker for record update syntax: @REC_UPD r { x = 42 }@.+-- Desugared by the @Polytropos@ source plugin into 'setField' calls.+--+-- [ref:note-source-plugin-arch] [ref:note-view-patterns]+data REC_UPD = REC_UPD+  deriving (Show, Eq)++-- | Marker for functorial/HKD record update syntax: @REC_UPD_F r { x = Just 42 }@.+-- Desugared by the @Polytropos@ source plugin into 'setFieldF' calls.+--+-- [ref:note-source-plugin-arch] [ref:note-view-patterns]+data REC_UPD_F = REC_UPD_F+  deriving (Show, Eq)++-- | Marker class for open record declarations desugared by the source plugin.+--+-- [ref:note-open-declarations]+class OpenRecord a++-- | Marker class for open variant declarations desugared by the source plugin.+--+-- [ref:note-open-declarations]+class OpenVariant a++-- | Fetch a field value from a record, used for pattern matching and field access.+--+-- Algorithmic Mechanics:+-- In view patterns emitted by the source plugin for pattern matching on records+-- (@REC { x, y }@), field values are extracted using 'recordField'. It queries+-- GHC's built-in 'HasField' constraint, which is solved by @polytropos-plugin@+-- using the precomputed 0-based index of field @n@.+recordField :: forall n a r. HasField n (Record r) (Identity a) => Field n -> Record r -> a+recordField _ r = case getField @n r of Identity x -> x++-- | Update an existing field in a 'Record'.+--+-- Algorithmic Mechanics:+-- Resolves 'FieldIndex' at compile time to obtain the literal slot index of @n@+-- in @r@, coerces the new value to 'Identity Any', and delegates to 'setFieldAt'.+setField :: forall n a r. FieldIndex n r a => Field n -> a -> Record r -> Record r+setField _ val (RowRep rep) =+  RowRep (setFieldAt (fieldIndex @_ @n @r @a) (Identity (noInlineUnsafeCo val)) rep)++-- | Update an existing field in a 'RecordF'.+setFieldF :: forall n a f r. FieldIndex n r (f a) => Field n -> f a -> RecordF f r -> RecordF f r+setFieldF _ val (RowRep rep) =+  RowRep (setFieldAt (fieldIndex @_ @n @r @(f a)) (noInlineUnsafeCo val) rep)++{-------------------------------------------------------------------------------+  Generic Row Operations (§1.7 Generic instance layer)+-------------------------------------------------------------------------------}++-- | Map a class-constrained function over all fields of a record.+--+-- Algorithmic Mechanics:+-- 1. Fetches pre-resolved dictionary vector @fieldDicts@ (a contiguous 'SmallArray'+--    of type-erased 'DictAny' entries).+-- 2. Clones the underlying payload array into a mutable 'SmallMutableArray' in ST.+-- 3. In a tight unrolled loop from 0 to N-1:+--    - Fetches the dictionary at slot @i@ and unpacks 'DictAny', bringing @c Any@ into scope.+--    - Fetches the payload at slot @i@, coerces to @Any@, and invokes @f@.+--    - Writes the coerced result back into slot @i@ in-place.+-- 4. Freezes the mutable array into an immutable 'Record'.+--+-- Complexity: Exactly 1 array allocation of size N, zero intermediate list allocations.+cmapRecord+  :: forall c r. AllFields ProductRowT r c+  => (forall x. c x => x -> x)+  -> Record r+  -> Record r+cmapRecord f (RowRep (Rep t v)) =+  let dicts = fieldDicts @ProductRowT @r @c+      n = sizeofSmallArray v+      v' = runSmallArray $ do+        m <- thawSmallArray v 0 n+        let loop i+              | i == n = pure ()+              | otherwise = do+                  let d = indexSmallArray dicts i+                      Identity vi = indexSmallArray v i+                  case d of+                    DictAny -> do+                      let vi' = f (noInlineUnsafeCo vi :: Any)+                      writeSmallArray m i (Identity (noInlineUnsafeCo vi'))+                      loop (i + 1)+        loop 0+        pure m+  in RowRep (Rep t v')++-- | Fold over all fields of a record using a class constraint.+--+-- Algorithmic Mechanics:+-- Recursively traverses the dictionary vector and payload array from index 0 to N-1.+-- For each slot, unpacks 'DictAny', maps the value using @f@ to a monoidal value @m@,+-- and combines the results using '<>'.+--+-- Complexity: Zero heap array allocations.+cfoldMapRecord+  :: forall c r m. (AllFields ProductRowT r c, Monoid m)+  => (forall x. c x => x -> m)+  -> Record r+  -> m+cfoldMapRecord f (RowRep (Rep _ v)) =+  let dicts = fieldDicts @ProductRowT @r @c+      n = sizeofSmallArray v+      loop i+        | i == n = mempty+        | otherwise =+            let d = indexSmallArray dicts i+                Identity vi = indexSmallArray v i+            in case d of+                 DictAny ->+                   let val = f (noInlineUnsafeCo vi :: Any)+                   in val <> loop (i + 1)+  in loop 0++-- | Zip two records of identical row shape applying a class-constrained function.+--+-- Algorithmic Mechanics:+-- Walks both records in parallel from slot 0 to N-1, applying the binary function @f@+-- using the dictionary from @fieldDicts@, writing results into a newly allocated array.+--+-- Complexity: Exactly 1 array allocation of size N, zero intermediate list allocations.+czipWithRecord+  :: forall c r. AllFields ProductRowT r c+  => (forall x. c x => x -> x -> x)+  -> Record r+  -> Record r+  -> Record r+czipWithRecord f (RowRep (Rep t v1)) (RowRep (Rep _ v2)) =+  let dicts = fieldDicts @ProductRowT @r @c+      n = sizeofSmallArray v1+      v' = runSmallArray $ do+        m <- thawSmallArray v1 0 n+        let loop i+              | i == n = pure ()+              | otherwise = do+                  let d = indexSmallArray dicts i+                      Identity x1 = indexSmallArray v1 i+                      Identity x2 = indexSmallArray v2 i+                  case d of+                    DictAny -> do+                      let res = f (noInlineUnsafeCo x1 :: Any) (noInlineUnsafeCo x2 :: Any)+                      writeSmallArray m i (Identity (noInlineUnsafeCo res))+                      loop (i + 1)+        loop 0+        pure m+  in RowRep (Rep t v')++-- | Map a class-constrained function over all fields of an HKD record.+cmapRecordF+  :: forall c f r. AllFields ProductRowHKDT r c+  => (forall x. c x => x -> x)+  -> RecordF f r+  -> RecordF f r+cmapRecordF f (RowRep (Rep t v)) =+  let dicts = fieldDicts @ProductRowHKDT @r @c+      n = sizeofSmallArray v+      v' = runSmallArray $ do+        m <- thawSmallArray v 0 n+        let loop i+              | i == n = pure ()+              | otherwise = do+                  let d = indexSmallArray dicts i+                      vi = indexSmallArray v i+                  case d of+                    DictAny -> do+                      let vi' = f (noInlineUnsafeCo vi :: Any)+                      writeSmallArray m i (noInlineUnsafeCo vi')+                      loop (i + 1)+        loop 0+        pure m+  in RowRep (Rep t v')++-- | Fold over all fields of an HKD record using a class constraint.+cfoldMapRecordF+  :: forall c f r m. (AllFields ProductRowHKDT r c, Monoid m)+  => (forall x. c x => x -> m)+  -> RecordF f r+  -> m+cfoldMapRecordF f (RowRep (Rep _ v)) =+  let dicts = fieldDicts @ProductRowHKDT @r @c+      n = sizeofSmallArray v+      loop i+        | i == n = mempty+        | otherwise =+            let d = indexSmallArray dicts i+                vi = indexSmallArray v i+            in case d of+                 DictAny ->+                   let val = f (noInlineUnsafeCo vi :: Any)+                   in val <> loop (i + 1)+  in loop 0++

@@ -0,0 +1,1201 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneKindSignatures #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}++{-|+Module      : Polytropos.Core+Description : Low-level substrate, row vocabulary, and generic representation for Polytropos+Copyright   : (c) 2026 The Polytropos Authors+License     : EUPL-1.2 OR Apache-2.0+Maintainer  : nadia.yvette.chambers@ik.me+Stability   : experimental+Portability : non-portable (GHC extensions)++Core vocabulary and generic representation for @polytropos@.++This module is the foundational substrate of the library. It fixes three+essential architectural components and defers higher-level ergonomics to+"Polytropos" and the canonical design note (@docs\/notes\/POLYTROPOS_DESIGN.md@):++1. The /row vocabulary/: how products and sums are spelled at the type level+   (@'Pair'@ \/ @':='@, @'Row'@, @'ProductRow'@, @'SumRow'@).+2. The /generic representation/: @t'Rep'@, a runtime tag plus a flat array of+   payload slots.+3. The /evidence classes/: @'RowEq'@, @'RowShow'@, @'FieldIndex'@,+   @'ConstructorIndex'@, and @'AllFields'@, whose instance bodies are synthesised+   as literals by the TcPlugin.++= Architectural Overview & Rationale++== Why one @Rep@ for both products and sums++A product is a sum with exactly one constructor. Making that literal rather+than a special case buys one uniform representation, so the four quadrants of+the design space (nominal product, structural product, structural sum of+nominal products, nominal sum of structural products) differ only in what the+/type/ says, never in what the /value/ is:++@+data Rep (f :: Type -> Type) a = Rep {-# UNPACK #-} !Word !(SmallArray (f Any))+@++For a product the tag is always @0@ and is known statically, so tag comparisons+fold away completely in GHC Core. For a sum, the tag is the constructor index.++= When to Use This Module++* When implementing compilers, typechecker plugins, or low-level primitives.+* When writing custom backend adapters (e.g. database decoders or wire encoders)+  that need direct, unboxed access to the underlying 'Data.Primitive.SmallArray.SmallArray' slots.++= When Not to Use This Module++* In ordinary application code or domain modeling; prefer the user-friendly+  primitives and pattern synonyms in "Polytropos".+-}+module Polytropos.Core (+    -- * Rows+    Pair(..)+  , Field(..)+  , RowOf+  , Row+  , ProductRow+  , ProductRowHKD+  , SumRowOf+  , SumRow+  , SumRowHKD+  , SumRowF+    -- * Type-level row metadata+  , FieldNames+  , SimpleFieldTypes+  , FieldTypes+    -- * Row flavours (Option D vocabulary)+  , RowType(..)+  , RowFlavour(..)+    -- * Handler and result types+  , HandlerType(..)+  , ResultType(..)+    -- * Generic representation+  , Rep(..)+  , repTag+  , repVals+    -- * Ephemeral transient representation+  , MRep(..)+  , thawRep+  , thawRepSlice+  , freezeRep+  , writeFieldAt+  , writeFieldsAt+  , copyFieldsFrom+  , copyMFields+  , newMRep+  , modifyRep+    -- * Row-carrying wrapper (Case 3)+  , RowRep(..)+  , unRowRep+    -- * Construction+  , productRep+  , injectRep+    -- * Access+  , repArity+  , fieldAt+  , setFieldAt+  , setFieldsAt+  , setFieldSumAt+  , projectRep+  , projectRepList+  , matchRep+  , matchRepArr+  , peelRep+  , peelRepList+    -- * Evidence classes+  , RowEq(..)+  , RowShow(..)+  , RowEqSum(..)+  , RowShowSum(..)+  , FieldIndex(..)+  , ConstructorIndex(..)+  , Dict(..)+  , DictAny(..)+  , mkDictAny+  , evidenceAllFields+  , AllFields(..)+  , DictAllFields+  , SubRow(..)+  , SubSum(..)+  , KnownHash(..)+  , labelHash+  , hashVal+  , fnv1a64+  , ProxyRowFlavour(..)+  , ProductRowProxy+  , SumRowProxy+  , ProductRowHKDProxy+  , SumRowHKDProxy+    -- * Utilities+  , noInlineUnsafeCo+  ) where++import Control.Monad               (forM_, when)+import Control.Monad.ST            (ST)+import Data.Bits                   (xor)+import Data.Char                   (ord)+import Data.Foldable               (toList)+import Data.Kind                   (Constraint, Type)+import Data.List                   (sortOn)+#if !MIN_VERSION_base(4,20,0)+import Data.List                   (foldl')+#endif+import Data.Primitive.SmallArray+import Data.Word                   (Word64)+-- import Data.Tagged                 (Tagged(..))+import GHC.Exts                    (Any)+import GHC.OverloadedLabels        (IsLabel(..))+import GHC.TypeLits                (Symbol)+import Unsafe.Coerce               (unsafeCoerce)++{- Note [The Unified Rep Memory Physics: Quad-Quadrant Collapse]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+[tag:note-rep-memory-physics]+Historically, functional languages treat products (records, tuples, structs)+and sums (variants, coproducts, enums) as dual but structurally disjoint+mechanisms:++  1. Nominal Products:   data Person = Person { name :: String, age :: Int }+  2. Structural Products: Anonymous records (Record '["name" ':= String, ...])+  3. Nominal Sums:       data Shape = Circle Double | Rectangle Double Double+  4. Structural Sums:     Open variants (Variant '["Circle" ':= ..., ...])++In most extensible row libraries (such as vinyl or open-adt), these four+quadrants require distinct runtime architectures:+  - Products use heterogeneous cons-lists (HList) or balanced type-level trees,+    incurring O(N) pointer indirection chains and massive GC nursery churn.+  - Sums use nested binary Either trees (Either a (Either b (Either c ...))),+    incurring O(N) allocation overhead per injection and O(N) pattern cascading.++Polytropos collapses all four quadrants into a single, uniform runtime primitive:+  data Rep f a = Rep {-# UNPACK #-} !Word !(SmallArray (f Any))++Under GHC's STG/heap representation, Rep has the following precise memory physics:+  - 1 word: GHC info table pointer (heap object header).+  - 1 word: Unboxed 64-bit integer (Word#) representing the constructor tag t.+  - 1 word: Pointer to a SmallArray# heap object.++The SmallArray# payload itself consists of:+  - 1 word: GHC info table pointer.+  - 1 word: Size integer (Int#) representing the arity N.+  - N words: Contiguous pointers directly to the field values (f Any).++Total heap footprint: exactly 3 words for Rep + (2 + N) words for SmallArray#.+Crucially:+  * Zero Vector box overhead: Unlike standard Data.Vector, which wraps arrays in+    a 3-word record carrying an offset, length, and array pointer, SmallArray+    indexes the bare contiguous array directly.+  * For Products: The runtime tag is statically fixed to 0 and ignored. Field+    access is direct indexed lookup: indexSmallArray# arr i.+  * For Sums: The tag t indicates the active constructor (0, 1, 2, ...).+    The SmallArray# contains exactly the fields of constructor t.+    Because constructor arities can differ, the array size adapts dynamically+    without padding unused slots.+  * Homogeneity: A product of 10 fields and a sum whose active constructor has+    10 fields share the identical memory layout and garbage collection profile.+-}++{- Note [Transient Builders and In-Place CoW Hardware Vectorization]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+[tag:note-transient-cow]+Persistent data structures in functional languages face a well-known tension:+immutability guarantees thread safety and referential transparency, but single-field+updates naively require copying the entire N-element record (O(N) time and allocation).+For large records (e.g. 50-100 fields in enterprise domain models), repeated single+updates `r { a = 1, b = 2, c = 3 }` produce K * O(N) heap allocations, flooding the+GHC nursery and degrading L1/L2 cache hit rates.++Polytropos addresses this through a two-tiered hardware-conscious update architecture:++1. Ephemeral Transient Builders (MRep):+   When batch mutations or deserializations occur, we introduce an ephemeral mutable+   representation:+     data MRep s f a = MRep {-# UNPACK #-} !Word !(SmallMutableArray s (f Any))+   Inside the ST s monad, fields can be written in-place with zero allocations+   (writeSmallArray). Once construction is complete, unsafeFreezeSmallArray freezes+   the buffer into an immutable Rep with zero copying.++2. SIMD Hardware-Vectorized Copy-on-Write Bifurcation (Threshold N = 32):+   When an immutable record update (setFieldAt or setFieldsAt) is requested,+   the record size N is inspected:++   a. Small Records (N <= 32 fields):+      An array of 32 pointer words occupies 256 bytes (plus 16 bytes header).+      On modern x86-64 and AArch64 processors, L1 data cache lines are 64 bytes.+      A 32-field record fits entirely within 4 to 5 cache lines.+      Here, cloning the array via thawSmallArray and writing the updated slot in-place+      is executed entirely within L1 cache, with minimal branch prediction penalty.++   b. Large Records (N > 32 fields):+      For records exceeding 32 fields, thawing and overwriting causes cache eviction+      and redundant memory writes. Instead, we allocate a fresh array pre-filled with the+      updated value and copy the unchanged segments using copySmallArray:+        - Pre-slice:  copySmallArray m 0 v 0 i (indices 0 to i-1)+        - Post-slice: copySmallArray m (i+1) v (i+1) (n - i - 1) (indices i+1 to n-1)+      Under GHC's runtime system, copySmallArray translates directly to primitive+      memmove / memcpy intrinsics. On modern hardware, this utilizes AVX2 (256-bit)+      or AVX-512 (512-bit) SIMD instructions, streaming 4 to 8 pointer words per CPU+      cycle directly between memory locations without polluting intermediate registers.++3. Multi-Field Batch Updates (setFieldsAt):+   For updates modifying K fields simultaneously:+   - Naive chaining of K single-field updates incurs K * O(N) allocations.+   - setFieldsAt sorts the update indices in O(K log K) time and iterates through+     contiguous unchanged blocks, copying them in vectorized chunks. Total allocation:+     exactly 1 array of size N, reducing multi-field update overhead to 1 * O(N).+-}++{- Note [Single-Constructor Peeling and Total Elimination]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+[tag:note-peeling-elimination]+A critical challenge in extensible sum types (variants) is how to deconstruct them:++1. Total Elimination via Jump Tables:+   Standard Haskell multi-way pattern matching on sum types generates nested cascading+   branch trees (case tag of 0 -> ...; 1 -> ...; 2 -> ...; ...). For variants with+   large constructor rows (e.g. 50 error codes or AST node kinds), branch mispredictions+   severely degrade instruction pipeline throughput.+   Polytropos solves this in Polytropos.hs via eliminateUniform:+   The handler record is represented as an array of functions. The variant's tag t+   is used as an immediate array index into the handler array (indexSmallArray handlers t),+   yielding O(1) jump-table dispatch with zero branching penalty.++2. Single-Constructor Peeling (peelRep and peel):+   In modular compiler pipelines (e.g., Nanopass compilers) or open error handling,+   a function frequently only handles one specific constructor (e.g., Timeout) and+   wishes to forward all other constructors transparently to downstream handlers.+   In nested Either or church-encoded variants, peeling a constructor requires+   re-wrapping the entire value into a smaller type, allocating new wrapper constructors.++   Polytropos achieves O(1) constructor peeling with ZERO heap reallocation:+   Given a variant Rep t arr and a target constructor tag targetTag:+     - If t == targetTag: Match succeeds! Return Right (Rep 0 arr) representing the+       constructor payload directly as a product record.+     - If t < targetTag: The active constructor preceded the target constructor.+       In the narrowed row (where targetTag is deleted), its relative tag index is+       unchanged. Return Left (Rep t arr).+     - If t > targetTag: The active constructor followed the target constructor.+       In the narrowed row, all constructors after targetTag shift down by 1.+       Return Left (Rep (t - 1) arr).++   Notice the critical invariant:+   In ALL branches (both Left and Right), the underlying SmallArray pointer arr+   is REUSED DIRECTLY. Not a single field pointer is copied or moved. The+   constructor peeling operation is a pure, instantaneous integer comparison,+   tag overwrite, and pointer hand-off!+-}++{-------------------------------------------------------------------------------+  §1  The row vocabulary+-------------------------------------------------------------------------------}++-- | A type-level pair: a name bound to a type.+--+-- Poly-kinded with independent parameters, mirroring @large-anon@'s+-- @Pair@ / @:=@. Kept deliberately simple; the @f@-functor parameter that+-- @large-anon@ threads through its rows is future work (see note §1, D3).+--+-- Algorithmic Mechanics:+-- In type expressions, @("name" ':= Type)@ provides an ergonomic, readable+-- alternative to tuple pairs @'("name", Type)@. Because ':=' is an ordinary data+-- constructor promoted by DataKinds, GHC treats it as a first-class type constructor+-- of kind @k1 -> k2 -> Type@.+data Pair a b = a := b++-- | A zero-cost witness for a type-level field name.+--+-- Can be constructed ergonomically via @OverloadedLabels@ (e.g. @#foo@).+--+-- Algorithmic Mechanics:+-- 'Field' has no runtime fields and is represented by GHC as a zero-cost singleton.+-- When the user writes @#foo@, GHC desugars this to @fromLabel @"foo"@. The+-- 'IsLabel' instance below matches when the label string @l@ unifies with the+-- expected field symbol @l'@, constructing 'Field' at compile time with zero+-- runtime allocation.+data Field (n :: Symbol) = Field++instance (l ~ l') => IsLabel l (Field l') where+  fromLabel = Field++-- | A poly-kinded row whose entries have kind @k@.+--+-- Poly-kinded over entry kind @k@, mirroring @large-anon@'s @Row k@.+-- A row is represented purely as a standard type-level list @[Pair Symbol k]@.+type RowOf k = [Pair Symbol k]++-- | A /product/ row: an ordered list of field names and field types.+--+-- [ref:note-rep-memory-physics]+-- Order is the identity of the row; two rows with the same fields in a+-- different order are different rows. This is deliberate — it is what lets a+-- field index be a compile-time constant (0, 1, 2, ...) synthesized directly+-- into Core by the @polytropos-plugin@ without runtime linear scanning.+type Row = RowOf Type++-- | An HKD-aware product row parameterised by a field functor @f@.+--+-- In an HKD-aware product row, each field value is wrapped in the functor @f@.+-- Since @f ty@ has kind 'Type' for any @ty :: Type@, this is an alias for+-- a row where field types are parameterised by @f@.+type ProductRow (f :: Type -> Type) = RowOf Type++-- | Synonym for 'ProductRow'.+type ProductRowHKD (f :: Type -> Type) = ProductRow f++-- | A poly-kinded sum row whose constructor payloads have product kind @prod@.+--+-- Sum rows map constructor name symbols to their payload specification.+type SumRowOf prod = [Pair Symbol prod]++-- | A /sum/ row: an ordered list of constructor names, each carrying the+-- product row of that constructor's fields.+--+-- [ref:note-rep-memory-physics]+-- The tag of a constructor is its 0-based position in this list. Constructor+-- arities are therefore the lengths of the nested product rows, and may differ+-- (see note §3, D7).+type SumRow = SumRowOf Row++-- | An HKD-aware sum row parameterised by a field functor @f@.+-- Each constructor carries an HKD product row.+type SumRowHKD (f :: Type -> Type) = SumRowOf (ProductRow f)++-- | Synonym for 'SumRowHKD'.+type SumRowF (f :: Type -> Type) = SumRowHKD f++{-------------------------------------------------------------------------------+  §1b  Type-level row metadata (rewritten by TcPlugin)++  [ref:note-metadata-rewriting]+  Closed-form type families without Haskell-level equations. When a row is+  fully known, the TcPlugin rewrites these type families to concrete type-level+  lists, enabling generic programming over field names and field types.++  Why Defunctionalized Closed-Form Families?+  In standard GHC type family programming, recursive equations (e.g. `FieldNames (x ': xs) = ...`)+  incur O(N) evaluation steps during constraint solving and generate large substitution+  forests in Core. If a row contains an unsolved unification variable or row tail,+  standard equations can become stuck or lead to explosive simplification cycles.+  By declaring them as closed type families with NO equations, GHC treats them as+  opaque abstract symbols until @Polytropos.Plugin@ inspects the row structure,+  extracts all field names/types in a single linear pass, and emits a direct+  reduction to a concrete promoted list literal.+-------------------------------------------------------------------------------}++-- | Extract field names as a type-level list of 'Symbol's.+--+-- For each field @"name" ':= ty@ in the row, this evaluates to @"name"@.+-- When the row is fully known, the TcPlugin rewrites this type family to a+-- concrete type-level list of symbols.+type family FieldNames (r :: k) :: [Symbol]++-- | Extract field names and bare field types as a type-level list of pairs.+--+-- For each field @"name" ':= ty@ in the row, this evaluates to @'("name", ty)@.+-- When the row is fully known, the TcPlugin rewrites this type family to a+-- concrete type-level list of pairs.+type family SimpleFieldTypes (r :: k) :: [(Symbol, Type)]++-- | Extract field names and instantiated field types as a type-level list of pairs.+--+-- For each field @"name" ':= ty@ in the row, this evaluates to @'("name", f ty)@.+-- When the row is fully known, the TcPlugin rewrites this type family to a+-- concrete type-level list of pairs.+type family FieldTypes (f :: Type -> Type) (r :: k) :: [(Symbol, Type)]++{-------------------------------------------------------------------------------+  §1b  Row flavours (Option D vocabulary)++  Concrete row flavours, not kind-polymorphic. Each flavour carries a+  type-level list of entries; the flavour tells the plugin what kind of+  entries to expect.++  See PHASE2_SKETCH.md, Piece 1, §1a.+-------------------------------------------------------------------------------}++-- | The kind of row flavours (Option D).+--+-- Promoted by DataKinds: the types @ProductRowT@, @SumRowT@, @HandlerRowT@,+-- @ResultRowT@ have kind @RowType@, and can be used as the row parameter of+-- t'RowRep' and the evidence classes.+--+-- Algorithmic Mechanics:+-- Option D uses concrete, distinct types for each row flavour rather than an+-- open kind-polymorphic family. This allows the @TcPlugin@ to immediately+-- determine whether it is solving for a product row, sum row, HKD variant,+-- or handler vector by inspecting the promoted type constructor, avoiding+-- ambiguity and complex kind unification steps during constraint solving.+data RowType+  = ProductRowT        -- ^ field name → field type+  | SumRowT            -- ^ constructor name → fieldrow+  | HandlerRowT        -- ^ constructor name → handler type+  | ResultRowT         -- ^ constructor name → result type+  | ProductRowHKDT     -- ^ field name → f (field type)+  | SumRowHKDT         -- ^ constructor name → ProductRow f++-- | The class that abstracts over row flavours.+--+-- Each flavour has an associated 'EntryKind' — the kind of a single entry+-- in a row of that flavour. The plugin uses this to know what to inspect.+class RowFlavour (r :: RowType) where+  -- | The kind of entries in a row of this flavour.+  type EntryKind (r :: RowType) :: Type++-- | A productrow entry: a field name paired with a field type.+instance RowFlavour ProductRowT where+  type EntryKind ProductRowT = Pair Symbol Type++-- | A sumrow entry: a constructor name paired with its fieldrow.+instance RowFlavour SumRowT where+  type EntryKind SumRowT = Pair Symbol Row++-- | An HKD-aware productrow entry: a field name paired with an applied functor type.+instance RowFlavour ProductRowHKDT where+  type EntryKind ProductRowHKDT = Pair Symbol Type++-- | An HKD-aware sumrow entry: a constructor name paired with an HKD productrow.+instance RowFlavour SumRowHKDT where+  type EntryKind SumRowHKDT = Pair Symbol Row++-- | A handlerrow entry: a handler type (see t'HandlerType').+instance RowFlavour HandlerRowT where+  type EntryKind HandlerRowT = Pair Symbol Type++-- | A result-row entry: a result type (see t'ResultType').+instance RowFlavour ResultRowT where+  type EntryKind ResultRowT = Pair Symbol Type++-- | A handler type: \"handler for constructor n, with field types fs,+-- returning result type res in monad m\".+--+-- This is the entry kind of 'HandlerRowT'. Each handler entry carries the+-- constructor name, field types, result type, and monad explicitly, so that+-- handler rows are self-contained and can be passed around without a paired+-- sum row (see PHASE2_SKETCH.md, refinement #2).+data HandlerType (n :: Symbol) (fs :: Row) (res :: Type) (m :: Type -> Type)+  = HandlerType++-- | A result type: \"result for constructor n, of type res\".+--+-- This is the entry kind of 'ResultRowT'. Each result entry carries the+-- constructor name and the result type.+data ResultType (n :: Symbol) (res :: Type)+  = ResultType++{-------------------------------------------------------------------------------+  §1c  The row-carrying wrapper (Case 3)++  t'Rep' stays erased (it does not know its row). The wrapper t'RowRep' carries+  the row in its type, so that the evidence classes can work over t'RowRep'+  without a 'Data.Proxy.Proxy' argument (obligation 4, design note §6).++  See PHASE2_SKETCH.md, Piece 1, §1c.+-------------------------------------------------------------------------------}++-- | Typed, row-carrying wrapper around t'Rep'.+--+-- @f@ is the functor applied to each payload slot.+-- @r@ is the row flavour (one of 'ProductRowT', 'SumRowT', etc.).+-- @row@ is the actual row data (a type-level list of entries), of any kind.+-- @a@ is the value type.+--+-- At runtime this is exactly @Rep f a@ — a newtype with zero cost.+--+-- [ref:note-rep-memory-physics]+-- Zero-Cost Newtype Erasure:+-- GHC's Core compiler completely unwraps @RowRep@ at compile time. At runtime,+-- all operations on @RowRep@ compile down to direct primitive instructions on+-- the underlying 'Rep'. The type arguments @r@ and @row@ act as purely type-level+-- evidence tags, allowing typeclasses like 'RowEq', 'RowShow', and 'AllFields'+-- to be invoked directly on records without requiring explicit runtime proxies.+data RowRep (f :: Type -> Type) (r :: RowType) (row :: k) a = RowRep (Rep f a)++-- | Extract the underlying t'Rep' from a t'RowRep'.+unRowRep :: RowRep f r row a -> Rep f a+unRowRep (RowRep r) = r+  -- Note: @k@ is a kind variable that allows any kind for the row data.+  -- For product rows, @row@ has kind @[Pair Symbol Type]@.+  -- For sum rows, @row@ has kind @[Pair Symbol Row]@.+  -- The evidence classes use this flexibility to accept different row kinds.+++{-------------------------------------------------------------------------------+  §2  The generic representation+-------------------------------------------------------------------------------}++-- | Generic representation of a product or a sum.+--+-- [ref:note-rep-memory-physics]+-- The layout is exactly the one proposed for this project: a tag plus a flat+-- array of payload slots.+--+-- > newtype Rep f a = Rep (Word#, SmallArray# (f Any))+--+-- written here at the Haskell level, which has the same layout:+-- @{-# UNPACK #-} !Word@ is @Word#@, and @SmallArray (f Any)@ is a+-- @SmallArray# (f Any)@ behind a newtype. @SmallArray@ rather than @Vector@+-- because it stores one pointer per element instead of a three-word box, which+-- is the change @large-generics@ 0.2 made for the same reason.+--+-- @f@ is the functor applied to each payload slot, so that @Rep I@ is+-- isomorphic to the value itself and @Rep Maybe@ boxes the slots.+data Rep (f :: Type -> Type) a = Rep+  {-# UNPACK #-} !Word+  !(SmallArray (f Any))++-- | Constructor index. @0@ for a product.+--+-- For sums, this identifies which constructor of the sum row is currently active.+repTag :: Rep f a -> Word+repTag (Rep t _) = t++-- | Payload slots, in row order, of the /selected/ constructor.+--+-- For products, this contains all fields of the record.+-- For sums, this contains only the payload fields of the active constructor.+repVals :: Rep f a -> SmallArray (f Any)+repVals (Rep _ v) = v++-- | Materialise the payload slots as a list, in row order.+toListSlots :: SmallArray (f Any) -> [f Any]+toListSlots = toList++-- | How many payload slots the selected constructor has.+repArity :: Rep f a -> Int+repArity = sizeofSmallArray . vals+  where+    vals (Rep _ v) = v++{-------------------------------------------------------------------------------+  §2b  Ephemeral transient representation+-------------------------------------------------------------------------------}++-- | Ephemeral mutable representation for in-place construction and deserialization.+--+-- [ref:note-transient-cow]+-- Allows O(1) in-place slot modification during multi-field updates, bulk parsing,+-- or database row decoding without allocating intermediate immutable 'SmallArray'+-- wrappers.+data MRep s (f :: Type -> Type) a = MRep+  {-# UNPACK #-} !Word+  !(SmallMutableArray s (f Any))++-- | Allocate a new mutable t'MRep' pre-initialized with a default payload.+--+-- Used when building a record or variant from scratch in ST before freezing.+newMRep :: Word -> Int -> f Any -> ST s (MRep s f a)+newMRep tag n defaultVal = do+  m <- newSmallArray n defaultVal+  pure (MRep tag m)++-- | Safely thaw an immutable t'Rep' into a mutable builder.+--+-- Performs a single heap allocation of a 'SmallMutableArray' and copies the N+-- pointers from the source array.+thawRep :: Rep f a -> ST s (MRep s f a)+thawRep (Rep t v) = do+  m <- thawSmallArray v 0 (sizeofSmallArray v)+  pure (MRep t m)++-- | Safely thaw a sub-slice of an immutable t'Rep' into a mutable builder.+thawRepSlice :: Rep f a -> Int -> Int -> ST s (MRep s f a)+thawRepSlice (Rep t v) off len = do+  m <- thawSmallArray v off len+  pure (MRep t m)++-- | Safely freeze an ephemeral builder into an immutable t'Rep'.+--+-- Uses 'unsafeFreezeSmallArray', which is an O(1) zero-copy operation that reuses+-- the mutable buffer directly as an immutable 'SmallArray'. Safe because caller+-- relinquishes all mutable references in the enclosing 'ST' action.+freezeRep :: MRep s f a -> ST s (Rep f a)+freezeRep (MRep t m) = do+  v <- unsafeFreezeSmallArray m+  pure (Rep t v)++-- | In-place slot write (@O(1)@, zero allocation).+writeFieldAt :: MRep s f a -> Int -> f Any -> ST s ()+writeFieldAt (MRep _ m) i !x = writeSmallArray m i x++-- | In-place batch slot writes (@O(K)@, zero allocations).+writeFieldsAt :: MRep s f a -> [(Int, f Any)] -> ST s ()+writeFieldsAt (MRep _ m) updates =+  forM_ updates $ \(i, !x) -> writeSmallArray m i x++-- | Batch copy of a slice of fields from an immutable t'Rep' into an t'MRep'.+--+-- Uses hardware-accelerated memory block transfer ('copySmallArray').+copyFieldsFrom :: Rep f a -> Int -> MRep s f a -> Int -> Int -> ST s ()+copyFieldsFrom (Rep _ src) srcOff (MRep _ dst) dstOff len =+  copySmallArray dst dstOff src srcOff len++-- | In-place batch block copy between mutable builders.+copyMFields :: MRep s f a -> Int -> MRep s f a -> Int -> Int -> ST s ()+copyMFields (MRep _ src) srcOff (MRep _ dst) dstOff len =+  copySmallMutableArray dst dstOff src srcOff len++-- | Scoped pure modification wrapper.+--+-- Safely thaws an immutable 'Rep', runs an ST-scoped mutation callback, and freezes+-- the result back into an immutable 'Rep' without exposing mutable state.+modifyRep :: Rep f a -> (forall s. MRep s f a -> ST s ()) -> Rep f a+modifyRep (Rep t v) act = Rep t $ runSmallArray $ do+  m <- thawSmallArray v 0 (sizeofSmallArray v)+  act (MRep t m)+  pure m++{-------------------------------------------------------------------------------+  §3  Construction+-------------------------------------------------------------------------------}++-- | Build a product from its field values, in row order.+--+-- [ref:note-rep-memory-physics]+-- The tag is @0@: a product is the one-constructor sum. The payload values+-- are placed directly into a contiguous 'SmallArray'.+productRep :: [f Any] -> Rep f a+productRep xs = Rep 0 (smallArrayFromList xs)++-- | Build a sum value carrying the given tag and that constructor's fields.+--+-- [ref:note-rep-memory-physics]+-- The tag @t@ is an unboxed integer identifying the active constructor.+-- The payload array contains exactly the fields required by constructor @t@.+injectRep :: Word -> [f Any] -> Rep f a+injectRep t xs = Rep t (smallArrayFromList xs)++{-------------------------------------------------------------------------------+  §4  Access+-------------------------------------------------------------------------------}++-- | Read the payload slot at a compile-time-known index.+--+-- The @x@ is not determined by the index alone; it comes from the row type. The+-- coercion is unchecked, exactly as in @large-anon@: the index is only ever+-- produced by the plugin from a row that actually has that field.+--+-- Algorithmic Mechanics:+-- In Core, this lowers directly to @indexSmallArray#@ followed by a no-op cast.+-- Because index @i@ is a compile-time constant emitted by the @TcPlugin@, there+-- is zero runtime dictionary lookup, zero branch instructions, and zero heap allocation.+fieldAt :: forall f a x. Int -> Rep f a -> f x+fieldAt i r = noInlineUnsafeCo (indexSmallArray (repVals r) i)++-- | Replace the payload slot at a compile-time-known index.+--+-- [ref:note-transient-cow]+-- For records with @>32@ fields (Milestone T3), uses hardware-vectorized SIMD+-- non-overlapping block copies ('copySmallArray'), eliminating redundant reads+-- and writes of slot @i@ from the source array.+--+-- For small records (@<=32@ fields), uses direct in-cache 'thawSmallArray'.+setFieldAt :: forall f a. Int -> f Any -> Rep f a -> Rep f a+setFieldAt i !x (Rep t v)+  | n > 32 = Rep t $ runSmallArray $ do+      -- Large Record Path (N > 32):+      -- Pre-fill new array with the target value x, then copy the two non-overlapping+      -- slices [0 .. i-1] and [i+1 .. n-1] via vectorized memmove.+      m <- newSmallArray n x+      when (i > 0) $+        copySmallArray m 0 v 0 i+      let !after = i + 1+          !lenAfter = n - after+      when (lenAfter > 0) $+        copySmallArray m after v after lenAfter+      pure m+  | otherwise = Rep t $ runSmallArray $ do+      -- Small Record Path (N <= 32):+      -- Entire array fits inside 4-5 L1 cache lines (256 bytes). Direct thaw and+      -- in-place slot write executes completely within CPU cache.+      m <- thawSmallArray v 0 n+      writeSmallArray m i x+      pure m+  where+    !n = sizeofSmallArray v++-- | Clone once, apply K updates in-place, freeze once.+--+-- [ref:note-transient-cow]+-- Reduces multi-field update overhead from @K * O(N)@ to @1 * O(N)@.+-- For records with @>32@ fields (Milestone T3), sorts update offsets and copies+-- non-overlapping unchanged slices in contiguous vectorized blocks.+setFieldsAt :: forall f a. [(Int, f Any)] -> Rep f a -> Rep f a+setFieldsAt [] r = r+setFieldsAt [(!i, !x)] r = setFieldAt i x r+setFieldsAt updates (Rep t v)+  | n > 32, (firstUpd : _) <- updates = Rep t $ runSmallArray $ do+      -- Large Record Multi-Update:+      -- Sort update offsets in O(K log K) to determine contiguous unchanged spans.+      let sortedUpds = sortOn fst updates+      m <- newSmallArray n (snd firstUpd)+      -- Recursively copy unchanged spans between update indices using SIMD block copies.+      let copySlices curIdx [] = do+            when (curIdx < n) $+              copySmallArray m curIdx v curIdx (n - curIdx)+          copySlices curIdx ((i, !x) : rest)+            | i < curIdx = do+                writeSmallArray m i x+                copySlices curIdx rest+            | otherwise = do+                when (i > curIdx) $+                  copySmallArray m curIdx v curIdx (i - curIdx)+                writeSmallArray m i x+                copySlices (i + 1) rest+      copySlices 0 sortedUpds+      pure m+  | otherwise = Rep t $ runSmallArray $ do+      -- Small Record Multi-Update:+      -- Direct thaw, followed by K in-place writes in L1 cache, then freeze.+      m <- thawSmallArray v 0 n+      forM_ updates $ \(i, !x) -> writeSmallArray m i x+      pure m+  where+    !n = sizeofSmallArray v++-- | Partial field update for sum constructors.+--+-- Ensures the runtime tag matches the expected constructor tag before updating.+-- If the sum value is not currently the specified constructor, returns 'Nothing'.+setFieldSumAt :: forall f a. Word -> Int -> f Any -> Rep f a -> Maybe (Rep f a)+setFieldSumAt expectedTag idx !val r@(Rep t _)+  | t == expectedTag = Just (setFieldAt idx val r)+  | otherwise        = Nothing++-- | Project a constructor, or 'Nothing' if the tag does not match.+--+-- When matching, returns the constructor payload wrapped as a product representation+-- (@Rep 0 v@) in \(\mathcal{O}(1)\) time with zero payload copying.+projectRep :: Word -> Rep f a -> Maybe (Rep f b)+projectRep t (Rep t' v)+  | t == t'   = Just (Rep 0 v)+  | otherwise = Nothing++-- | Convenience helper returning constructor payload slots as a list.+projectRepList :: Word -> Rep f a -> Maybe [f Any]+projectRepList t (Rep t' v)+  | t == t'   = Just (toListSlots v)+  | otherwise = Nothing++-- | Eliminate a sum: hand the tag and the selected payload to a continuation.+--+-- The continuation sees the tag, so the unmatched case is the continuation's+-- own business; this primitive does not decide it. The elimination story is+-- unsettled — see note §4.+matchRep :: (Word -> [f Any] -> a) -> Rep f a -> a+matchRep k r = k (repTag r) (toListSlots (repVals r))++-- | Eliminate a sum passing the payload as a flat 'SmallArray' without list allocation.+matchRepArr :: (Word -> SmallArray (f Any) -> a) -> Rep f a -> a+matchRepArr k r = k (repTag r) (repVals r)++-- | Peel a target tag from a sum representation in \(\mathcal{O}(1)\) time.+--+-- [ref:note-peeling-elimination]+-- If @repTag r == targetTag@, returns @Right (Rep 0 v)@ representing the payload+-- as a product representation.+-- Otherwise, returns @Left r'@ where the remaining tag is preserved if+-- @repTag r < targetTag@, or decremented by 1 if @repTag r > targetTag@.+--+-- Complexity: \(\mathcal{O}(1)\) time, requiring zero array payload copying or allocations.+peelRep :: Word -> Rep f a -> Either (Rep f a) (Rep f b)+peelRep targetTag (Rep t v)+  | t == targetTag = Right (Rep 0 v)+  | t < targetTag  = Left (Rep t v)+  | otherwise      = Left (Rep (t - 1) v)++-- | Convenience helper returning matching constructor payload as a list.+peelRepList :: Word -> Rep f a -> Either (Rep f a) [f Any]+peelRepList targetTag (Rep t v)+  | t == targetTag = Right (toListSlots v)+  | t < targetTag  = Left (Rep t v)+  | otherwise      = Left (Rep (t - 1) v)++{-------------------------------------------------------------------------------+  §5  Evidence classes++  The instance bodies are intended to be produced as integer literals by the+  TcPlugin, the same way @large-anon@ produces @DictRowHasField@. Until the+  plugin exists, the defaults are @undefined@; the concrete instances in the+  test suite are hand-written and stand in for what the plugin will emit.++  [ref:note-literal-evidence]+  Algorithmic Rationale:+  In traditional Haskell row libraries, operations like record equality or+  hashing require type-level inductive class resolution:+    instance (Eq x, Eq (Record xs)) => Eq (Record (x ': xs))+  This generates nested runtime call stacks of depth N, allocating dictionary+  frames at runtime and causing O(N^2) or O(N^3) compile-time slow-downs.+  In Polytropos, the @TcPlugin@ eliminates all type-level search:+  for any fully-known row, it emits evidence directly as unrolled Core expressions+  using literal indices, executing in a single flat unrolled loop.+-------------------------------------------------------------------------------}++-- | Field-wise equality for a product row.+--+-- The method works over t'RowRep', so the row is in the type and no 'Data.Proxy.Proxy'+-- argument is needed (obligation 4, design note §6). A plugin will build the+-- body by substituting literal slot indices and a literal element count, so+-- there is no type-level search at the use site.+--+-- [ref:note-literal-evidence]+-- The test suite writes these bodies by hand, which makes the tests the+-- specification of what the plugin must emit.+class RowFlavour r => RowEq (r :: RowType) (row :: k) where+  repEq :: RowRep f r row a -> RowRep f r row a -> Bool+  repEq _ _ = undefined++-- | Field-wise @Show@ for a product row. See 'RowEq' for the design.+--+-- [ref:note-literal-evidence]+-- The plugin synthesizes an unrolled sequence of per-field `showsPrec` calls,+-- formatting each field label as a literal string @"fieldname = "@ followed by+-- the field value's `showsPrec`, joined by comma separators.+class RowFlavour r => RowShow (r :: RowType) (row :: k) where+  repShowsPrec :: Int -> RowRep f r row a -> ShowS+  repShowsPrec _ _ = undefined++-- | Field-wise equality for a sum row.+--+-- Sums need their own class because the comparison includes the tag (the+-- constructor index), which products don't have (their tag is always 0 and+-- folds away).+--+-- [ref:note-literal-evidence]+-- Algorithmic Mechanics:+-- Two variant values `v1` and `v2` are equal iff:+--   1. Their runtime tags match: `repTag v1 == repTag v2`+--   2. Their payload fields for that specific active constructor match.+-- The plugin emits a Core `case` expression on the tag, branching into per-constructor+-- literal slot equality comparisons.+class RowFlavour r => RowEqSum (r :: RowType) (row :: k) where+  repEqSum :: RowRep f r row a -> RowRep f r row a -> Bool+  repEqSum _ _ = undefined++-- | Field-wise @Show@ for a sum row.+--+-- [ref:note-literal-evidence]+-- The plugin generates a jump table on `repTag`, emitting the constructor name+-- as a string literal followed by its payload record's field representations.+class RowFlavour r => RowShowSum (r :: RowType) (row :: k) where+  repShowsPrecSum :: Int -> RowRep f r row a -> ShowS+  repShowsPrecSum _ _ = undefined++-- | Evidence that a field name or type @n@ has a slot at a known index in a row.+--+-- The plugin solves this by inspecting the row and emitting the index as a+-- literal (obligation 1, design note §5).+--+-- Algorithmic Mechanics:+-- When GHC encounters a wanted constraint `FieldIndex "foo" r a`, the plugin+-- scans the type-level list `r` for the entry `"foo" ':= a`. It returns the+-- 0-based integer offset directly as a Core literal `Lit (MachInt i)`.+type FieldIndex :: forall {kn} k {ka}. kn -> k -> ka -> Constraint+class FieldIndex (n :: kn) (row :: k) (a :: ka) where+  fieldIndex :: Int+  fieldIndex = undefined++-- | Evidence that a constructor name or type @n@ has a known tag in a row.+--+-- The plugin solves this by inspecting the row and emitting the tag as a+-- literal (obligation 2, design note §5).+--+-- Algorithmic Mechanics:+-- For wanted `ConstructorIndex "Bar" s`, the plugin locates `"Bar"` in the sum+-- row `s` and produces an unboxed integer literal `Lit (MachWord t)`.+type ConstructorIndex :: forall {kn} k. kn -> k -> Constraint+class ConstructorIndex (n :: kn) (row :: k) where+  constructorIndex :: Word+  constructorIndex = undefined++-- | Witness for a class constraint @c a@.+--+-- Standard GADT representation of an explicit typeclass dictionary.+data Dict (c :: Type -> Constraint) (a :: Type) where+  Dict :: c a => Dict c a++-- | Evidence that all fields of a row satisfy some class.+--+-- @DictAny c@ is the type-erased form of @c Any@, mirroring @large-anon@'s+-- dictionary packing. It is what lets one dictionary carry many field+-- dictionaries without a type-level list of them.+--+-- Algorithmic Mechanics:+-- Under the hood, GHC typeclass dictionaries are ordinary record values containing+-- function pointers (vtable). Because all boxed heap objects have identical runtime+-- representation (a pointer), a dictionary for `c a` can be coerced to `c Any` via+-- 'noInlineUnsafeCo'. At point of consumption, passing an `Any` value cast from `a`+-- to a method in `c Any` is completely type-safe because the vtable functions match+-- the actual runtime type of the value.+data DictAny (c :: Type -> Constraint) where+  DictAny :: c Any => DictAny c++-- | Wrap a class dictionary into t'DictAny'.+mkDictAny :: forall c a. c a => DictAny c+mkDictAny = aux (noInlineUnsafeCo (Dict :: Dict c a) :: Dict c Any)+  where+    aux :: Dict c Any -> DictAny c+    aux Dict = DictAny++-- | Construct evidence for the 'AllFields' class.+--+-- Takes a list of type-erased dictionaries and places them into a contiguous+-- 'SmallArray' for O(1) indexed lookup during generic loops.+{-# NOINLINE evidenceAllFields #-}+evidenceAllFields :: forall c. [DictAny c] -> DictAllFields c+evidenceAllFields = smallArrayFromList++-- | The evidence type for 'AllFields': a flat array of type-erased per-field+-- dictionaries, in row order.+type DictAllFields (c :: Type -> Constraint) = SmallArray (DictAny c)++-- | Evidence that every field in a row satisfies a class.+--+-- This is the generic dictionary-supply class the plugin solves+-- for fully-known rows. Its evidence is a flat array of type-erased field+-- dictionaries, in row order, so callers can map/fold over all fields without+-- writing per-row instances by hand.+--+-- The class is kind-polymorphic in the row parameter so the same surface can+-- be reused for the legacy @Row@ rows and for the HKD-aware product and sum rows+-- once those are layered on top. The row flavour parameter remains so the+-- plugin can distinguish product vs sum rows.+type AllFields :: forall {k}. RowType -> k -> (Type -> Constraint) -> Constraint+class RowFlavour r => AllFields (r :: RowType) (row :: k) (c :: Type -> Constraint) where+  fieldDicts :: DictAllFields c+  fieldDicts = undefined++-- | A stand-in proxy for the row flavour. This is used in the smoke test as a+-- placeholder for the row-flavour parameter of 'AllFields' until the row+-- vocabulary is finalised and the class is re-indexed.+data ProxyRowFlavour (r :: RowType) = ProxyRowFlavour+  deriving (Show)++-- | The row-flavour proxy for product rows, used in the smoke test.+type ProductRowProxy = ProxyRowFlavour ProductRowT++-- | The row-flavour proxy for sum rows, for use in the smoke test once sum+-- rows are exercised.+type SumRowProxy = ProxyRowFlavour SumRowT++-- | The row-flavour proxy for HKD product rows.+type ProductRowHKDProxy = ProxyRowFlavour ProductRowHKDT++-- | The row-flavour proxy for HKD sum rows.+type SumRowHKDProxy = ProxyRowFlavour SumRowHKDT++{-------------------------------------------------------------------------------+  Standard type class instances for RowRep (§1.7 Generic instance layer)+-------------------------------------------------------------------------------}++-- | Standard 'Eq' instance for product rows, backed by 'RowEq'.+instance RowEq ProductRowT row => Eq (RowRep f ProductRowT row a) where+  (==) = repEq++-- | Standard 'Show' instance for product rows, backed by 'RowShow'.+instance RowShow ProductRowT row => Show (RowRep f ProductRowT row a) where+  showsPrec = repShowsPrec++-- | Standard 'Ord' instance for product rows, backed by 'AllFields'.+--+-- Algorithmic Mechanics:+-- Walks the field dictionary array and the two value arrays in lockstep from+-- index 0 to N-1. For each slot, unpacks `DictAny`, casts both values to `Any`,+-- and calls `compare`. If `EQ`, advances to the next slot; otherwise immediately+-- terminates with the comparison result.+instance (RowEq ProductRowT row, AllFields ProductRowT row Ord) => Ord (RowRep f ProductRowT row a) where+  compare (RowRep r1) (RowRep r2) =+    let dicts = fieldDicts @ProductRowT @row @Ord+        v1 = repVals r1+        v2 = repVals r2+        n = sizeofSmallArray v1+        loop i+          | i == n = EQ+          | otherwise =+              case indexSmallArray dicts i of+                DictAny ->+                  let x1 :: Any+                      x1 = noInlineUnsafeCo (indexSmallArray v1 i)+                      x2 :: Any+                      x2 = noInlineUnsafeCo (indexSmallArray v2 i)+                  in case compare x1 x2 of+                       EQ -> loop (i + 1)+                       other -> other+    in loop 0++-- | Standard 'Eq' instance for HKD product rows, backed by 'RowEq'.+instance RowEq ProductRowHKDT row => Eq (RowRep f ProductRowHKDT row a) where+  (==) = repEq++-- | Standard 'Show' instance for HKD product rows, backed by 'RowShow'.+instance RowShow ProductRowHKDT row => Show (RowRep f ProductRowHKDT row a) where+  showsPrec = repShowsPrec++-- | Standard 'Ord' instance for HKD product rows, backed by 'AllFields'.+instance (RowEq ProductRowHKDT row, AllFields ProductRowHKDT row Ord) => Ord (RowRep f ProductRowHKDT row a) where+  compare (RowRep r1) (RowRep r2) =+    let dicts = fieldDicts @ProductRowHKDT @row @Ord+        v1 = repVals r1+        v2 = repVals r2+        n = sizeofSmallArray v1+        loop i+          | i == n = EQ+          | otherwise =+              case indexSmallArray dicts i of+                DictAny ->+                  let x1 :: Any+                      x1 = noInlineUnsafeCo (indexSmallArray v1 i)+                      x2 :: Any+                      x2 = noInlineUnsafeCo (indexSmallArray v2 i)+                  in case compare x1 x2 of+                       EQ -> loop (i + 1)+                       other -> other+    in loop 0++-- | Standard 'Eq' instance for sum rows, backed by 'RowEqSum'.+instance RowEqSum SumRowT row => Eq (RowRep f SumRowT row a) where+  (==) = repEqSum++-- | Standard 'Show' instance for sum rows, backed by 'RowShowSum'.+instance RowShowSum SumRowT row => Show (RowRep f SumRowT row a) where+  showsPrec = repShowsPrecSum++-- | Standard 'Eq' instance for HKD sum rows, backed by 'RowEqSum'.+instance RowEqSum SumRowHKDT row => Eq (RowRep f SumRowHKDT row a) where+  (==) = repEqSum++-- | Standard 'Show' instance for HKD sum rows, backed by 'RowShowSum'.+instance RowShowSum SumRowHKDT row => Show (RowRep f SumRowHKDT row a) where+  showsPrec = repShowsPrecSum++{-------------------------------------------------------------------------------+  §5b  Subrow and Subsum evidence classes+-------------------------------------------------------------------------------}++-- | Sub-row relationship between two product rows.+--+-- [ref:note-subrow-subsum] [ref:note-subrow-subsum-mechanics]+-- @'SubRow' sub super@ holds when every field in @sub@ occurs in @super@ with+-- the same field type. The plugin emits the 0-based projection slot indices+-- as evidence.+--+-- Algorithmic Mechanics:+-- For sub-record projection `projectRecord @sub superRec`, the runtime must extract+-- the subset of fields in @sub@ from @super@. The @subRowIndices@ method returns a+-- precomputed permutation vector `[Int]` containing the exact slot indices in @super@.+-- This allows projection to execute in a single O(|sub|) pass with zero type search.+type SubRow :: forall {k1} {k2}. k1 -> k2 -> Constraint+class SubRow (sub :: k1) (super :: k2) where+  -- | For each field in @sub@, its 0-based slot index in @super@.+  subRowIndices :: [Int]+  subRowIndices = undefined++-- | Sub-sum relationship between two sum rows (variant widening & narrowing).+--+-- [ref:note-subrow-subsum] [ref:note-subrow-subsum-mechanics]+-- @'SubSum' sub super@ holds when every constructor in @sub@ occurs in @super@+-- with identical field rows. The plugin emits the injection tag indices+-- (for widening) and narrowing tag indices (for projection) as evidence.+--+-- Algorithmic Mechanics:+-- 1. Widening (`widenVariant`):+--    Total and O(1). Every constructor in @sub@ is present in @super@. The runtime tag+--    `t` in @sub@ is mapped to `subSumInjectIndices !! fromIntegral t`, which is+--    precomputed by the plugin.+-- 2. Narrowing (`narrowVariant`):+--    Partial and O(1). Inspects `subSumNarrowIndices !! fromIntegral t`. If the constructor+--    is present in @sub@, returns `Just subTag`; otherwise `Nothing`.+type SubSum :: forall {k1} {k2}. k1 -> k2 -> Constraint+class SubSum (sub :: k1) (super :: k2) where+  -- | For each constructor in @sub@, its tag in @super@ (widening).+  subSumInjectIndices :: [Word]+  subSumInjectIndices = undefined++  -- | For each constructor in @super@, its tag in @sub@ if present, or 'Nothing'+  -- if it does not belong to @sub@ (narrowing).+  subSumNarrowIndices :: [Maybe Word]+  subSumNarrowIndices = undefined++{-------------------------------------------------------------------------------+  §5c  Compile-time label hashing+-------------------------------------------------------------------------------}++-- | Class providing a compile-time hash for a label 'Symbol'.+--+-- The @TcPlugin@ solves this by evaluating the hash (FNV-1a 64-bit) of the literal+-- symbol at compile time and emitting a literal 'Word' dictionary.+--+-- == Purpose and Non-Purpose+--+-- * __Purpose:__ @'KnownHash'@ provides O(1) integer keys for dynamic/HAMT label+--   dispatch, label interning, and name-based field lookup without requiring+--   'GHC.TypeLits.KnownSymbol' dictionary plumbing or runtime string hashing in hot paths.+--+-- * __Non-purpose:__ @'KnownHash'@ is /not/ used for slot offset indexing in+--   records and sums. Record slot access in @polytropos@ is statically determined+--   at compile time by 'FieldIndex' and 'ConstructorIndex' (0, 1, 2, ...), which are+--   dense, collision-free literal offsets into 'Polytropos.Rep.repVals'.+--+-- Algorithmic Mechanics:+-- The FNV-1a 64-bit algorithm evaluates over the UTF-8 bytes of the label string:+--   hash = 14695981039346656037 (offset basis)+--   for each byte c:+--     hash = (hash `xor` c) * 1099511628211 (prime)+type KnownHash :: Symbol -> Constraint+class KnownHash (s :: Symbol) where+  -- | Literal compile-time hash for label @s@.+  knownHash :: Word+  knownHash = undefined++-- | Ergonomic helper to extract the compile-time hash of a label via a proxy+-- (such as t'Field' or 'Data.Proxy.Proxy').+labelHash :: forall (s :: Symbol) proxy. KnownHash s => proxy s -> Word+labelHash _ = knownHash @s++-- | Synonymous with 'labelHash' for compatibility with large-record conventions.+hashVal :: forall (s :: Symbol) proxy. KnownHash s => proxy s -> Word+hashVal _ = knownHash @s++-- | FNV-1a 64-bit hash of a 'String', matching the hash computed at compile-time+-- by the @TcPlugin@ for 'KnownHash'.+fnv1a64 :: String -> Word+fnv1a64 str = fromIntegral (foldl' step (14695981039346656037 :: Word64) str)+  where+    step !h !c = (h `xor` fromIntegral (ord c)) * 1099511628211++{-------------------------------------------------------------------------------+  §6  Utilities+-------------------------------------------------------------------------------}++-- | @unsafeCoerce@ that survives GHC's Core linter.+--+-- Must be marked @NOINLINE@: @large-anon@ found that without it, GHC 9.6+-- produces @-dcore-lint@ errors for the evidence built on top of this.+--+-- Algorithmic Mechanics & Compiler Safety Invariant:+-- In modern GHC (9.6 through 9.14+), the Core simplifier performs aggressive+-- inlining and floating of coercions. If an unchecked coercion is marked inlineable,+-- GHC's simplifier may attempt to float the cast outside of enclosing lambdas or+-- push it across case branches where the type invariants are not yet established.+-- When running with @-dcore-lint@, this causes fatal Core Lint failures.+-- Marking 'noInlineUnsafeCo' as @{-# NOINLINE #-}@ establishes an impenetrable+-- optimization barrier, preventing the simplifier from inspecting or hoisting+-- the underlying @unsafeCoerce#@ primitive while still emitting zero runtime instructions.+noInlineUnsafeCo :: a -> b+{-# NOINLINE noInlineUnsafeCo #-}+noInlineUnsafeCo = unsafeCoerce

@@ -0,0 +1,434 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeOperators #-}+{-# OPTIONS_GHC -Wno-orphans #-}++-- | Tests for @Polytropos.Core@.+--+-- The 'RowEq' and 'RowShow' instances here are written by hand and stand in for+-- what the TcPlugin will synthesise. They are deliberately literal: a fixed+-- number of slot comparisons at fixed indices, with no type-level search. That+-- is exactly the property the plugin has to reproduce, so these tests double as+-- the specification of what the plugin must emit.+--+-- Representations are built at @f ~ Identity@, where @Rep Identity a@ is+-- isomorphic to @a@ and each slot holds a concrete value. Reading a slot is+-- two coercions — 'fieldAt' yields @Identity x@, then 'unslot' recovers @x@ —+-- and the expected value in each assertion supplies the type @x@. That is+-- precisely the information the plugin will get from the row instead.+--+-- The evidence classes now work over 'RowRep' (the row-carrying wrapper) with+-- no 'Proxy' argument, as specified by Phase 1 decision 1c (Case 3) and the+-- Phase 2 sketch (Sketch B). The row flavour ('ProductRowT') and the row data+-- ('R2') are passed as type parameters to the evidence class.+module Main (main) where++import Control.Monad.ST             (runST)+import Data.Functor.Identity        (Identity(..))+import Data.Primitive.SmallArray    (indexSmallArray)+import GHC.Exts                     (Any)+import Test.Tasty                  (TestTree, defaultMain, testGroup)+import Test.Tasty.HUnit            (testCase, (@?=))++import Polytropos.Core+import Polytropos++{-------------------------------------------------------------------------------+  Slot helpers+-------------------------------------------------------------------------------}++-- | Store a concrete value in a slot.+slot :: a -> Identity Any+slot = noInlineUnsafeCo++-- | Read a concrete value out of a slot.+unslot :: Identity Any -> a+unslot = noInlineUnsafeCo++-- | Read slot @0@ as an @Int@.+--+-- Polymorphic in @f@ so the same reader serves both the @Identity@-specialised+-- tests and the polymorphic dictionary bodies.+intAt0 :: forall f a. Rep f a -> Int+intAt0 = noInlineUnsafeCo . indexAt 0++-- | Read slot @1@ as an @Int@.+intAt1 :: forall f a. Rep f a -> Int+intAt1 = noInlineUnsafeCo . indexAt 1++-- | Read slot @1@ as a @Bool@.+boolAt1 :: forall f a. Rep f a -> Bool+boolAt1 = noInlineUnsafeCo . indexAt 1++-- | Read a raw slot.+indexAt :: forall f a. Int -> Rep f a -> f Any+indexAt i r = indexSmallArray (repVals r) i++{-------------------------------------------------------------------------------+  Rows under test+-------------------------------------------------------------------------------}++-- | A two-field product: @a :: Int@, @b :: Bool@.+type R2 = '[ "a" := Int, "b" := Bool ]++-- | A type-level proxy for R2, used to avoid kind issues with type synonyms.+-- The row data parameter of 'RowRep' and the evidence classes expects a type+-- of kind 'Type', but type synonyms for type-level lists can cause kind+-- inference issues. This proxy wraps the type-level list in a 'Proxy' to+-- give it an explicit kind.+--+-- Note: This is a workaround for a GHC kind inference issue. In GHC 9.14,+-- type synonyms for type-level lists may not be recognized as having kind+-- 'Type' in all contexts. Wrapping in 'Proxy' forces the kind to be 'Type'.+++{-------------------------------------------------------------------------------+  Hand-written evidence: the plugin's job, done manually+-------------------------------------------------------------------------------}++-- | Field-wise equality for the @R2@ product row.+--+-- This instance is written by hand and stands in for what the TcPlugin will+-- emit. It is deliberately literal: it compares the tags, arities, and the+-- two field slots at fixed indices (0 and 1), with no type-level search.+--+-- The instance is indexed by the row flavour (@ProductRowT@) and the row data+-- (@R2@), as specified by the Phase 2 sketch (Sketch B). The 'RowRep' wrapper+-- carries the row in its type, so no 'Proxy' argument is needed.+instance RowEq ProductRowT R2 where+  repEq (RowRep r1) (RowRep r2) =+    repTag r1 == repTag r2+      && repArity r1 == repArity r2+      && intAt0 r1 == intAt0 r2+      && boolAt1 r1 == boolAt1 r2++-- | Field-wise @Show@ for the @R2@ product row.+--+-- This instance is written by hand and stands in for what the TcPlugin will+-- emit. It renders the row as @"R2 " @ followed by the two field values.+--+-- See 'RowEq R2' for the design rationale.+instance RowShow ProductRowT R2 where+  repShowsPrec _ (RowRep r) =+    showString "R2 " . shows (intAt0 r) . showChar ' ' . shows (boolAt1 r)++-- | Field-wise equality for a sum row with one constructor.+instance RowEqSum SumRowT '[ "neg" := '[ Int ] ] where+  repEqSum (RowRep r1) (RowRep r2) =+    repTag r1 == repTag r2+      && repArity r1 == repArity r2+      && intAt0 r1 == intAt0 r2++{-------------------------------------------------------------------------------+  Fixtures+-------------------------------------------------------------------------------}++-- | @R2@ holding @a = 7@, @b = True@, wrapped in 'RowRep'.+--+-- The 'RowRep' wrapper carries the row flavour (@ProductRowT@) and the row+-- data (@R2@) in its type, so that the evidence classes can work over it+-- without a 'Proxy' argument.+ab :: RowRep Identity ProductRowT R2 (Int, Bool)+ab = RowRep (productRep [slot (7 :: Int), slot True])++{-------------------------------------------------------------------------------+  Tests+-------------------------------------------------------------------------------}++productTests :: TestTree+productTests = testGroup "products"+  [ testCase "a product's tag is zero" $+      repTag (unRowRep ab) @?= 0+  , testCase "arity is the number of fields" $+      repArity (unRowRep ab) @?= 2+  , testCase "fieldAt reads slot 0" $+      unslot (fieldAt 0 (unRowRep ab)) @?= (7 :: Int)+  , testCase "fieldAt reads slot 1" $+      unslot (fieldAt 1 (unRowRep ab)) @?= True+  , testCase "setFieldAt updates index 0 and leaves index 1 unchanged" $ do+      let r = setFieldAt 0 (slot (9 :: Int)) (unRowRep ab)+      unslot (fieldAt 0 r) @?= (9 :: Int)+      unslot (fieldAt 1 r) @?= True+  , testCase "setFieldAt updates index 1 and leaves index 0 unchanged" $ do+      let r = setFieldAt 1 (slot False) (unRowRep ab)+      unslot (fieldAt 0 r) @?= (7 :: Int)+      unslot (fieldAt 1 r) @?= False+  , testCase "setFieldAt preserves tag" $ do+      repTag (setFieldAt 0 (slot (9 :: Int)) (unRowRep ab)) @?= 0+      repTag (setFieldAt 1 (slot False) (unRowRep ab)) @?= 0+  , testCase "setFieldAt preserves arity" $ do+      repArity (setFieldAt 0 (slot (9 :: Int)) (unRowRep ab)) @?= 2+      repArity (setFieldAt 1 (slot False) (unRowRep ab)) @?= 2+  , testCase "setFieldsAt updates multiple fields simultaneously" $ do+      let r = setFieldsAt [(0, slot (42 :: Int)), (1, slot False)] (unRowRep ab)+      unslot (fieldAt 0 r) @?= (42 :: Int)+      unslot (fieldAt 1 r) @?= False+  , testCase "setFieldsAt with empty updates is identity" $ do+      let r = setFieldsAt [] (unRowRep ab)+      unslot (fieldAt 0 r) @?= (7 :: Int)+      unslot (fieldAt 1 r) @?= True+  , testCase "modifyRep executes chained in-place mutations" $ do+      let r = modifyRep (unRowRep ab) $ \m -> do+                writeFieldAt m 0 (slot (99 :: Int))+                writeFieldAt m 1 (slot False)+      unslot (fieldAt 0 r) @?= (99 :: Int)+      unslot (fieldAt 1 r) @?= False+  , testCase "thawRep and freezeRep round-trip" $ do+      let r = runST $ do+                m <- thawRep (unRowRep ab)+                writeFieldAt m 0 (slot (100 :: Int))+                freezeRep m+      unslot (fieldAt 0 r) @?= (100 :: Int)+      unslot (fieldAt 1 r) @?= True+  , testCase "the empty product has arity zero" $+      repArity (productRep ([] :: [Identity Any])) @?= 0+  ]++sumTests :: TestTree+sumTests = testGroup "sums"+  [ testCase "the tag records the constructor index" $+      repTag (injectRep 1 [slot True]) @?= 1+  , testCase "arity is the selected constructor's arity" $+      repArity (injectRep 0 [slot (3 :: Int)]) @?= 1+  , testCase "injectRep preserves the payload" $+      unslot (fieldAt 0 (injectRep 0 [slot (3 :: Int)])) @?= (3 :: Int)+  , testCase "projectRep succeeds on a matching tag" $+      (case projectRep 1 (injectRep 1 [slot True]) of+         Just r  -> repArity r == 1+         Nothing -> False) @?= True+  , testCase "projectRep fails on a mismatched tag" $+      (case projectRep 0 (injectRep 1 [slot True]) of+         Just _  -> False+         Nothing -> True) @?= True+  , testCase "projectRep round-trips the payload" $ do+      let got = case projectRep 0 (injectRep 0 [slot (42 :: Int)]) of+                  Just r -> Just (unslot (fieldAt 0 r) :: Int)+                  _      -> Nothing+      got @?= Just 42+  , testCase "projectRep round-trips at a non-zero tag" $ do+      let got = case projectRep 7 (injectRep 7 [slot (11 :: Int)]) of+                  Just r -> Just (unslot (fieldAt 0 r) :: Int)+                  _      -> Nothing+      got @?= Just 11+  , testCase "projectRepList round-trips payload as a list" $ do+      let got = case projectRepList 7 (injectRep 7 [slot (11 :: Int)]) of+                  Just [x] -> Just (unslot (x :: Identity Any) :: Int)+                  _        -> Nothing+      got @?= Just 11+  , testCase "matchRep observes the tag" $+      matchRep (\t _ -> t) (injectRep 3 []) @?= (3 :: Word)+  , testCase "matchRep observes the payload" $+      matchRep (\_ xs -> length xs) (injectRep 0 [slot (1 :: Int), slot (2 :: Int)])+        @?= 2+  , testCase "constructors of different arity coexist" $+      map repArity [injectRep 0 [slot (1 :: Int)], injectRep 1 [slot True, slot False]]+        @?= [1, 2]+  ]++evidenceTests :: TestTree+evidenceTests = testGroup "evidence classes (hand-written)"+  [ testCase "repEq is reflexive" $+      repEq ab ab @?= True+  , testCase "repEq detects a differing slot" $+      repEq ab (RowRep (productRep [slot (7 :: Int), slot False])) @?= False+  , testCase "repEqSum detects a differing tag" $+      repEqSum+        (RowRep (injectRep 0 [slot (7 :: Int), slot True]) :: RowRep Identity SumRowT ('[ "neg" := '[ Int ] ]) (Int, Int))+        (RowRep (injectRep 1 [slot (7 :: Int), slot True]) :: RowRep Identity SumRowT ('[ "neg" := '[ Int ] ]) (Int, Int))+        @?= False+  , testCase "repEq detects a differing arity" $+      repEq ab (RowRep (productRep [slot (7 :: Int)])) @?= False+  , testCase "repShowsPrec renders both fields" $+      repShowsPrec 0 ab "" @?= "R2 7 True"+  , testCase "intAt1 sees the rewritten slot" $+      intAt1 (setFieldAt 1 (slot (5 :: Int)) (unRowRep ab)) @?= 5+  ]++{-------------------------------------------------------------------------------+  Consumer API Tests+-------------------------------------------------------------------------------}++type TwoSum = '[ "Neg" ':= '[ "v" ':= Int ], "Pos" ':= '[ "v" ':= Int ] ]+type ResRow = '[ "Neg" ':= '[ "out" ':= Int ], "Pos" ':= '[ "out" ':= Int ] ]++instance ConstructorIndex "Neg" TwoSum where+  constructorIndex = 0++instance ConstructorIndex "Pos" TwoSum where+  constructorIndex = 1++instance ConstructorIndex "Pos" '[ "Pos" ':= '[ "v" ':= Int ] ] where+  constructorIndex = 0++instance ConstructorIndex "Neg" '[ "Neg" ':= '[ "v" ':= Int ] ] where+  constructorIndex = 0++consumerTests :: TestTree+consumerTests = testGroup "consumer api (Polytropos)"+  [ testCase "emptyRecord has arity 0" $+      repArity (unRowRep emptyRecord) @?= 0+  , testCase "insertField builds record" $ do+      let r = insertField (Field @"a") (42 :: Int) emptyRecord+      unslot (fieldAt 0 (unRowRep r)) @?= (42 :: Int)+      repArity (unRowRep r) @?= 1+  , testCase "Variant pattern and injection" $ do+      let r = insertField (Field @"v") (7 :: Int) emptyRecord+          v :: Variant ('[ "Neg" ':= '[ "v" ':= Int ] ])+          v = Variant (Field @"Neg") r+      case v of+        Variant (Field :: Field "Neg") r' -> unslot (fieldAt 0 (unRowRep r')) @?= (7 :: Int)+        _ -> error "Pattern match failed"+  , testCase "peel isolates target constructor" $ do+      let r = insertField (Field @"v") (10 :: Int) emptyRecord+          v = injectVariant (Field @"Neg") r :: Variant TwoSum+      case peel @"Neg" v of+        Right r' -> unslot (fieldAt 0 (unRowRep r')) @?= (10 :: Int)+        Left _   -> error "Expected Right on matching constructor"+  , testCase "peel remaps tag on non-matching constructor" $ do+      let r = insertField (Field @"v") (20 :: Int) emptyRecord+          v = injectVariant (Field @"Pos") r :: Variant TwoSum+      case peel @"Neg" v of+        Left (remV :: Variant '[ "Pos" ':= '[ "v" ':= Int ] ]) ->+          repTag (unRowRep remV) @?= 0+        Right _ -> error "Expected Left on non-matching constructor"+  , testCase "eliminateUniform dispatches to matching handler in O(1)" $ do+      let rNeg = insertField (Field @"v") (7 :: Int) emptyRecord+          rPos = insertField (Field @"v") (7 :: Int) emptyRecord+          vNeg = injectVariant (Field @"Neg") rNeg :: Variant TwoSum+          vPos = injectVariant (Field @"Pos") rPos :: Variant TwoSum+          handlers = insertField (Field @"Neg") (\r -> -(unslot (fieldAt 0 (unRowRep r)) :: Int))+                   $ insertField (Field @"Pos") (\r -> (unslot (fieldAt 0 (unRowRep r)) :: Int))+                   $ emptyRecord+      eliminateUniform handlers vNeg @?= (-7)+      eliminateUniform handlers vPos @?= 7+      matchVariant vNeg handlers @?= (-7)+  , testCase "eliminateUniformM dispatches inside monad" $ do+      let rNeg = insertField (Field @"v") (3 :: Int) emptyRecord+          vNeg = injectVariant (Field @"Neg") rNeg :: Variant TwoSum+          handlersM = insertField (Field @"Neg") (\r -> pure (-(unslot (fieldAt 0 (unRowRep r)) :: Int)))+                    $ insertField (Field @"Pos") (\r -> pure ((unslot (fieldAt 0 (unRowRep r)) :: Int)))+                    $ emptyRecord+      eliminateUniformM handlersM vNeg @?= Just (-3)+  , testCase "eliminate produces heterogeneous Variant result" $ do+      let rNeg = insertField (Field @"v") (4 :: Int) emptyRecord+          rPos = insertField (Field @"v") (4 :: Int) emptyRecord+          vNeg = injectVariant (Field @"Neg") rNeg :: Variant TwoSum+          vPos = injectVariant (Field @"Pos") rPos :: Variant TwoSum+          hHet = insertField (Field @"Neg") (\r -> insertField (Field @"out") (-(unslot (fieldAt 0 (unRowRep r)) :: Int)) emptyRecord)+               $ insertField (Field @"Pos") (\r -> insertField (Field @"out") ((unslot (fieldAt 0 (unRowRep r)) :: Int) * 10) emptyRecord)+               $ emptyRecord+          outNeg = eliminate @_ @ResRow hHet vNeg+          outPos = eliminate @_ @ResRow hHet vPos+      repTag (unRowRep outNeg) @?= 0+      repTag (unRowRep outPos) @?= 1+  ]++{-------------------------------------------------------------------------------+  Milestone T3: Hardware-vectorized SIMD CoW tests (records > 32 fields)+-------------------------------------------------------------------------------}++simdTests :: TestTree+simdTests = testGroup "simd-cow (records > 32 fields)"+  [ testCase "setFieldAt on 64-field record correctly updates index 0" $ do+      let n = 64+          initial = productRep [slot (i :: Int) | i <- [0 .. n - 1]]+          updated = setFieldAt 0 (slot (999 :: Int)) initial+      repArity updated @?= n+      repTag updated @?= 0+      unslot (fieldAt 0 updated) @?= (999 :: Int)+      map (\i -> unslot (fieldAt i updated) :: Int) [1 .. n - 1] @?= [1 .. n - 1]++  , testCase "setFieldAt on 64-field record correctly updates middle and last slots" $ do+      let n = 64+          initial = productRep [slot (i :: Int) | i <- [0 .. n - 1]]+          updMid = setFieldAt 32 (slot (777 :: Int)) initial+          updLast = setFieldAt 63 (slot (888 :: Int)) updMid+      unslot (fieldAt 32 updLast) @?= (777 :: Int)+      unslot (fieldAt 63 updLast) @?= (888 :: Int)+      unslot (fieldAt 0 updLast) @?= (0 :: Int)+      unslot (fieldAt 31 updLast) @?= (31 :: Int)+      unslot (fieldAt 33 updLast) @?= (33 :: Int)++  , testCase "setFieldAt on 100-field record scales cleanly" $ do+      let n = 100+          initial = productRep [slot (i * 2 :: Int) | i <- [0 .. n - 1]]+          updated = setFieldAt 99 (slot (12345 :: Int)) initial+      repArity updated @?= 100+      unslot (fieldAt 99 updated) @?= (12345 :: Int)+      unslot (fieldAt 0 updated) @?= (0 :: Int)+      unslot (fieldAt 50 updated) @?= (100 :: Int)++  , testCase "setFieldsAt batch updates multiple slots in 64-field record" $ do+      let n = 64+          initial = productRep [slot (i :: Int) | i <- [0 .. n - 1]]+          batch = [(0, slot (100 :: Int)), (15, slot (200 :: Int)), (32, slot (300 :: Int)), (63, slot (400 :: Int))]+          updated = setFieldsAt batch initial+      repArity updated @?= 64+      unslot (fieldAt 0 updated) @?= (100 :: Int)+      unslot (fieldAt 15 updated) @?= (200 :: Int)+      unslot (fieldAt 32 updated) @?= (300 :: Int)+      unslot (fieldAt 63 updated) @?= (400 :: Int)+      unslot (fieldAt 1 updated) @?= (1 :: Int)+      unslot (fieldAt 14 updated) @?= (14 :: Int)+      unslot (fieldAt 16 updated) @?= (16 :: Int)+      unslot (fieldAt 31 updated) @?= (31 :: Int)+      unslot (fieldAt 62 updated) @?= (62 :: Int)++  , testCase "setFieldsAt on 100-field record handles sorted and unsorted batches" $ do+      let n = 100+          initial = productRep [slot (i :: Int) | i <- [0 .. n - 1]]+          batch = [(90, slot (990 :: Int)), (10, slot (110 :: Int)), (50, slot (550 :: Int))]+          updated = setFieldsAt batch initial+      repArity updated @?= 100+      unslot (fieldAt 10 updated) @?= (110 :: Int)+      unslot (fieldAt 50 updated) @?= (550 :: Int)+      unslot (fieldAt 90 updated) @?= (990 :: Int)+      unslot (fieldAt 99 updated) @?= (99 :: Int)++  , testCase "MRep fast-path batch write and slice copy on 64-field builder" $ do+      let n = 64+          initial = productRep [slot (i :: Int) | i <- [0 .. n - 1]]+          res = runST $ do+            m <- thawRep initial+            writeFieldsAt m [(5, slot (555 :: Int)), (35, slot (355 :: Int))]+            freezeRep m+      unslot (fieldAt 5 res) @?= (555 :: Int)+      unslot (fieldAt 35 res) @?= (355 :: Int)+      unslot (fieldAt 0 res) @?= (0 :: Int)++  , testCase "MRep newMRep and copyFieldsFrom block copies" $ do+      let n = 64+          src = productRep [slot (i :: Int) | i <- [0 .. n - 1]]+          res = runST $ do+            dst <- newMRep 0 n (slot (0 :: Int))+            copyFieldsFrom src 10 dst 10 40+            freezeRep dst+      unslot (fieldAt 0 res) @?= (0 :: Int)+      unslot (fieldAt 9 res) @?= (0 :: Int)+      unslot (fieldAt 10 res) @?= (10 :: Int)+      unslot (fieldAt 49 res) @?= (49 :: Int)+      unslot (fieldAt 50 res) @?= (0 :: Int)++  , testCase "thawRepSlice and copyMFields between builders" $ do+      let n = 64+          src = productRep [slot (i * 10 :: Int) | i <- [0 .. n - 1]]+          res = runST $ do+            sub <- thawRepSlice src 20 10+            dst <- newMRep 0 10 (slot (0 :: Int))+            copyMFields sub 0 dst 0 10+            freezeRep dst+      repArity res @?= 10+      unslot (fieldAt 0 res) @?= (200 :: Int)+      unslot (fieldAt 9 res) @?= (290 :: Int)+  ]++main :: IO ()+main = defaultMain $ testGroup "polytropos-core"+  [ productTests+  , sumTests+  , evidenceTests+  , consumerTests+  , simdTests+  ]