heph-aligned-storable (empty) → 0.1.0.0

raw patch · 11 files changed

+4431/−0 lines, 11 filesdep +basedep +bytestringdep +halfsetup-changed

Dependencies added: base, bytestring, half, hashable, hedgehog, heph-aligned-storable, lifted-base, linear, monad-control, tasty, tasty-discover, tasty-hedgehog, tasty-hunit, tasty-inspection-testing, unliftio, vector, vector-sized

Files

• CHANGELOG.md +20/−0
• LICENSE +26/−0
• README.md +103/−0
• Setup.hs +3/−0
• heph-aligned-storable.cabal +82/−0
• src/Foreign/GPU/Marshal/Aligned.hs +110/−0
• src/Foreign/GPU/Storable/Aligned.hs +1216/−0
• test/Driver.hs +1/−0
• test/Foreign/GPU/Marshal/AlignedSpec.hs +113/−0
• test/Foreign/GPU/Storable/AlignedInspectionSpec.hs +309/−0
• test/Foreign/GPU/Storable/AlignedSpec.hs +2448/−0

@@ -0,0 +1,20 @@+# Changelog for `heph-aligned-storable`++All notable changes to this project will be documented in this file.++The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/),+and this project adheres to the+[Haskell Package Versioning Policy](https://pvp.haskell.org/).++## Unreleased++## 0.1.0.0 - 2026-02-02++### Added++- Initial release. Generic derivation of `AlignedStorable` for GPU memory layouts.+- Provided instances for `Std140`, `Std430`, and `Scalar` layout rules.+- Added support for SPIR-V primitives, vectors, and matrices.+- Included `AlignedArray` for opt-in `memcpy` of fixed-size arrays.+- Added marshaling helpers (`withPacked`, `allocaPacked`) with guaranteed zero-initialized padding.+- Tested via property-based tests, unit tests verified against GLSL compiler output, and inspection tests.

@@ -0,0 +1,26 @@+Copyright 2025 Jeremy Nuttall++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++1.  Redistributions of source code must retain the above copyright notice, this+    list of conditions and the following disclaimer.++2.  Redistributions in binary form must reproduce the above copyright notice,+    this list of conditions and the following disclaimer in the documentation+    and/or other materials provided with the distribution.++3.  Neither the name of the copyright holder nor the names of its contributors+    may be used to endorse or promote products derived from this software+    without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON+ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,103 @@+# heph-aligned-storable++Generically derive `Storable` instances for GPU memory layouts (`std140`, `std430`, `scalar`).++[![CI](https://github.com/jtnuttall/heph/actions/workflows/haskell.yml/badge.svg)](https://github.com/jtnuttall/heph/actions/workflows/haskell.yml)++<!-- [![Hackage](https://img.shields.io/hackage/v/heph-aligned-storable.svg)](https://hackage.haskell.org/package/heph-aligned-storable) -->++## Quick Start++**IMPORTANT**: Be sure to use `layout(row_major)` if you are using `linear` with this library.++GLSL:++```glsl+layout(std140, row_major, binding = 0) uniform myuniforms {+  mat4 modelViewProjection;+  vec3 cameraPosition;+  float time;+};+```++Haskell:++```haskell+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeApplications #-}++import Foreign.GPU.Storable.Aligned+import Foreign.GPU.Marshal.Aligned+import GHC.Generics (Generic)+import Linear (M44, V3, V4(..))++data Uniforms = Uniforms+  { modelViewProjection :: M44 Float+  , cameraPosition      :: V3 Float+  , time                :: Float+  } deriving (Generic, Show, Eq)++instance AlignedStorable Std140 Uniforms++main :: IO ()+main = do+  let uniforms = Uniforms+        { modelViewProjection = V4 (V4 1 0 0 0) (V4 0 1 0 0) (V4 0 0 1 0) (V4 0 0 0 1)+        , cameraPosition = V3 0 0 5+        , time = 0+        }+  withPacked @Std140 uniforms $ \ptr -> do+    -- ptr is ready for vkCmdPushConstants, memcpy to mapped buffer, etc.+    pure ()+```++## Features++- Correct, spec-compliant padding for `Std140`, `Std430`, and `Scalar` layouts+- Single `memcpy` for arrays via `AlignedArray`+- Type-level layout witnesses prevent mismatched layouts at compile time+- Zero runtime overhead—generic machinery fully eliminated by GHC++## The Contract++**`alignedPoke` writes member data only. Padding bytes are untouched.**++Use the helpers in `Foreign.GPU.Marshal.Aligned` (`withPacked`, `allocaPacked`, etc.) for guaranteed zero-initialized padding. If you allocate memory yourself, use `calloc` or zero the buffer before poking.++## Arrays++By default, arrays are poked element-by-element. For a single `memcpy`, wrap in `AlignedArray`:++```haskell+data MyStruct (layout :: MemoryLayout) = MyStruct+  { meta   :: Float+  , pixels :: AlignedArray layout 64 (V4 Float)  -- memcpy'd as a block+  } deriving Generic++instance AlignedStorable Std140 (MyStruct Std140)+```++## Gotchas++### Matrix naming conventions++`linear` uses `Mnm` for n rows × m columns. GLSL uses `matNxM` for N columns of M-vectors.++- `M32 Float` (3 rows, 2 cols) → `mat2x3`+- `M24 Double` (2 rows, 4 cols) → `dmat4x2`++### `row_major`++GLSL's `layout(row_major)` affects memory layout, not matrix semantics. Matrices are still column-major for arithmetic. This library implements the memory layout correctly. You don't need to transpose before upload.++### `vec3` and `mat3` are cursed++Driver handling of the round-up rules for these types has historically been inconsistent. Consider padding to `vec4`/`mat4` and pretending the 3-element variants don't exist.++## Why not `derive-storable`?++`derive-storable` produces FFI-compatible layouts (C struct ABI), not GPU layouts. GPU alignment rules differ:++- `std140` rounds struct alignment to 16 bytes+- `scalar` layout requires 4-byte booleans, not 1-byte

@@ -0,0 +1,3 @@+import Distribution.Simple++main = defaultMain

@@ -0,0 +1,82 @@+cabal-version: 2.2++-- This file has been generated from package.yaml by hpack version 0.39.1.+--+-- see: https://github.com/sol/hpack++name:           heph-aligned-storable+version:        0.1.0.0+synopsis:       Generically derive Storable instances suitable for CPU-GPU transfer+description:    Please see the README on GitHub at <https://github.com/jtnuttall/heph/tree/main/heph-aligned-storable#readme>+category:       Graphics+homepage:       https://github.com/jtnuttall/heph/tree/main/heph-aligned-storable#readme+bug-reports:    https://github.com/jtnuttall/heph/issues+author:         Jeremy Nuttall+maintainer:     jeremy@jeremy-nuttall.com+copyright:      2025 Jeremy Nuttall+license:        BSD-3-Clause+license-file:   LICENSE+build-type:     Simple+tested-with:+    GHC == 9.8.4 || == 9.6.5 || == 8.10.7 || == 8.10.4+extra-doc-files:+    README.md+    CHANGELOG.md++source-repository head+  type: git+  location: https://github.com/jtnuttall/heph++library+  exposed-modules:+      Foreign.GPU.Marshal.Aligned+      Foreign.GPU.Storable.Aligned+  other-modules:+      Paths_heph_aligned_storable+  autogen-modules:+      Paths_heph_aligned_storable+  hs-source-dirs:+      src+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints+  build-depends:+      base >=4.7 && <5+    , half >=0.3 && <0.5+    , hashable >=1.3 && <1.6+    , linear >=1.20 && <1.24+    , unliftio ==0.2.*+    , vector >=0.12.3.0 && <0.14+    , vector-sized >=1.4 && <1.7+  default-language: Haskell2010++test-suite heph-aligned-storable-test+  type: exitcode-stdio-1.0+  main-is: Driver.hs+  other-modules:+      Foreign.GPU.Marshal.AlignedSpec+      Foreign.GPU.Storable.AlignedInspectionSpec+      Foreign.GPU.Storable.AlignedSpec+      Paths_heph_aligned_storable+  autogen-modules:+      Paths_heph_aligned_storable+  hs-source-dirs:+      test+  ghc-options: -Wall -Wcompat -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      base >=4.7 && <5+    , bytestring >=0.10 && <0.13+    , half >=0.3 && <0.5+    , hashable >=1.3 && <1.6+    , hedgehog >=1.0.4 && <1.6+    , heph-aligned-storable+    , lifted-base ==0.2.*+    , linear >=1.20 && <1.24+    , monad-control ==1.0.*+    , tasty >=1.4.1 && <1.6+    , tasty-discover >=4.2.1 && <6+    , tasty-hedgehog >=1.1 && <1.5+    , tasty-hunit ==0.10.*+    , tasty-inspection-testing >=0.1 && <0.3+    , unliftio ==0.2.*+    , vector >=0.12.3.0 && <0.14+    , vector-sized >=1.4 && <1.7+  default-language: Haskell2010

@@ -0,0 +1,110 @@+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RoleAnnotations #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE NoMonomorphismRestriction #-}++-- |+-- Description : Zero-initialized allocation for GPU-aligned types+-- Copyright   : (c) Jeremy Nuttall, 2025+-- License     : BSD-3-Clause+-- Maintainer  : jeremy@jeremy-nuttall.com+-- Stability   : experimental+--+-- Allocation helpers with guaranteed zero-initialized padding.+-- Use these instead of 'alloca' or 'malloc' to avoid garbage in padding bytes.+module Foreign.GPU.Marshal.Aligned (+  -- * Utilities for 'Packed' values+  PackedPtr,+  withPacked,+  allocaPacked,++  -- * Utilities for 'Strided' values+  StridedPtr,+  withStrided,+  allocaStrided,++  -- * Utilities for runtime length arrays+  alignedCopyVector,+) where++import qualified Data.Vector.Storable as SV+import UnliftIO (MonadIO, MonadUnliftIO, liftIO)+import UnliftIO.Foreign++import Foreign.GPU.Storable.Aligned++-- | Convenience type for 'Packed' 'AlignedPtr'+type PackedPtr layout a = AlignedPtr layout (Packed layout a)++-- | Temporarily allocates a zero-initialized block of memory and pokes a+-- 'Packed' value into it, providing a pointer to the result.+-- The storage is freed automatically. The pointer is only valid within the continuation.+withPacked+  :: forall layout a m b+   . (MonadUnliftIO m, AlignedStorable layout a)+  => a+  -> (PackedPtr layout a -> m b)+  -> m b+withPacked a f = withZeroed (Packed a) (f . AlignedPtr)+{-# INLINEABLE withPacked #-}++-- | Allocates temporary, zero-initialized storage for a 'Packed' value on the stack.+-- The pointer is only valid within the continuation.+allocaPacked+  :: forall layout a b m+   . (MonadUnliftIO m, AlignedStorable layout a)+  => (PackedPtr layout a -> m b)+  -> m b+allocaPacked f = allocaZeroed (f . AlignedPtr)+{-# INLINEABLE allocaPacked #-}++-- | Convenience type for 'Strided' 'AlignedPtr'+type StridedPtr layout a = AlignedPtr layout (Strided layout a)++-- | Temporarily allocates a zero-initialized block of memory and pokes a+-- 'Strided' value into it, providing a pointer to the result.+-- The storage is freed automatically. The pointer is only valid within the continuation.+withStrided+  :: (MonadUnliftIO m, AlignedStorable layout a) => a -> (StridedPtr layout a -> m b) -> m b+withStrided a f = withZeroed (Strided a) (f . AlignedPtr)+{-# INLINEABLE withStrided #-}++-- | Allocates temporary, zero-initialized storage for a 'Strided' value on the stack.+-- The pointer is only valid within the continuation.+allocaStrided :: (MonadUnliftIO m, AlignedStorable layout a) => (StridedPtr layout a -> m b) -> m b+allocaStrided f = allocaZeroed (f . AlignedPtr)+{-# INLINEABLE allocaStrided #-}++-- | Performs a straight 'copyBytes' on the underlying pointer of 'SV.Vector'+alignedCopyVector+  :: forall layout a m+   . (MonadIO m, AlignedStorable layout a)+  => AlignedPtr layout a+  -> SV.Vector (Strided layout a)+  -> m ()+alignedCopyVector (AlignedPtr dest) v = liftIO $ SV.unsafeWith v \src ->+  copyBytes+    dest+    (castPtr src)+    (sizeOf @(Strided layout a) undefined * SV.length v)+{-# INLINE alignedCopyVector #-}++--------------------------------------------------------------------------------+-- Utilities+--------------------------------------------------------------------------------++zeroPtr :: forall a m. (MonadIO m, Storable a) => Ptr a -> m ()+zeroPtr ptr = fillBytes ptr 0 (sizeOf @a undefined)+{-# INLINE zeroPtr #-}++allocaZeroed :: (MonadUnliftIO m, Storable a) => (Ptr a -> m b) -> m b+allocaZeroed f = alloca \ptr -> zeroPtr ptr >> f ptr+{-# INLINE allocaZeroed #-}++withZeroed :: (MonadUnliftIO m, Storable a) => a -> (Ptr a -> m b) -> m b+withZeroed a f = allocaZeroed \ptr -> do+  liftIO $ poke ptr a+  f ptr+{-# INLINE withZeroed #-}

@@ -0,0 +1,1216 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RoleAnnotations #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}++-- |+-- Description : Generically derive Storable instances for GPU memory layouts+-- Copyright   : (c) Jeremy Nuttall, 2025+-- License     : BSD-3-Clause+-- Maintainer  : jeremy@jeremy-nuttall.com+-- Stability   : experimental+--+-- Derive @Storable@ instances that respect GPU memory layout rules (@std140@,+-- @std430@, @scalar@). Works with any product type that has a 'Generic' instance.+--+-- @+-- data Uniforms = Uniforms+--   { viewProj  :: M44 Float+--   , cameraPos :: V3 Float+--   } deriving Generic+--+-- instance AlignedStorable Std140 Uniforms+-- @+--+-- Then use "Foreign.GPU.Marshal.Aligned" to get properly-padded pointers:+--+-- @+-- withPacked \@Std140 uniforms $ \\ptr -> uploadToGPU ptr+-- @+--+-- __NB:__ @vec3@ and @mat3@ types have historically had driver bugs+-- around alignment. Prefer @vec4@/@mat4@ when possible.+module Foreign.GPU.Storable.Aligned (+  -- * The AlignedStorable class+  AlignedStorable (..),++  -- * Memory layout+  MemoryLayout (..),+  SMemoryLayout (..),+  KnownMemoryLayout (..),+  memoryLayoutVal,++  -- * Storable Wrappers+  Strided (..),+  StridedVector,+  Packed (..),+  AlignedArray (..),+  mkAlignedArray,+  withAlignedArray,+  AlignedPtr (..),++  -- * Memory layout rules+  MemoryLayoutRules (..),++  -- * Generics+  GAlignedStorable (..),+)+where++import Control.Monad+import Data.Bifunctor (first)+import Data.Bits+import Data.Coerce+import Data.Foldable (traverse_)+import Data.Hashable (Hashable)+import Data.Int+import Data.Kind+import Data.Maybe (fromJust)+import Data.Proxy+import Data.Typeable (Typeable)+import qualified Data.Vector.Generic as GV+import qualified Data.Vector.Generic.Sized as SGV+import qualified Data.Vector.Storable as SV+import qualified Data.Vector.Storable.Mutable as SMV+import qualified Data.Vector.Storable.Sized as SSV+import Data.Word+import Foreign (Ptr, castPtr, copyBytes, plusPtr)+import Foreign.Storable+import GHC.Generics+import GHC.TypeLits+import Linear (M22, M23, M24, M32, M33, M34, M42, M43, M44, V2 (..), V3 (..), V4 (..))+import Numeric.Half (Half)++--------------------------------------------------------------------------------+-- Layout Rules+--------------------------------------------------------------------------------++-- | A type-level tag representing a memory layout standard.+data MemoryLayout+  = -- | `std140` is a standardized memory layout for SPIR-V interface blocks.+    -- It has strict padding and alignment rules, ensuring layout consistency across platforms.+    --+    -- For details, refer to 7.6.2.2 "Standard Uniform Block Layout" of the+    -- [OpenGL 4.6 Specification](https://registry.khronos.org/OpenGL/specs/gl/glspec46.core.pdf).+    Std140+  | -- | `std430` is a standardized memory layout, typically used for Shader Storage Buffer+    -- Objects (SSBOs). It has more relaxed alignment rules for arrays and structs+    -- than `std140`, which can result in more compact memory usage.+    --+    -- For details, please refer to the section 7.6.2.2 "Standard Uniform Block Layout" of the+    -- [OpenGL 4.6 Specification](https://registry.khronos.org/OpenGL/specs/gl/glspec46.core.pdf).+    Std430+  | -- | `scalar` block layout is a memory layout with the most relaxed alignment rules,+    -- closely matching the alignment of scalar and vector types in C.+    --+    -- For details, please refer to the+    -- [extension specification](https://github.com/KhronosGroup/GLSL/blob/main/extensions/ext/GL_EXT_scalar_block_layout.txt)+    Scalar+  deriving (Show, Generic, Typeable, Enum, Bounded, Eq, Ord)++instance Hashable MemoryLayout++-- | Singled 'MemoryLayout', primarily useful for authors of higher-level libraries+-- (e.g., shader eDSLs, descriptor set builders).+data SMemoryLayout (layout :: MemoryLayout) where+  SStd140 :: SMemoryLayout Std140+  SStd430 :: SMemoryLayout Std430+  SScalar :: SMemoryLayout Scalar++-- | This class gives the 'SMemoryLayout' associated with a 'MemoryLayout'.+--+-- A very rough sketch of this use case:+--+-- > emitLayoutQualifier :: forall layout. KnownMemoryLayout layout => String+-- > emitLayoutQualifier = case memoryLayoutVal (Proxy @layout) of+-- >   Std140 -> "layout(std140)"+-- >   Std430 -> "layout(std430)"+-- >   Scalar -> "layout(scalar)"+class KnownMemoryLayout (layout :: MemoryLayout) where+  memoryLayoutSing :: SMemoryLayout layout++instance KnownMemoryLayout Std140 where+  memoryLayoutSing = SStd140+  {-# INLINE memoryLayoutSing #-}++instance KnownMemoryLayout Std430 where+  memoryLayoutSing = SStd430+  {-# INLINE memoryLayoutSing #-}++instance KnownMemoryLayout Scalar where+  memoryLayoutSing = SScalar+  {-# INLINE memoryLayoutSing #-}++memoryLayoutVal :: forall layout. (KnownMemoryLayout layout) => Proxy layout -> MemoryLayout+memoryLayoutVal _ = case memoryLayoutSing @layout of+  SStd140 -> Std140+  SStd430 -> Std430+  SScalar -> Scalar+{-# INLINE memoryLayoutVal #-}++-- | Defines the precise calculation rules for a given 'MemoryLayout'.+--+-- These rules correspond to the memory layout requirements found in the OpenGL+-- and Vulkan specifications.+class MemoryLayoutRules (layout :: MemoryLayout) where+  -- | The alignment rule for top-level structs, matrix rows, and array members.+  alignBlock :: Proxy layout -> Int -> Int++  -- | The final size rule for a top-level struct.+  roundStructSize :: Proxy layout -> Int -> Int -> Int++  -- | The stride rule for an element within an array.+  layoutStride :: Proxy layout -> Int -> Int -> Int++std140Align :: Int+std140Align = 16++instance MemoryLayoutRules Std140 where+  alignBlock _ = roundUpTo std140Align+  {-# INLINE alignBlock #-}+  roundStructSize _ = flip roundUpTo+  {-# INLINE roundStructSize #-}+  layoutStride _ size align = roundUpTo std140Align (roundUpTo align size)+  {-# INLINE layoutStride #-}++instance MemoryLayoutRules Std430 where+  alignBlock _ = id+  {-# INLINE alignBlock #-}+  roundStructSize _ = flip roundUpTo+  {-# INLINE roundStructSize #-}+  layoutStride _ = flip roundUpTo+  {-# INLINE layoutStride #-}++instance MemoryLayoutRules Scalar where+  alignBlock _ = id+  {-# INLINE alignBlock #-}+  roundStructSize _ size _ = size+  {-# INLINE roundStructSize #-}+  layoutStride _ = flip roundUpTo+  {-# INLINE layoutStride #-}++--------------------------------------------------------------------------------+-- Layout-aware Storable+--------------------------------------------------------------------------------++-- | Wrapper whose 'sizeOf' includes stride padding, for use in arrays.+-- @SV.Vector (Strided Std140 MyType)@ can be 'copyBytes'd to the GPU in one shot.+newtype Strided (layout :: MemoryLayout) a = Strided {unStrided :: a}+  deriving (Generic, Typeable, Show, Eq, Ord)++-- | Wrapper without stride padding. Use for single values (push constants, lone UBOs).+newtype Packed (layout :: MemoryLayout) a = Packed {unPacked :: a}+  deriving (Generic, Typeable, Show, Eq, Ord)++-- | A convenience type for Data.Vector.Storable.Vector (Strided layout a)+type StridedVector (layout :: MemoryLayout) a = SV.Vector (Strided layout a)++-- | Opt-in 'copyBytes' for fixed-size arrays. Parameterize your struct by layout:+--+-- @+-- data MyStruct layout = MyStruct { pixels :: AlignedArray layout 64 (V4 Float) }+-- @+newtype AlignedArray (layout :: MemoryLayout) (n :: Nat) a = AlignedArray+  {unAlignedArray :: SSV.Vector n (Strided layout a)}+  deriving (Generic, Typeable, Show, Eq, Ord)++-- | Construct an 'AlignedArray' from a sized vector.+mkAlignedArray+  :: (AlignedStorable layout a, Storable a) => SSV.Vector n a -> AlignedArray layout n a+mkAlignedArray = AlignedArray . SSV.map Strided+{-# INLINE CONLIKE mkAlignedArray #-}++-- | Helper function to unwrap an 'AlignedArray' and manipulate its contents.+-- Don't do unsafe pointer tricks in the closure.+withAlignedArray+  :: AlignedArray layout n a+  -> (SSV.Vector n (Strided layout a) -> SSV.Vector n (Strided layout a))+  -> AlignedArray layout n a+withAlignedArray (AlignedArray v) f = AlignedArray (f v)+{-# INLINE withAlignedArray #-}++-- | A 'Ptr' that is tagged with its 'MemoryLayout'.+newtype AlignedPtr (layout :: MemoryLayout) a = AlignedPtr {unAlignedPtr :: Ptr a}+  deriving (Generic, Typeable, Show)++type role AlignedPtr nominal nominal++-- | A class for types that have calculable layouts according to GPU requirements.+--+-- __NB__: `alignedPoke` only writes member data. Only poke into zeroed buffers+-- unless you really enjoy parsing through garbage in RenderDoc.+class (MemoryLayoutRules layout) => AlignedStorable (layout :: MemoryLayout) a where+  -- | The size of the type 'a' after its contents are laid out, but *before*+  -- any final padding is applied to the container struct itself. This is+  -- the offset after the last member.+  packedAlignedSizeOf :: Proxy layout -> Proxy a -> Int+  default packedAlignedSizeOf+    :: (GAlignedStorable layout (Rep a))+    => Proxy layout+    -> Proxy a+    -> Int+  packedAlignedSizeOf l _ = fst (galignedSize l (Proxy @(Rep a)) 0)+  {-# INLINE packedAlignedSizeOf #-}++  -- | The size of the type 'a' including final padding/rounding according to the+  -- layout rules for a struct. For `Std140`, this means the size is rounded+  -- up to a multiple of 16.+  alignedSizeOf :: Proxy layout -> Proxy a -> Int+  default alignedSizeOf+    :: (GAlignedStorable layout (Rep a))+    => Proxy layout+    -> Proxy a+    -> Int+  alignedSizeOf l _ =+    let (!s, !a) = galignedSize l (Proxy @(Rep a)) 0+        !structAlign = alignBlock l a+     in roundStructSize l s structAlign+  {-# INLINE alignedSizeOf #-}++  -- | The base alignment requirement for the type 'a'.+  alignedAlignment :: Proxy layout -> Proxy a -> Int+  default alignedAlignment+    :: (GAlignedStorable layout (Rep a))+    => Proxy layout+    -> Proxy a+    -> Int+  alignedAlignment l _ =+    let (_, !a) = galignedSize l (Proxy @(Rep a)) 0+     in alignBlock l a+  {-# INLINE alignedAlignment #-}++  -- | Read a value from the given pointer, respecting the layout rules.+  alignedPeek :: AlignedPtr layout a -> IO a+  default alignedPeek+    :: (Generic a, GAlignedStorable layout (Rep a))+    => AlignedPtr layout a+    -> IO a+  alignedPeek (AlignedPtr ptr) = to . fst <$> galignedPeek @layout (AlignedPtr (castPtr ptr)) 0+  {-# INLINE alignedPeek #-}++  -- | Write a value to the given pointer, respecting the layout rules.+  alignedPoke :: AlignedPtr layout a -> a -> IO ()+  default alignedPoke+    :: (Generic a, GAlignedStorable layout (Rep a))+    => AlignedPtr layout a+    -> a+    -> IO ()+  alignedPoke (AlignedPtr ptr) val = void $ galignedPoke @layout (AlignedPtr (castPtr ptr)) (from val) 0+  {-# INLINE alignedPoke #-}++-- | @sizeOf @(Strided layout a)@ calculates the full stride of the type,+-- including final padding, making it suitable for array allocations.+--+-- Use zeroed buffers when using this newtype.+instance (MemoryLayoutRules layout, AlignedStorable layout a) => Storable (Strided layout a) where+  sizeOf _ =+    layoutStride+      (Proxy @layout)+      (alignedSizeOf (Proxy @layout) (Proxy @a))+      (alignedAlignment (Proxy @layout) (Proxy @a))+  {-# INLINE sizeOf #-}+  alignment _ = alignedAlignment (Proxy @layout) (Proxy @a)+  {-# INLINE alignment #-}+  peek ptr = Strided <$> alignedPeek @layout (AlignedPtr (castPtr ptr))+  {-# INLINE peek #-}+  poke ptr a = alignedPoke @layout (AlignedPtr (castPtr ptr)) (coerce a :: a)+  {-# INLINE poke #-}++instance (AlignedStorable layout a) => Storable (Packed layout a) where+  sizeOf _ = alignedSizeOf (Proxy @layout) (Proxy @a)+  {-# INLINE sizeOf #-}+  alignment _ = alignedAlignment (Proxy @layout) (Proxy @a)+  {-# INLINE alignment #-}+  peek ptr = Packed <$> alignedPeek @layout (AlignedPtr (castPtr ptr))+  {-# INLINE peek #-}+  poke ptr a = alignedPoke @layout (AlignedPtr (castPtr ptr)) (coerce a :: a)+  {-# INLINE poke #-}++--------------------------------------------------------------------------------+-- Generic deriving+--------------------------------------------------------------------------------++-- | Generically derive 'AlignedStorable'.+--+-- > data MyType = MyType { field1 :: Float, field2 :: V3 Float }+-- >   deriving (Generic)+-- >+-- > instance AlignedStorable Std140 MyType+class GAlignedStorable (layout :: MemoryLayout) (rep :: Type -> Type) where+  galignedSize :: Proxy layout -> Proxy rep -> Int -> (Int, Int)+  galignedPoke :: AlignedPtr layout a -> rep a -> Int -> IO Int+  galignedPeek :: AlignedPtr layout a -> Int -> IO (rep a, Int)++instance+  ( TypeError+      (Text "Cannot derive AlignedStorable for empty data types as there is no shader equivalent.")+  )+  => GAlignedStorable layout V1+  where+  galignedSize = error "unreachable: empty data type"+  galignedPoke = error "unreachable: empty data type"+  galignedPeek = error "unreachable: empty data type"++instance+  ( TypeError+      (Text "Cannot derive AlignedStorable for nullary constructors as there is no shader equivalent.")+  )+  => GAlignedStorable layout U1+  where+  galignedSize = error "unreachable: nullary constructor"+  galignedPoke = error "unreachable: nullary constructor"+  galignedPeek = error "unreachable: nullary constructor"++instance+  ( TypeError+      ( Text+          "Cannot derive AlignedStorable for sum types as there is no unambiguous shader equivalent."+      )+  )+  => GAlignedStorable layout (a :+: b)+  where+  galignedSize = error "unreachable: sum type"+  galignedPoke = error "unreachable: sum type"+  galignedPeek = error "unreachable: sum type"++instance (AlignedStorable layout c) => GAlignedStorable layout (K1 i c) where+  galignedSize l _ off =+    let !a = alignedAlignment l (Proxy @c)+        !s = alignedSizeOf l (Proxy @c)+        !off' = roundUpTo a off+     in (off' + s, a)+  {-# INLINE galignedSize #-}+  galignedPoke (AlignedPtr ptr) (K1 !v) !off = do+    let !a = alignedAlignment (Proxy @layout) (Proxy @c)+        !s = alignedSizeOf (Proxy @layout) (Proxy @c)+        !off' = roundUpTo a off+    alignedPoke @layout (AlignedPtr (ptr `plusPtr` off')) v+    pure (off' + s)+  {-# INLINE galignedPoke #-}+  galignedPeek (AlignedPtr ptr) !off = do+    let !a = alignedAlignment (Proxy @layout) (Proxy @c)+        !s = alignedSizeOf (Proxy @layout) (Proxy @c)+        !off' = roundUpTo a off+    !v <- alignedPeek @layout (AlignedPtr (ptr `plusPtr` off'))+    pure (K1 v, off' + s)+  {-# INLINE galignedPeek #-}++instance (GAlignedStorable layout a, GAlignedStorable layout b) => GAlignedStorable layout (a :*: b) where+  galignedSize l _ off =+    let (!nextOffA, !alignA) = galignedSize l (Proxy @a) off+        (!nextOffB, !alignB) = galignedSize l (Proxy @b) nextOffA+     in (nextOffB, max alignA alignB)+  {-# INLINE galignedSize #-}+  galignedPoke ptr (valA :*: valB) !off = do+    !nextOffA <- galignedPoke ptr valA off+    galignedPoke ptr valB nextOffA+  {-# INLINE galignedPoke #-}+  galignedPeek ptr off = do+    (!valA, !nextOffA) <- galignedPeek ptr off+    (!valB, !nextOffB) <- galignedPeek ptr nextOffA+    pure (valA :*: valB, nextOffB)+  {-# INLINE galignedPeek #-}++instance (GAlignedStorable layout f) => GAlignedStorable layout (M1 i c f) where+  galignedSize l _ = galignedSize l (Proxy @f)+  {-# INLINE galignedSize #-}+  galignedPoke ptr = galignedPoke ptr . unM1+  {-# INLINE galignedPoke #-}+  galignedPeek ptr off = first M1 <$> galignedPeek ptr off+  {-# INLINE galignedPeek #-}++--------------------------------------------------------------------------------+-- Sized arrays+--------------------------------------------------------------------------------++instance+  {-# OVERLAPPABLE #-}+  (KnownNat n, AlignedStorable layout a, GV.Vector v a)+  => AlignedStorable layout (SGV.Vector v n a)+  where+  packedAlignedSizeOf _ _ = packedAlignedSizeOfArray (Proxy @layout) (Proxy @n) (Proxy @a)+  {-# INLINE packedAlignedSizeOf #-}+  alignedSizeOf = packedAlignedSizeOf+  {-# INLINE alignedSizeOf #-}+  alignedAlignment l _ = arrayAlignedAlignment l (Proxy @a)+  {-# INLINE alignedAlignment #-}+  alignedPeek = garrayAlignedPeek+  {-# INLINE alignedPeek #-}+  alignedPoke = garrayAlignedPoke+  {-# INLINE alignedPoke #-}++instance (KnownNat n, AlignedStorable Scalar a, GV.Vector v a) => AlignedStorable Scalar (SGV.Vector v n a) where+  packedAlignedSizeOf _ _ = scalarPackedAlignedSizeOfArray (Proxy @n) (Proxy @a)+  {-# INLINE packedAlignedSizeOf #-}+  alignedSizeOf = packedAlignedSizeOf+  {-# INLINE alignedSizeOf #-}+  alignedAlignment l _ = arrayAlignedAlignment l (Proxy @a)+  {-# INLINE alignedAlignment #-}+  alignedPeek = garrayAlignedPeek+  {-# INLINE alignedPeek #-}+  alignedPoke = garrayAlignedPoke+  {-# INLINE alignedPoke #-}++instance+  {-# OVERLAPPABLE #-}+  (KnownNat n, AlignedStorable layout a)+  => AlignedStorable layout (AlignedArray layout n a)+  where+  packedAlignedSizeOf _ _ = packedAlignedSizeOfArray (Proxy @layout) (Proxy @n) (Proxy @a)+  {-# INLINE packedAlignedSizeOf #-}+  alignedSizeOf = packedAlignedSizeOf+  {-# INLINE alignedSizeOf #-}+  alignedAlignment l _ = arrayAlignedAlignment l (Proxy @a)+  {-# INLINE alignedAlignment #-}+  alignedPeek (AlignedPtr src) = do+    let s = fromIntegral $ natVal (Proxy @n)+    v <- SMV.new s+    SMV.unsafeWith v \dest ->+      copyBytes (castPtr dest) src (alignedSizeOf (Proxy @layout) (Proxy @(AlignedArray layout n a)))+    AlignedArray . fromJust . SSV.toSized @n <$> SV.unsafeFreeze v+  {-# INLINE alignedPeek #-}+  alignedPoke (AlignedPtr dest) (AlignedArray v) = SV.unsafeWith (SSV.fromSized v) \src ->+    copyBytes dest (castPtr src) (alignedSizeOf (Proxy @layout) (Proxy @(AlignedArray layout n a)))+  {-# INLINE alignedPoke #-}++instance+  (KnownNat n, AlignedStorable Scalar a)+  => AlignedStorable Scalar (AlignedArray Scalar n a)+  where+  packedAlignedSizeOf _ _ = scalarPackedAlignedSizeOfArray (Proxy @n) (Proxy @a)+  {-# INLINE packedAlignedSizeOf #-}+  alignedSizeOf = packedAlignedSizeOf+  {-# INLINE alignedSizeOf #-}+  alignedAlignment l _ = arrayAlignedAlignment l (Proxy @a)+  {-# INLINE alignedAlignment #-}+  alignedPeek (AlignedPtr src) = do+    let s = fromIntegral $ natVal (Proxy @n)+    v <- SMV.new s+    SMV.unsafeWith v \dest ->+      copyBytes (castPtr dest) src (alignedSizeOf (Proxy @Scalar) (Proxy @(AlignedArray Scalar n a)))+    AlignedArray . fromJust . SSV.toSized @n <$> SV.unsafeFreeze v+  {-# INLINE alignedPeek #-}+  alignedPoke (AlignedPtr dest) (AlignedArray v) = SV.unsafeWith (SSV.fromSized v) \src ->+    copyBytes dest (castPtr src) (alignedSizeOf (Proxy @Scalar) (Proxy @(AlignedArray Scalar n a)))+  {-# INLINE alignedPoke #-}++packedAlignedSizeOfArray+  :: forall layout n a+   . (KnownNat n, AlignedStorable layout a)+  => Proxy layout+  -> Proxy n+  -> Proxy a+  -> Int+packedAlignedSizeOfArray _ _ _ = fromIntegral (natVal (Proxy @n)) * sizeOf @(Strided layout a) undefined+{-# INLINE packedAlignedSizeOfArray #-}++scalarPackedAlignedSizeOfArray+  :: forall n a+   . (KnownNat n, AlignedStorable Scalar a)+  => Proxy n+  -> Proxy a+  -> Int+scalarPackedAlignedSizeOfArray _ _ =+  let n = fromIntegral $ natVal (Proxy @n)+      stride = sizeOf @(Strided Scalar a) undefined+      lastElementSize = packedAlignedSizeOf (Proxy @Scalar) (Proxy @a)+   in if n > 0+        then ((n - 1) * stride) + lastElementSize+        else 0+{-# INLINE scalarPackedAlignedSizeOfArray #-}++arrayAlignedAlignment+  :: forall layout a. (AlignedStorable layout a) => Proxy layout -> Proxy a -> Int+arrayAlignedAlignment l a = alignBlock l $ alignedAlignment l a+{-# INLINE arrayAlignedAlignment #-}++garrayAlignedPeek+  :: forall layout n a v+   . (KnownNat n, GV.Vector v a, AlignedStorable layout a)+  => AlignedPtr layout (SGV.Vector v n a)+  -> IO (SGV.Vector v n a)+garrayAlignedPeek (AlignedPtr ptr) =+  let !stride = sizeOf @(Strided layout a) undefined+   in SGV.generateM \i ->+        alignedPeek @layout (AlignedPtr (ptr `plusPtr` (fromIntegral i * stride)))+{-# INLINE garrayAlignedPeek #-}++garrayAlignedPoke+  :: forall layout n a v+   . (KnownNat n, GV.Vector v a, AlignedStorable layout a)+  => AlignedPtr layout (SGV.Vector v n a)+  -> SGV.Vector v n a+  -> IO ()+garrayAlignedPoke (AlignedPtr ptr) =+  let !stride = sizeOf @(Strided layout a) undefined+   in fusedimapMSized_ \i -> alignedPoke @layout (AlignedPtr (ptr `plusPtr` (i * stride)))+{-# INLINE garrayAlignedPoke #-}++--------------------------------------------------------------------------------+-- Utils+--------------------------------------------------------------------------------++-- | Bit-twiddling hack. Assumes multiple is a power of 2.+-- The assumption holds for all standard GPU layouts.+--+-- __NB__: As of writing, GHC's optimizer fails when optimizing GAlignedStorable+-- if this function branches.+roundUpTo :: (Bits a, Num a) => a -> a -> a+roundUpTo multiple val = (val + multiple - 1) .&. complement (multiple - 1)+{-# INLINE roundUpTo #-}++-- | Exploits the knowledge of the array length to create a straight, bounded loop over the+-- underlying vector.+fusedimapMSized_+  :: forall n v a f+   . (Monad f, KnownNat n, GV.Vector v a)+  => (Int -> a -> f ())+  -> SGV.Vector v n a+  -> f ()+fusedimapMSized_ f v =+  traverse_+    (\i -> f i (SGV.unsafeIndex v i))+    [0 .. fromIntegral (natVal (Proxy @n)) - 1]+{-# INLINE fusedimapMSized_ #-}++--------------------------------------------------------------------------------+-- Internal helpers used across macros+--------------------------------------------------------------------------------++defaultAlignedPeek :: (Storable a) => AlignedPtr layout a -> IO a+defaultAlignedPeek (AlignedPtr ptr) = peek ptr+{-# INLINE defaultAlignedPeek #-}++defaultAlignedPoke :: (Storable a) => AlignedPtr layout a -> a -> IO ()+defaultAlignedPoke (AlignedPtr ptr) = poke ptr+{-# INLINE defaultAlignedPoke #-}++packedAlignedSizeOfMat+  :: forall layout a f g+   . (AlignedStorable layout (g a))+  => Proxy layout+  -> Proxy (f (g a))+  -> Int+packedAlignedSizeOfMat l _ =+  let rowSize = packedAlignedSizeOf l (Proxy @(g a))+      rowAlign = alignedAlignment l (Proxy @(g a))+   in layoutStride (Proxy @layout) rowSize rowAlign+{-# INLINE packedAlignedSizeOfMat #-}++-- | Unsafe, for internal use only+castAlignedPtr :: forall layout a b. AlignedPtr layout a -> AlignedPtr layout b+castAlignedPtr (AlignedPtr ptr) = AlignedPtr (castPtr ptr)++-- | Unsafe, for internal use only+alignedPeekByteOff+  :: forall layout a. (AlignedStorable layout a) => AlignedPtr layout a -> Int -> IO a+alignedPeekByteOff (AlignedPtr ptr) off = alignedPeek (AlignedPtr @layout (ptr `plusPtr` off))+{-# INLINE alignedPeekByteOff #-}++-- | Unsafe, for internal use only+alignedPokeByteOff+  :: forall layout a. (AlignedStorable layout a) => AlignedPtr layout a -> Int -> a -> IO ()+alignedPokeByteOff (AlignedPtr ptr) off = alignedPoke (AlignedPtr @layout (ptr `plusPtr` off))+{-# INLINE alignedPokeByteOff #-}++alignedPeekV2+  :: forall layout a+   . (AlignedStorable layout a, Storable a)+  => AlignedPtr layout (V2 a)+  -> IO (V2 a)+alignedPeekV2 (AlignedPtr ptr) =+  let !stride = alignedAlignment (Proxy @layout) (Proxy @a)+   in V2 <$> peekByteOff ptr 0 <*> peekByteOff ptr stride+{-# INLINE alignedPeekV2 #-}++alignedPokeV2+  :: forall layout a+   . (AlignedStorable layout a, Storable a)+  => AlignedPtr layout (V2 a)+  -> V2 a+  -> IO ()+alignedPokeV2 (AlignedPtr ptr) (V2 x y) = do+  let !stride = alignedAlignment (Proxy @layout) (Proxy @a)+  pokeByteOff ptr 0 x+  pokeByteOff ptr stride y+{-# INLINE alignedPokeV2 #-}++alignedPeekM2+  :: forall layout a v+   . (AlignedStorable layout (v a))+  => AlignedPtr layout (V2 (v a))+  -> IO (V2 (v a))+alignedPeekM2 aptr =+  let ptr = castAlignedPtr aptr+      !rowSize = packedAlignedSizeOf (Proxy @layout) (Proxy @(v a))+      !rowAlign = alignedAlignment (Proxy @layout) (Proxy @(v a))+      !stride = layoutStride (Proxy @layout) rowSize rowAlign+   in V2+        <$> alignedPeekByteOff ptr 0+        <*> alignedPeekByteOff ptr stride+{-# INLINE alignedPeekM2 #-}++alignedPokeM2+  :: forall layout a v+   . (AlignedStorable layout (v a))+  => AlignedPtr layout (V2 (v a))+  -> V2 (v a)+  -> IO ()+alignedPokeM2 aptr (V2 x y) = do+  let ptr = castAlignedPtr aptr+      !rowSize = packedAlignedSizeOf (Proxy @layout) (Proxy @(v a))+      !rowAlign = alignedAlignment (Proxy @layout) (Proxy @(v a))+      !stride = layoutStride (Proxy @layout) rowSize rowAlign+  alignedPokeByteOff ptr 0 x+  alignedPokeByteOff ptr stride y+{-# INLINE alignedPokeM2 #-}++alignedPeekV3+  :: forall layout a. (AlignedStorable layout a, Storable a) => AlignedPtr layout (V3 a) -> IO (V3 a)+alignedPeekV3 (AlignedPtr ptr) =+  let a = alignedAlignment (Proxy @layout) (Proxy @a)+   in V3 <$> peekByteOff ptr 0 <*> peekByteOff ptr a <*> peekByteOff ptr (a * 2)+{-# INLINE alignedPeekV3 #-}++alignedPokeV3+  :: forall layout a. (AlignedStorable layout a, Storable a) => AlignedPtr layout (V3 a) -> V3 a -> IO ()+alignedPokeV3 (AlignedPtr ptr) (V3 x y z) = do+  let a = alignedAlignment (Proxy @layout) (Proxy @a)+  pokeByteOff ptr 0 x+  pokeByteOff ptr a y+  pokeByteOff ptr (a * 2) z+{-# INLINE alignedPokeV3 #-}++alignedPeekM3+  :: forall layout a v+   . (AlignedStorable layout (v a))+  => AlignedPtr layout (V3 (v a))+  -> IO (V3 (v a))+alignedPeekM3 aptr =+  let ptr = castAlignedPtr aptr+      !rowSize = packedAlignedSizeOf (Proxy @layout) (Proxy @(v a))+      !rowAlign = alignedAlignment (Proxy @layout) (Proxy @(v a))+      !stride = layoutStride (Proxy @layout) rowSize rowAlign+   in V3+        <$> alignedPeekByteOff ptr 0+        <*> alignedPeekByteOff ptr stride+        <*> alignedPeekByteOff ptr (stride * 2)+{-# INLINE alignedPeekM3 #-}++alignedPokeM3+  :: forall layout a v+   . (AlignedStorable layout (v a))+  => AlignedPtr layout (V3 (v a))+  -> V3 (v a)+  -> IO ()+alignedPokeM3 aptr (V3 x y z) = do+  let ptr = castAlignedPtr aptr+      !rowSize = packedAlignedSizeOf (Proxy @layout) (Proxy @(v a))+      !rowAlign = alignedAlignment (Proxy @layout) (Proxy @(v a))+      !stride = layoutStride (Proxy @layout) rowSize rowAlign+  alignedPokeByteOff ptr 0 x+  alignedPokeByteOff ptr stride y+  alignedPokeByteOff ptr (stride * 2) z+{-# INLINE alignedPokeM3 #-}++alignedPokeV4+  :: forall layout a. (AlignedStorable layout a, Storable a) => AlignedPtr layout (V4 a) -> V4 a -> IO ()+alignedPokeV4 (AlignedPtr ptr) (V4 x y z w) = do+  let a = alignedAlignment (Proxy @layout) (Proxy @a)+  pokeByteOff ptr 0 x+  pokeByteOff ptr a y+  pokeByteOff ptr (a * 2) z+  pokeByteOff ptr (a * 3) w+{-# INLINE alignedPokeV4 #-}++alignedPeekV4+  :: forall layout a. (AlignedStorable layout a, Storable a) => AlignedPtr layout (V4 a) -> IO (V4 a)+alignedPeekV4 (AlignedPtr ptr) =+  let a = alignedAlignment (Proxy @layout) (Proxy @a)+   in V4+        <$> peekByteOff ptr 0+        <*> peekByteOff ptr a+        <*> peekByteOff ptr (a * 2)+        <*> peekByteOff ptr (a * 3)+{-# INLINE alignedPeekV4 #-}++alignedPeekM4+  :: forall layout a v+   . (AlignedStorable layout (v a))+  => AlignedPtr layout (V4 (v a))+  -> IO (V4 (v a))+alignedPeekM4 aptr =+  let ptr = castAlignedPtr aptr+      !rowSize = packedAlignedSizeOf (Proxy @layout) (Proxy @(v a))+      !rowAlign = alignedAlignment (Proxy @layout) (Proxy @(v a))+      !stride = layoutStride (Proxy @layout) rowSize rowAlign+   in V4+        <$> alignedPeekByteOff ptr 0+        <*> alignedPeekByteOff ptr stride+        <*> alignedPeekByteOff ptr (stride * 2)+        <*> alignedPeekByteOff ptr (stride * 3)+{-# INLINE alignedPeekM4 #-}++alignedPokeM4+  :: forall layout a v+   . (AlignedStorable layout (v a))+  => AlignedPtr layout (V4 (v a))+  -> V4 (v a)+  -> IO ()+alignedPokeM4 aptr (V4 x y z w) = do+  let ptr = castAlignedPtr aptr+      !rowSize = packedAlignedSizeOf (Proxy @layout) (Proxy @(v a))+      !rowAlign = alignedAlignment (Proxy @layout) (Proxy @(v a))+      !stride = layoutStride (Proxy @layout) rowSize rowAlign+  alignedPokeByteOff ptr 0 x+  alignedPokeByteOff ptr stride y+  alignedPokeByteOff ptr (stride * 2) z+  alignedPokeByteOff ptr (stride * 3) w+{-# INLINE alignedPokeM4 #-}++--------------------------------------------------------------------------------+-- Base instances for primitive shader types+--+-- CPP is the simple way to stamp out the instances. I'll probably switch to TH+-- at some point.+--------------------------------------------------------------------------------++-- schema: (MemoryLayout, Type, size, alignment)+#define FOR_EACH_STD140_PRIMITIVE(X) \+  X (Std140, Bool, 4, 4) \+  X (Std140, Half, 2, 2) \+  X (Std140, Float, 4, 4) \+  X (Std140, Double, 8, 8) \+  X (Std140, Int8, 4, 4) \+  X (Std140, Int16, 4, 4) \+  X (Std140, Int32, 4, 4) \+  X (Std140, Int64, 8, 8) \+  X (Std140, Word8, 4, 4) \+  X (Std140, Word16, 4, 4) \+  X (Std140, Word32, 4, 4) \+  X (Std140, Word64, 8, 8)++-- schema: (MemoryLayout, Type, size, alignment)+#define FOR_EACH_STD430_PRIMITIVE(X) \+  X (Std430, Bool, 4, 4) \+  X (Std430, Half, 2, 2) \+  X (Std430, Float, 4, 4) \+  X (Std430, Double, 8, 8) \+  X (Std430, Int8, 1, 1) \+  X (Std430, Int16, 2, 2) \+  X (Std430, Int32, 4, 4) \+  X (Std430, Int64, 8, 8) \+  X (Std430, Word8, 1, 1) \+  X (Std430, Word16, 2, 2) \+  X (Std430, Word32, 4, 4) \+  X (Std430, Word64, 8, 8)++-- schema: (MemoryLayout, Type, size, alignment)+#define FOR_EACH_SCALAR_PRIMITIVE(X) \+  X (Scalar, Bool, 4, 4) \+  X (Scalar, Half, 2, 2) \+  X (Scalar, Float, 4, 4) \+  X (Scalar, Double, 8, 8) \+  X (Scalar, Int8, 1, 1) \+  X (Scalar, Int16, 2, 2) \+  X (Scalar, Int32, 4, 4) \+  X (Scalar, Int64, 8, 8) \+  X (Scalar, Word8, 1, 1) \+  X (Scalar, Word16, 2, 2) \+  X (Scalar, Word32, 4, 4) \+  X (Scalar, Word64, 8, 8)++-- schema: (Type)+#define FOR_EACH_MATRIX_PRIMITIVE(X) \+  X (Half) \+  X (Float) \+  X (Double)++#define PRIMITIVE_INSTANCE(LAYOUT, T, S, A) \+instance AlignedStorable LAYOUT T where { \+  packedAlignedSizeOf _ _ = S; \+  {-# INLINE packedAlignedSizeOf #-}; \+  alignedSizeOf _ _ = S; \+  {-# INLINE alignedSizeOf #-}; \+  alignedAlignment _ _ = A; \+  {-# INLINE alignedAlignment #-}; \+  alignedPeek = defaultAlignedPeek; \+  {-# INLINE alignedPeek #-}; \+  alignedPoke = defaultAlignedPoke; \+  {-# INLINE alignedPoke #-}; \+  };++#define X(LAYOUT, T, S, A) PRIMITIVE_INSTANCE(LAYOUT, T, S, A)+FOR_EACH_STD140_PRIMITIVE (X)+FOR_EACH_STD430_PRIMITIVE (X)+FOR_EACH_SCALAR_PRIMITIVE (X)+#undef X++--------------------------------------------------------------------------------+-- Base instances for vectors and matrices+--------------------------------------------------------------------------------++#define VEC2_STD_INSTANCE(LAYOUT, T) \+instance AlignedStorable LAYOUT (V2 T) where { \+  packedAlignedSizeOf _ _ = 2 * alignedSizeOf (Proxy :: Proxy LAYOUT) (Proxy :: Proxy T); \+  {-# INLINE packedAlignedSizeOf #-}; \+  alignedSizeOf _ _ = 2 * alignedSizeOf (Proxy :: Proxy LAYOUT) (Proxy :: Proxy T); \+  {-# INLINE alignedSizeOf #-}; \+  alignedAlignment _ _ = 2 * alignedAlignment (Proxy :: Proxy LAYOUT) (Proxy :: Proxy T); \+  {-# INLINE alignedAlignment #-}; \+  alignedPeek = alignedPeekV2; \+  {-# INLINE alignedPeek #-}; \+  alignedPoke = alignedPokeV2; \+  {-# INLINE alignedPoke #-}; \+  };++#define X(LAYOUT, T, S, A) VEC2_STD_INSTANCE(LAYOUT, T)+FOR_EACH_STD140_PRIMITIVE (X)+FOR_EACH_STD430_PRIMITIVE (X)+#undef X++#define VEC2_SCALAR_INSTANCE(T) \+instance AlignedStorable Scalar (V2 T) where { \+  packedAlignedSizeOf _ _ = 2 * alignedSizeOf (Proxy :: Proxy Scalar) (Proxy :: Proxy T); \+  {-# INLINE packedAlignedSizeOf #-}; \+  alignedSizeOf _ _ = 2 * alignedSizeOf (Proxy :: Proxy Scalar) (Proxy :: Proxy T); \+  {-# INLINE alignedSizeOf #-}; \+  alignedAlignment _ _ = alignedAlignment (Proxy :: Proxy Scalar) (Proxy :: Proxy T); \+  alignedPeek = defaultAlignedPeek; \+  {-# INLINE alignedPeek #-}; \+  alignedPoke = defaultAlignedPoke; \+  {-# INLINE alignedPoke #-}; \+  };++#define X(LAYOUT, T, S, A) VEC2_SCALAR_INSTANCE(T)+FOR_EACH_SCALAR_PRIMITIVE (X)+#undef X++#define MAT2_STD_INSTANCE(LAYOUT, T) \+instance AlignedStorable LAYOUT (M22 T) where { \+  packedAlignedSizeOf l a = 2 * packedAlignedSizeOfMat l a; \+  {-# INLINE packedAlignedSizeOf #-}; \+  alignedSizeOf = packedAlignedSizeOf; \+  {-# INLINE alignedSizeOf #-}; \+  alignedAlignment l _ = alignBlock l (alignedAlignment l (Proxy :: Proxy (V2 T))); \+  {-# INLINE alignedAlignment #-}; \+  alignedPeek = alignedPeekM2; \+  {-# INLINE alignedPeek #-}; \+  alignedPoke = alignedPokeM2; \+  {-# INLINE alignedPoke #-}; \+  };++#define X(T) MAT2_STD_INSTANCE(Std140, T)+FOR_EACH_MATRIX_PRIMITIVE (X)+#undef X++#define X(T) MAT2_STD_INSTANCE(Std430, T)+FOR_EACH_MATRIX_PRIMITIVE (X)+#undef X++-- For Scalar layout, matrices are trivially the same as nested vectors+#define X(T) VEC2_SCALAR_INSTANCE((V2 T))+FOR_EACH_MATRIX_PRIMITIVE (X)+#undef X++#define MAT23_STD_INSTANCE(LAYOUT, T) \+instance AlignedStorable LAYOUT (M23 T) where { \+  packedAlignedSizeOf l a = 2 * packedAlignedSizeOfMat l a; \+  {-# INLINE packedAlignedSizeOf #-}; \+  alignedSizeOf = packedAlignedSizeOf; \+  {-# INLINE alignedSizeOf #-}; \+  alignedAlignment l _ = alignBlock l (alignedAlignment l (Proxy :: Proxy (V3 T))); \+  {-# INLINE alignedAlignment #-}; \+  alignedPeek = alignedPeekM2; \+  {-# INLINE alignedPeek #-}; \+  alignedPoke = alignedPokeM2; \+  {-# INLINE alignedPoke #-}; \+  };++#define X(T) MAT23_STD_INSTANCE(Std140, T)+FOR_EACH_MATRIX_PRIMITIVE (X)+#undef X++#define X(T) MAT23_STD_INSTANCE(Std430, T)+FOR_EACH_MATRIX_PRIMITIVE (X)+#undef X++-- For Scalar layout, matrices are trivially the same as nested vectors+#define X(T) VEC2_SCALAR_INSTANCE((V3 T))+FOR_EACH_MATRIX_PRIMITIVE (X)+#undef X++#define MAT24_STD_INSTANCE(LAYOUT, T) \+instance AlignedStorable LAYOUT (M24 T) where { \+  packedAlignedSizeOf l a = 2 * packedAlignedSizeOfMat l a; \+  {-# INLINE packedAlignedSizeOf #-}; \+  alignedSizeOf = packedAlignedSizeOf ; \+  {-# INLINE alignedSizeOf #-}; \+  alignedAlignment l _ = alignBlock l (alignedAlignment l (Proxy :: Proxy (V4 T))); \+  {-# INLINE alignedAlignment #-}; \+  alignedPeek = alignedPeekM2; \+  {-# INLINE alignedPeek #-}; \+  alignedPoke = alignedPokeM2; \+  {-# INLINE alignedPoke #-}; \+  };++#define X(T) MAT24_STD_INSTANCE(Std140, T)+FOR_EACH_MATRIX_PRIMITIVE (X)+#undef X++#define X(T) MAT24_STD_INSTANCE(Std430, T)+FOR_EACH_MATRIX_PRIMITIVE (X)+#undef X++-- For Scalar layout, matrices are trivially the same as nested vectors+#define X(T) VEC2_SCALAR_INSTANCE((V4 T))+FOR_EACH_MATRIX_PRIMITIVE (X)+#undef X++#define VEC3_STD_INSTANCE(LAYOUT, A) \+instance AlignedStorable LAYOUT (V3 A) where { \+  packedAlignedSizeOf l _ = 3 * alignedSizeOf l (Proxy :: Proxy A); \+  {-# INLINE packedAlignedSizeOf #-} ; \+  alignedSizeOf l _ = 3 * alignedSizeOf l (Proxy :: Proxy A); \+  alignedAlignment l _ = 4 * alignedAlignment l (Proxy :: Proxy A); \+  {-# INLINE alignedAlignment #-} ; \+  alignedPeek = alignedPeekV3; \+  {-# INLINE alignedPeek #-} ; \+  alignedPoke = alignedPokeV3; \+    {-# INLINE alignedPoke #-} ; \+  }; \++#define X(LAYOUT, T, S, A) VEC3_STD_INSTANCE(LAYOUT, T)+FOR_EACH_STD140_PRIMITIVE (X)+FOR_EACH_STD430_PRIMITIVE (X)+#undef X++#define VEC3_SCALAR_INSTANCE(A) \+instance AlignedStorable Scalar (V3 A) where { \+  packedAlignedSizeOf _ _ = 3 * alignedSizeOf (Proxy :: Proxy Scalar) (Proxy :: Proxy A); \+  {-# INLINE packedAlignedSizeOf #-}; \+  alignedSizeOf _ _ = 3 * alignedSizeOf (Proxy :: Proxy Scalar) (Proxy :: Proxy A); \+  {-# INLINE alignedSizeOf #-}; \+  alignedAlignment _ _ = alignedAlignment (Proxy :: Proxy Scalar) (Proxy :: Proxy A); \+  {-# INLINE alignedAlignment #-}; \+  alignedPeek = defaultAlignedPeek; \+  {-# INLINE alignedPeek #-}; \+  alignedPoke = defaultAlignedPoke; \+  {-# INLINE alignedPoke #-}; \+  };++#define X(LAYOUT, T, S, A) VEC3_SCALAR_INSTANCE(T)+FOR_EACH_SCALAR_PRIMITIVE (X)+#undef X++#define MAT3_STD_INSTANCE(LAYOUT, A) \+instance AlignedStorable LAYOUT (M33 A) where { \+  packedAlignedSizeOf l a = 3 * packedAlignedSizeOfMat l a; \+  {-# INLINE packedAlignedSizeOf #-}; \+  alignedSizeOf = packedAlignedSizeOf; \+  {-# INLINE alignedSizeOf #-}; \+  alignedAlignment l _ = alignBlock l (alignedAlignment l (Proxy :: Proxy (V3 A))); \+  {-# INLINE alignedAlignment #-} ; \+  alignedPeek = alignedPeekM3; \+  {-# INLINE alignedPeek #-}; \+  alignedPoke = alignedPokeM3; \+  {-# INLINE alignedPoke #-}; \+  };++#define X(T) MAT3_STD_INSTANCE(Std140, T)+FOR_EACH_MATRIX_PRIMITIVE (X)+#undef X++#define X(T) MAT3_STD_INSTANCE(Std430, T)+FOR_EACH_MATRIX_PRIMITIVE (X)+#undef X++-- For Scalar layout, matrices are trivially the same as nested vectors+#define X(T) VEC3_SCALAR_INSTANCE((V3 T))+FOR_EACH_MATRIX_PRIMITIVE (X)+#undef X++#define MAT32_STD_INSTANCE(LAYOUT, A) \+instance AlignedStorable LAYOUT (M32 A) where { \+  packedAlignedSizeOf l a = 3 * packedAlignedSizeOfMat l a ; \+  {-# INLINE packedAlignedSizeOf #-}; \+  alignedSizeOf = packedAlignedSizeOf; \+  {-# INLINE alignedSizeOf #-}; \+  alignedAlignment l _ = alignBlock l (alignedAlignment l (Proxy :: Proxy (V2 A))); \+  {-# INLINE alignedAlignment #-} ; \+  alignedPeek = alignedPeekM3; \+  {-# INLINE alignedPeek #-}; \+  alignedPoke = alignedPokeM3; \+  {-# INLINE alignedPoke #-}; \+  };++#define X(T) MAT32_STD_INSTANCE(Std140, T)+FOR_EACH_MATRIX_PRIMITIVE (X)+#undef X++#define X(T) MAT32_STD_INSTANCE(Std430, T)+FOR_EACH_MATRIX_PRIMITIVE (X)+#undef X++-- For Scalar layout, matrices are trivially the same as nested vectors+#define X(T) VEC3_SCALAR_INSTANCE((V2 T))+FOR_EACH_MATRIX_PRIMITIVE (X)+#undef X++#define MAT34_STD_INSTANCE(LAYOUT, A) \+instance AlignedStorable LAYOUT (M34 A) where { \+  packedAlignedSizeOf l a = 3 * packedAlignedSizeOfMat l a; \+  {-# INLINE packedAlignedSizeOf #-}; \+  alignedSizeOf = packedAlignedSizeOf ; \+  {-# INLINE alignedSizeOf #-}; \+  alignedAlignment l _ = alignBlock l (alignedAlignment l (Proxy :: Proxy (V4 A))); \+  {-# INLINE alignedAlignment #-} ; \+  alignedPeek = alignedPeekM3; \+  {-# INLINE alignedPeek #-}; \+  alignedPoke = alignedPokeM3; \+  {-# INLINE alignedPoke #-}; \+  };++#define X(T) MAT34_STD_INSTANCE(Std140, T)+FOR_EACH_MATRIX_PRIMITIVE (X)+#undef X++#define X(T) MAT34_STD_INSTANCE(Std430, T)+FOR_EACH_MATRIX_PRIMITIVE (X)+#undef X++-- For Scalar layout, matrices are trivially the same as nested vectors+#define X(T) VEC3_SCALAR_INSTANCE((V4 T))+FOR_EACH_MATRIX_PRIMITIVE (X)+#undef X++#define VEC4_STD_INSTANCE(LAYOUT, A) \+instance AlignedStorable LAYOUT (V4 A) where { \+  packedAlignedSizeOf l _ = 4 * alignedSizeOf l (Proxy :: Proxy A); \+  {-# INLINE packedAlignedSizeOf #-}; \+  alignedSizeOf l _ = 4 * alignedSizeOf l (Proxy :: Proxy A); \+  {-# INLINE alignedSizeOf #-}; \+  alignedAlignment l _ = 4 * alignedAlignment l (Proxy :: Proxy A); \+  {-# INLINE alignedAlignment #-} ; \+  alignedPeek = alignedPeekV4; \+  {-# INLINE alignedPeek #-}; \+  alignedPoke = alignedPokeV4; \+  {-# INLINE alignedPoke #-}; \+  };++#define X(LAYOUT, T, S, A) VEC4_STD_INSTANCE(LAYOUT, T)+FOR_EACH_STD140_PRIMITIVE (X)+FOR_EACH_STD430_PRIMITIVE (X)+#undef X++#define VEC4_SCALAR_INSTANCE(A) \+instance AlignedStorable Scalar (V4 A) where { \+  packedAlignedSizeOf _ _ = 4 * alignedSizeOf (Proxy :: Proxy Scalar) (Proxy :: Proxy A); \+  {-# INLINE packedAlignedSizeOf #-}; \+  alignedSizeOf _ _ = 4 * alignedSizeOf (Proxy :: Proxy Scalar) (Proxy :: Proxy A); \+  {-# INLINE alignedSizeOf #-}; \+  alignedAlignment _ _ = alignedAlignment (Proxy :: Proxy Scalar) (Proxy :: Proxy A); \+  {-# INLINE alignedAlignment #-}; \+  alignedPeek = defaultAlignedPeek; \+  {-# INLINE alignedPeek #-}; \+  alignedPoke = defaultAlignedPoke; \+  {-# INLINE alignedPoke #-}; \+  };++#define X(LAYOUT, T, S, A) VEC4_SCALAR_INSTANCE(T)+FOR_EACH_SCALAR_PRIMITIVE (X)+#undef X++#define MAT4_STD_INSTANCE(LAYOUT, A) \+instance AlignedStorable LAYOUT (M44 A) where { \+  packedAlignedSizeOf l a = 4 * packedAlignedSizeOfMat l a; \+  {-# INLINE packedAlignedSizeOf #-}; \+  alignedSizeOf = packedAlignedSizeOf; \+  {-# INLINE alignedSizeOf #-}; \+  alignedAlignment l _ = alignBlock l (alignedAlignment l (Proxy :: Proxy (V4 A))); \+  {-# INLINE alignedAlignment #-}; \+  alignedPeek = alignedPeekM4; \+  {-# INLINE alignedPeek #-}; \+  alignedPoke = alignedPokeM4; \+  {-# INLINE alignedPoke #-}; \+  };++#define X(T) MAT4_STD_INSTANCE(Std140, T)+FOR_EACH_MATRIX_PRIMITIVE (X)+#undef X++#define X(T) MAT4_STD_INSTANCE(Std430, T)+FOR_EACH_MATRIX_PRIMITIVE (X)+#undef X++-- For Scalar layout, matrices are trivially the same as nested vectors+#define X(T) VEC4_SCALAR_INSTANCE((V4 T))+FOR_EACH_MATRIX_PRIMITIVE (X)+#undef X++#define MAT42_STD_INSTANCE(LAYOUT, A) \+instance AlignedStorable LAYOUT (M42 A) where { \+  packedAlignedSizeOf l a = 4 * packedAlignedSizeOfMat l a; \+  {-# INLINE packedAlignedSizeOf #-}; \+  alignedSizeOf = packedAlignedSizeOf; \+  {-# INLINE alignedSizeOf #-}; \+  alignedAlignment l _ = alignBlock l (alignedAlignment l (Proxy :: Proxy (V2 A))); \+  {-# INLINE alignedAlignment #-}; \+  alignedPeek = alignedPeekM4; \+  {-# INLINE alignedPeek #-}; \+  alignedPoke = alignedPokeM4; \+  {-# INLINE alignedPoke #-}; \+  };++#define X(T) MAT42_STD_INSTANCE(Std140, T)+FOR_EACH_MATRIX_PRIMITIVE (X)+#undef X++#define X(T) MAT42_STD_INSTANCE(Std430, T)+FOR_EACH_MATRIX_PRIMITIVE (X)+#undef X++-- For Scalar layout, matrices are trivially the same as nested vectors+#define X(T) VEC4_SCALAR_INSTANCE((V2 T))+FOR_EACH_MATRIX_PRIMITIVE (X)+#undef X++#define MAT43_STD_INSTANCE(LAYOUT, A) \+instance AlignedStorable LAYOUT (M43 A) where { \+  packedAlignedSizeOf l a = 4 * packedAlignedSizeOfMat l a; \+  {-# INLINE packedAlignedSizeOf #-}; \+  alignedSizeOf = packedAlignedSizeOf; \+  {-# INLINE alignedSizeOf #-}; \+  alignedAlignment l _ = alignBlock l (alignedAlignment l (Proxy :: Proxy (V3 A))); \+  {-# INLINE alignedAlignment #-}; \+  alignedPeek = alignedPeekM4; \+  {-# INLINE alignedPeek #-}; \+  alignedPoke = alignedPokeM4; \+  {-# INLINE alignedPoke #-}; \+  };++#define X(T) MAT43_STD_INSTANCE(Std140, T)+FOR_EACH_MATRIX_PRIMITIVE (X)+#undef X++#define X(T) MAT43_STD_INSTANCE(Std430, T)+FOR_EACH_MATRIX_PRIMITIVE (X)+#undef X++-- For Scalar layout, matrices are trivially the same as nested vectors+#define X(T) VEC4_SCALAR_INSTANCE((V3 T))+FOR_EACH_MATRIX_PRIMITIVE (X)+#undef X

@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF tasty-discover -optF --tree-display #-}

@@ -0,0 +1,113 @@+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}++module Foreign.GPU.Marshal.AlignedSpec where++import Control.Exception.Lifted (bracket)+import Control.Monad.IO.Class+import Data.Coerce+import Data.Foldable+import Data.Traversable+import qualified Data.Vector.Storable as SV+import qualified Data.Vector.Storable.Sized as SSV+import Foreign+import GHC.Generics+import Hedgehog+import qualified Hedgehog.Gen as Gen+import qualified Hedgehog.Range as Range+import Linear (V4 (..))++import Foreign.GPU.Marshal.Aligned+import Foreign.GPU.Storable.Aligned+import Foreign.GPU.Storable.AlignedSpec++getBytes :: Int -> Ptr a -> IO [Word8]+getBytes n = peekArray @Word8 n . castPtr++genSV :: (Storable a) => Gen a -> Gen (SV.Vector a)+genSV gen = SV.fromList <$> Gen.list (Range.linear 1 1000) gen++hprop_dynamic_vector_copy_byte_identity :: Property+hprop_dynamic_vector_copy_byte_identity = property do+  vec <- forAll $ genSV (Strided @Std140 <$> genSimple)+  let totalBytes = SV.length vec * sizeOf (SV.head vec)+  sutBytes <- liftIO $ SV.unsafeWith vec (getBytes totalBytes . castPtr)+  oracleBytes <- liftIO $ bracket (mallocBytes totalBytes) free \ptr -> do+    alignedCopyVector (AlignedPtr ptr) vec+    getBytes totalBytes ptr+  sutBytes === oracleBytes++hprop_dynamic_vector_copy :: Property+hprop_dynamic_vector_copy = property do+  values <- forAll $ Gen.list (Range.linear 1 100) genSimple+  let n = length values+      vec = SV.fromList $ map (Strided @Std140) values+      stride = sizeOf (SV.head vec)+      totalBytes = n * stride++  oracleResult <- liftIO $ bracket (mallocBytes totalBytes) free \ptr -> do+    alignedCopyVector (AlignedPtr (castPtr ptr)) vec+    for [0 .. n - 1] \i ->+      coerce <$> peekByteOff @SimpleStd140 ptr (i * stride)++  packedResult <- liftIO $ bracket (mallocBytes totalBytes) free \ptr -> do+    alignedCopyVector (AlignedPtr (castPtr ptr)) vec+    for [0 .. n - 1] \i ->+      coerce <$> peekByteOff @(Packed Std140 Simple) ptr (i * stride)++  oracleResult === values+  packedResult === values++-- | A struct containing a fixed-size array, designed to be optimized+-- by AlignedArray.+data StructWithArray (layout :: MemoryLayout) = StructWithArray+  { fieldA :: Float+  , fieldB :: AlignedArray layout 4 (V4 Float)+  }+  deriving (Generic)++deriving instance+  (MemoryLayoutRules layout, AlignedStorable layout (V4 Float)) => Show (StructWithArray layout)++deriving instance+  (MemoryLayoutRules layout, AlignedStorable layout (V4 Float)) => Eq (StructWithArray layout)++instance AlignedStorable Std140 (StructWithArray Std140)++hprop_dynamic_vector_with_aligned_array_copy :: Property+hprop_dynamic_vector_with_aligned_array_copy = property do+  values <-+    forAll $+      Gen.list+        (Range.linear 1 100)+        (StructWithArray <$> genFloat <*> (mkAlignedArray @Std140 <$> SSV.replicateM (genV genFloat)))++  let vec = SV.fromList $ map (Strided @Std140) values+      structStride = sizeOf (SV.head vec)+      totalBytes = length values * structStride++  bracket (liftIO $ mallocBytes totalBytes) (liftIO . free) \ptr -> do+    alignedCopyVector (AlignedPtr (castPtr ptr)) vec+    for_ (zip [0 ..] values) \(i, StructWithArray expectedFieldA expectedFieldB) -> do+      let structBaseOffset = i * structStride+          fieldAOffset = structBaseOffset+      actualFieldA <- liftIO $ peekByteOff @Float ptr fieldAOffset+      actualFieldA === expectedFieldA++      let fieldBBaseOffset = structBaseOffset + 16+          vec4Stride = 16+          expectedVecs = unAlignedArray expectedFieldB++      for_ [0 .. 3] \j -> do+        let fieldBElementOffset = fieldBBaseOffset + (fromIntegral j * vec4Stride)+        actualVec4 <- liftIO $ peekByteOff @(V4 Float) ptr fieldBElementOffset+        let expectedVec4 = SSV.index expectedVecs j+        actualVec4 === coerce expectedVec4

@@ -0,0 +1,309 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeApplications #-}+{-# OPTIONS_GHC -O -dsuppress-all -dno-suppress-type-signatures -fplugin=Test.Tasty.Inspection.Plugin #-}++module Foreign.GPU.Storable.AlignedInspectionSpec where++import Data.Proxy+import GHC.Generics (Generic)+import Test.Tasty+import Test.Tasty.Inspection++import Foreign.GPU.Storable.Aligned+import Foreign.GPU.Storable.AlignedSpec++-- | Any type that pokes an array incurs allocations, even if it uses `copyBytes` internally.+-- I suspect llvm will unroll the loop if it is used, but I can't prove this by inspecting core.+data Stress+  = Stress+      Insanity+      Insanity+      Insanity+      Insanity+      Insanity+      Insanity+      Insanity+      Insanity+      Insanity+      Insanity+      Insanity+      Insanity+      Insanity+  deriving (Generic)++instance AlignedStorable Std140 Stress+instance AlignedStorable Std430 Stress+instance AlignedStorable Scalar Stress++packedAlignedSizeOf140Stress :: Proxy Std140 -> Proxy Stress -> Int+packedAlignedSizeOf140Stress = packedAlignedSizeOf+packedAlignedSizeOf430Stress :: Proxy Std430 -> Proxy Stress -> Int+packedAlignedSizeOf430Stress = packedAlignedSizeOf+packedAlignedSizeOfScalarStress :: Proxy Scalar -> Proxy Stress -> Int+packedAlignedSizeOfScalarStress = packedAlignedSizeOf++alignedAlignment140Stress :: Proxy Std140 -> Proxy Stress -> Int+alignedAlignment140Stress = alignedAlignment+alignedAlignment430Stress :: Proxy Std430 -> Proxy Stress -> Int+alignedAlignment430Stress = alignedAlignment+alignedAlignmentScalarStress :: Proxy Scalar -> Proxy Stress -> Int+alignedAlignmentScalarStress = alignedAlignment++alignedSizeOf140Stress :: Proxy Std140 -> Proxy Stress -> Int+alignedSizeOf140Stress = alignedSizeOf+alignedSizeOf430Stress :: Proxy Std430 -> Proxy Stress -> Int+alignedSizeOf430Stress = alignedSizeOf+alignedSizeOfScalarStress :: Proxy Scalar -> Proxy Stress -> Int+alignedSizeOfScalarStress = alignedSizeOf++alignedPoke140Stress :: AlignedPtr Std140 Stress -> Stress -> IO ()+alignedPoke140Stress = alignedPoke+alignedPoke430Stress :: AlignedPtr Std430 Stress -> Stress -> IO ()+alignedPoke430Stress = alignedPoke+alignedPokeScalarStress :: AlignedPtr Scalar Stress -> Stress -> IO ()+alignedPokeScalarStress = alignedPoke++alignedPeek140Stress :: AlignedPtr Std140 Stress -> IO Stress+alignedPeek140Stress = alignedPeek+alignedPeek430Stress :: AlignedPtr Std430 Stress -> IO Stress+alignedPeek430Stress = alignedPeek+alignedPeekScalarStress :: AlignedPtr Scalar Stress -> IO Stress+alignedPeekScalarStress = alignedPeek++packedAlignedSizeOf140Nested :: Proxy Std140 -> Proxy Nested -> Int+packedAlignedSizeOf140Nested = packedAlignedSizeOf+packedAlignedSizeOf430Nested :: Proxy Std430 -> Proxy Nested -> Int+packedAlignedSizeOf430Nested = packedAlignedSizeOf+packedAlignedSizeOfScalarNested :: Proxy Scalar -> Proxy Nested -> Int+packedAlignedSizeOfScalarNested = packedAlignedSizeOf++alignedSizeOf140Nested :: Proxy Std140 -> Proxy Nested -> Int+alignedSizeOf140Nested = alignedSizeOf+alignedSizeOf430Nested :: Proxy Std430 -> Proxy Nested -> Int+alignedSizeOf430Nested = alignedSizeOf+alignedSizeOfScalarNested :: Proxy Scalar -> Proxy Nested -> Int+alignedSizeOfScalarNested = alignedSizeOf++alignedAlignment140Nested :: Proxy Std140 -> Proxy Nested -> Int+alignedAlignment140Nested = alignedAlignment+alignedAlignment430Nested :: Proxy Std430 -> Proxy Nested -> Int+alignedAlignment430Nested = alignedAlignment+alignedAlignmentScalarNested :: Proxy Scalar -> Proxy Nested -> Int+alignedAlignmentScalarNested = alignedAlignment++alignedPoke140Nested :: AlignedPtr Std140 Nested -> Nested -> IO ()+alignedPoke140Nested = alignedPoke+alignedPoke430Nested :: AlignedPtr Std430 Nested -> Nested -> IO ()+alignedPoke430Nested = alignedPoke+alignedPokeScalarNested :: AlignedPtr Scalar Nested -> Nested -> IO ()+alignedPokeScalarNested = alignedPoke++alignedPeek140Nested :: AlignedPtr Std140 Nested -> IO Nested+alignedPeek140Nested = alignedPeek+alignedPeek430Nested :: AlignedPtr Std430 Nested -> IO Nested+alignedPeek430Nested = alignedPeek+alignedPeekScalarNested :: AlignedPtr Scalar Nested -> IO Nested+alignedPeekScalarNested = alignedPeek++test_inspection :: [TestTree]+test_inspection =+  [ testGroup+      "Stress"+      [ testGroup+          "std140"+          [ $(inspectTest $ hasNoGenerics 'packedAlignedSizeOf140Stress)+          , $(inspectTest $ hasNoTypeClasses 'packedAlignedSizeOf140Stress)+          , $( inspectTest $+                'packedAlignedSizeOf140Stress+                  `doesNotUseAnyOf` ['galignedSize, 'galignedPoke, 'galignedPeek]+             )+          , $(inspectTest $ hasNoGenerics 'alignedSizeOf140Stress)+          , $(inspectTest $ hasNoTypeClasses 'alignedSizeOf140Stress)+          , $( inspectTest $+                'alignedSizeOf140Stress+                  `doesNotUseAnyOf` ['galignedSize, 'galignedPoke, 'galignedPeek]+             )+          , $(inspectTest $ hasNoGenerics 'alignedAlignment140Stress)+          , $(inspectTest $ hasNoTypeClasses 'alignedAlignment140Stress)+          , $( inspectTest $+                'alignedAlignment140Stress+                  `doesNotUseAnyOf` ['galignedSize, 'galignedPoke, 'galignedPeek]+             )+          , $(inspectTest $ hasNoGenerics 'alignedPoke140Stress)+          , $(inspectTest $ hasNoTypeClasses 'alignedPoke140Stress)+          , $( inspectTest $+                'alignedPoke140Stress+                  `doesNotUseAnyOf` ['galignedSize, 'galignedPoke, 'galignedPeek]+             )+          , $(inspectTest $ hasNoGenerics 'alignedPeek140Stress)+          , $(inspectTest $ hasNoTypeClasses 'alignedPeek140Stress)+          , $( inspectTest $+                'alignedPeek140Stress+                  `doesNotUseAnyOf` ['galignedSize, 'galignedPoke, 'galignedPeek]+             )+          ]+      , testGroup+          "std430"+          [ $(inspectTest $ hasNoGenerics 'packedAlignedSizeOf430Stress)+          , $(inspectTest $ hasNoTypeClasses 'packedAlignedSizeOf430Stress)+          , $( inspectTest $+                'packedAlignedSizeOf140Stress+                  `doesNotUseAnyOf` ['galignedSize, 'galignedPoke, 'galignedPeek]+             )+          , $(inspectTest $ hasNoGenerics 'alignedSizeOf430Stress)+          , $(inspectTest $ hasNoTypeClasses 'alignedSizeOf430Stress)+          , $( inspectTest $+                'alignedSizeOf430Stress+                  `doesNotUseAnyOf` ['galignedSize, 'galignedPoke, 'galignedPeek]+             )+          , $(inspectTest $ hasNoGenerics 'alignedAlignment430Stress)+          , $(inspectTest $ hasNoTypeClasses 'alignedAlignment430Stress)+          , $( inspectTest $+                'alignedAlignment430Stress+                  `doesNotUseAnyOf` ['galignedSize, 'galignedPoke, 'galignedPeek]+             )+          , $(inspectTest $ hasNoGenerics 'alignedPoke430Stress)+          , $(inspectTest $ hasNoTypeClasses 'alignedPoke430Stress)+          , $( inspectTest $+                'alignedPoke430Stress+                  `doesNotUseAnyOf` ['galignedSize, 'galignedPoke, 'galignedPeek]+             )+          , $(inspectTest $ hasNoGenerics 'alignedPeek430Stress)+          , $(inspectTest $ hasNoTypeClasses 'alignedPeek430Stress)+          , $( inspectTest $+                'alignedPeek430Stress+                  `doesNotUseAnyOf` ['galignedSize, 'galignedPoke, 'galignedPeek]+             )+          ]+      , testGroup+          "scalar"+          [ $(inspectTest $ hasNoGenerics 'packedAlignedSizeOfScalarStress)+          , $(inspectTest $ hasNoTypeClasses 'packedAlignedSizeOfScalarStress)+          , $( inspectTest $+                'packedAlignedSizeOfScalarStress `doesNotUseAnyOf` ['galignedSize, 'galignedPoke, 'galignedPeek]+             )+          , $(inspectTest $ hasNoGenerics 'alignedSizeOfScalarStress)+          , $(inspectTest $ hasNoTypeClasses 'alignedSizeOfScalarStress)+          , $( inspectTest $+                'alignedSizeOfScalarStress `doesNotUseAnyOf` ['galignedSize, 'galignedPoke, 'galignedPeek]+             )+          , $(inspectTest $ hasNoGenerics 'alignedAlignmentScalarStress)+          , $(inspectTest $ hasNoTypeClasses 'alignedAlignmentScalarStress)+          , $( inspectTest $+                'alignedAlignmentScalarStress `doesNotUseAnyOf` ['galignedSize, 'galignedPoke, 'galignedPeek]+             )+          , $(inspectTest $ hasNoGenerics 'alignedPokeScalarStress)+          , $(inspectTest $ hasNoTypeClasses 'alignedPokeScalarStress)+          , $( inspectTest $+                'alignedPokeScalarStress `doesNotUseAnyOf` ['galignedSize, 'galignedPoke, 'galignedPeek]+             )+          , $(inspectTest $ hasNoGenerics 'alignedPeekScalarStress)+          , $(inspectTest $ hasNoTypeClasses 'alignedPeekScalarStress)+          , $( inspectTest $+                'alignedPeekScalarStress `doesNotUseAnyOf` ['galignedSize, 'galignedPoke, 'galignedPeek]+             )+          ]+      ]+  , testGroup+      "Nested"+      [ testGroup+          "std140"+          [ $(inspectTest $ hasNoGenerics 'packedAlignedSizeOf140Nested)+          , $(inspectTest $ mkObligation 'packedAlignedSizeOf140Nested NoAllocation)+          , $(inspectTest $ hasNoTypeClasses 'packedAlignedSizeOf140Nested)+          , $( inspectTest $+                'packedAlignedSizeOf140Nested `doesNotUseAnyOf` ['galignedSize, 'galignedPoke, 'galignedPeek]+             )+          , $(inspectTest $ hasNoGenerics 'alignedSizeOf140Nested)+          , $(inspectTest $ mkObligation 'alignedSizeOf140Nested NoAllocation)+          , $(inspectTest $ hasNoTypeClasses 'alignedSizeOf140Nested)+          , $( inspectTest $+                'alignedSizeOf140Nested `doesNotUseAnyOf` ['galignedSize, 'galignedPoke, 'galignedPeek]+             )+          , $(inspectTest $ hasNoGenerics 'alignedAlignment140Nested)+          , $(inspectTest $ mkObligation 'alignedAlignment140Nested NoAllocation)+          , $(inspectTest $ hasNoTypeClasses 'alignedAlignment140Nested)+          , $( inspectTest $+                'alignedAlignment140Nested `doesNotUseAnyOf` ['galignedSize, 'galignedPoke, 'galignedPeek]+             )+          , $(inspectTest $ hasNoGenerics 'alignedPoke140Nested)+          , $(inspectTest $ mkObligation 'alignedPoke140Nested NoAllocation)+          , $(inspectTest $ hasNoTypeClasses 'alignedPoke140Nested)+          , $( inspectTest $ 'alignedPoke140Nested `doesNotUseAnyOf` ['galignedSize, 'galignedPoke, 'galignedPeek]+             )+          , $(inspectTest $ hasNoGenerics 'alignedPeek140Nested)+          , $(inspectTest $ mkObligation 'alignedPeek140Nested NoAllocation)+          , $(inspectTest $ hasNoTypeClasses 'alignedPeek140Nested)+          , $( inspectTest $ 'alignedPeek140Nested `doesNotUseAnyOf` ['galignedSize, 'galignedPoke, 'galignedPeek]+             )+          ]+      , testGroup+          "std430"+          [ $(inspectTest $ hasNoGenerics 'packedAlignedSizeOf430Nested)+          , $(inspectTest $ mkObligation 'packedAlignedSizeOf430Nested NoAllocation)+          , $(inspectTest $ hasNoTypeClasses 'packedAlignedSizeOf430Nested)+          , $( inspectTest $+                'packedAlignedSizeOf430Nested `doesNotUseAnyOf` ['galignedSize, 'galignedPoke, 'galignedPeek]+             )+          , $(inspectTest $ hasNoGenerics 'alignedSizeOf430Nested)+          , $(inspectTest $ mkObligation 'alignedSizeOf430Nested NoAllocation)+          , $(inspectTest $ hasNoTypeClasses 'alignedSizeOf430Nested)+          , $( inspectTest $+                'alignedSizeOf430Nested `doesNotUseAnyOf` ['galignedSize, 'galignedPoke, 'galignedPeek]+             )+          , $(inspectTest $ hasNoGenerics 'alignedAlignment430Nested)+          , $(inspectTest $ mkObligation 'alignedAlignment430Nested NoAllocation)+          , $(inspectTest $ hasNoTypeClasses 'alignedAlignment430Nested)+          , $( inspectTest $+                'alignedAlignment430Nested `doesNotUseAnyOf` ['galignedSize, 'galignedPoke, 'galignedPeek]+             )+          , $(inspectTest $ hasNoGenerics 'alignedPoke430Nested)+          , $(inspectTest $ mkObligation 'alignedPoke430Nested NoAllocation)+          , $(inspectTest $ hasNoTypeClasses 'alignedPoke430Nested)+          , $( inspectTest $ 'alignedPoke430Nested `doesNotUseAnyOf` ['galignedSize, 'galignedPoke, 'galignedPeek]+             )+          , $(inspectTest $ hasNoGenerics 'alignedPeek430Nested)+          , $(inspectTest $ mkObligation 'alignedPeek430Nested NoAllocation)+          , $(inspectTest $ hasNoTypeClasses 'alignedPeek430Nested)+          , $( inspectTest $ 'alignedPeek430Nested `doesNotUseAnyOf` ['galignedSize, 'galignedPoke, 'galignedPeek]+             )+          ]+      , testGroup+          "scalar"+          [ $(inspectTest $ hasNoGenerics 'packedAlignedSizeOfScalarNested)+          , $(inspectTest $ mkObligation 'packedAlignedSizeOfScalarNested NoAllocation)+          , $(inspectTest $ hasNoTypeClasses 'packedAlignedSizeOfScalarNested)+          , $( inspectTest $+                'packedAlignedSizeOfScalarNested `doesNotUseAnyOf` ['galignedSize, 'galignedPoke, 'galignedPeek]+             )+          , $(inspectTest $ hasNoGenerics 'alignedSizeOfScalarNested)+          , $(inspectTest $ mkObligation 'alignedSizeOfScalarNested NoAllocation)+          , $(inspectTest $ hasNoTypeClasses 'alignedSizeOfScalarNested)+          , $( inspectTest $+                'alignedSizeOfScalarNested `doesNotUseAnyOf` ['galignedSize, 'galignedPoke, 'galignedPeek]+             )+          , $(inspectTest $ hasNoGenerics 'alignedAlignmentScalarNested)+          , $(inspectTest $ mkObligation 'alignedAlignmentScalarNested NoAllocation)+          , $(inspectTest $ hasNoTypeClasses 'alignedAlignmentScalarNested)+          , $( inspectTest $+                'alignedAlignmentScalarNested `doesNotUseAnyOf` ['galignedSize, 'galignedPoke, 'galignedPeek]+             )+          , $(inspectTest $ hasNoGenerics 'alignedPokeScalarNested)+          , $(inspectTest $ mkObligation 'alignedPokeScalarNested NoAllocation)+          , $(inspectTest $ hasNoTypeClasses 'alignedPokeScalarNested)+          , $( inspectTest $+                'alignedPokeScalarNested `doesNotUseAnyOf` ['galignedSize, 'galignedPoke, 'galignedPeek]+             )+          , $(inspectTest $ hasNoGenerics 'alignedPeekScalarNested)+          , $(inspectTest $ mkObligation 'alignedPeekScalarNested NoAllocation)+          , $(inspectTest $ hasNoTypeClasses 'alignedPeekScalarNested)+          , $( inspectTest $+                'alignedPeekScalarNested `doesNotUseAnyOf` ['galignedSize, 'galignedPoke, 'galignedPeek]+             )+          ]+      ]+  ]

@@ -0,0 +1,2448 @@+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}++-- | Alignments verified by running glslang against AlignedSpec.glsl and manually+-- inspecting the SPIR-V.+--+-- You can use https://godbolt.org/z/njnvM8q4o to check for yourself.+module Foreign.GPU.Storable.AlignedSpec where++import Control.Exception.Lifted (bracket)+import Control.Monad (replicateM)+import Control.Monad.IO.Class+import Control.Monad.Trans.Control (MonadBaseControl)+import Data.Coerce+import Data.Foldable (traverse_)+import Data.Int+import Data.Proxy+import Data.Typeable (Typeable, showsTypeRep, typeRep)+import qualified Data.Vector.Generic as GV+import qualified Data.Vector.Generic.Sized as SGV+import qualified Data.Vector.Sized as SV+import qualified Data.Vector.Storable.Sized as SSV+import Data.Word+import Foreign+import GHC.Generics+import GHC.TypeLits+import Hedgehog+import qualified Hedgehog.Gen as Gen+import qualified Hedgehog.Range as Range+import Linear hiding (outer)+import Numeric (showHex)+import Numeric.Half+import Test.Tasty.HUnit++import Foreign.GPU.Storable.Aligned++--------------------------------------------------------------------------------+-- Test harness+--------------------------------------------------------------------------------++newtype Canary = Canary {unCanary :: Word64}+  deriving newtype (Storable, Num, Eq)++instance Show Canary where+  showsPrec _ (Canary n) = showHex n++genCanary :: Gen Canary+genCanary =+  Gen.element+    [ 0xDEADBEEFDEADBEEF+    , 0xCAFEBABECAFEBABE+    , 0xABADBABEABADBABE+    , 0xCDCDCDCDCDCDCDCD+    , 0x5555555555555555+    , 0xAAAAAAAAAAAAAAAA+    , 0x0000000000000000+    , 0xFFFFFFFFFFFFFFFF+    , 0x0123456789ABCDEF+    , 0xFEDCBA9876543210+    ]++genCanaries :: Int -> Gen [Canary]+genCanaries sz = replicateM sz genCanary++-- |+-- Given a SUT and an oracle, checks that they round trip with oneself and one another.+--+-- We validate four ways: SUT vs. SUT, Oracle vs. Oracle, SUT vs. Oracle, Oracle vs. SUT.+-- At the top of the test, the SUT size and alignment is verified to match the Oracle's.+--+-- This verifies:+-- 1. The SUT is coherent.+-- 2. The Oracle is coherent.+-- 3. The SUT's 'peek' is the inverse of the Oracle's 'poke'.+-- 4. The Oracle's 'peek' is the inverse of the SUT's 'poke'.+--+-- This makes it highly probable that we catch subtle unidirectional bugs.+--+-- For each combination (a, b):+-- 1. Allocate a buffer approximately 3*sizeOf(SUT) - rounded up to the next multiple of sizeof(Canary)+-- 2. Poison the buffer with a repeating bit pattern (0xCD)+-- 3. Fill the edges of the buffer with a canary value.+-- 4. Check that the canaries got written to the right place.+-- 5. Poke `a` into the middle of the buffer+-- 6. Check the canaries -- if we overrun or undrrun the buffer, it's very likely to show here.+-- 7. Peek `b` out of the middle of the buffer+-- 8. Out of an overabundance of caution, check the canaries again+-- 9. Check that the peeked value of `b` is equal to the poked value of `a`+-- 10. Check that the peeked value of `b` is equal to the poked value of `b`+--+-- This makes it incredibly unlikely (but not impossible) that this module corrupts memory in a way+-- that isn't caught in test.+ptrTripping+  :: forall s o m+   . ( HasCallStack+     , Coercible s o+     , MonadBaseControl IO m+     , MonadIO m+     , Typeable s+     , Typeable o+     , Eq s+     , Eq o+     , Show s+     , Show o+     , Storable s+     , Storable o+     )+  => s+  -> o+  -> PropertyT m ()+ptrTripping sut oracle = do+  let sz = sizeOf sut+      cSz = sizeOf @Canary undefined+      pSz = roundUpTo cSz sz+      tSz = sz + 2 * pSz+      lPadOffsets = [0, cSz .. pSz - cSz]+      rPadOffsets = [pSz + sz, pSz + sz + cSz .. tSz - cSz]+      poison = 0xCD+  sz === sizeOf oracle+  alignment sut === alignment oracle++  lCanaries <- zip lPadOffsets <$> forAll (genCanaries (length lPadOffsets))+  rCanaries <- zip rPadOffsets <$> forAll (genCanaries (length rPadOffsets))++  let populateCanaries ptr = liftIO do+        traverse_ (uncurry (pokeByteOff ptr)) lCanaries+        traverse_ (uncurry (pokeByteOff ptr)) rCanaries++      checkCanary ptr offset canary = do+        result <- liftIO $ peekByteOff ptr offset+        Canary result === canary++      checkCanaries ptr = do+        annotate $ "Left pad: 0-" <> show pSz+        traverse_ (uncurry (checkCanary ptr)) lCanaries+        annotate $ "Right pad: " <> show (pSz + sz) <> "-" <> show tSz+        traverse_ (uncurry (checkCanary ptr)) rCanaries++      checkRoundTrip+        :: forall a b+         . ( HasCallStack+           , Coercible a b+           , MonadBaseControl IO m+           , MonadIO m+           , Typeable a+           , Typeable b+           , Eq a+           , Eq b+           , Show a+           , Show b+           , Storable a+           , Storable b+           )+        => a+        -> b+        -> PropertyT m ()+      checkRoundTrip a b = bracket (liftIO $ mallocBytes @a tSz) (liftIO . free) \ptr -> do+        annotate+          $ showsTypeRep (typeRep (Proxy @a))+            . showString " x "+            . showsTypeRep (typeRep (Proxy @b))+          $ ""+        liftIO $ fillBytes ptr poison tSz+        populateCanaries ptr+        checkCanaries ptr++        liftIO $ pokeByteOff ptr pSz a+        checkCanaries ptr++        (result :: b) <- liftIO $ peekByteOff (castPtr @a @b ptr) pSz+        checkCanaries ptr++        result === coerce a+        result === b++  checkRoundTrip sut sut+  checkRoundTrip oracle oracle+  checkRoundTrip sut oracle+  checkRoundTrip oracle sut++hprop_base_float_is_storable :: Property+hprop_base_float_is_storable = property do+  let x = Strided @Std140 (1.0 :: Float)+  let _ = sizeOf x+  success++hprop_base_int16_round_trips :: Property+hprop_base_int16_round_trips = property do+  ptrTripping @Int16 @Int16 12 12++--------------------------------------------------------------------------------+-- Simple+--------------------------------------------------------------------------------++data Simple = Simple+  { simpleA :: Float+  , simpleB :: Int32+  }+  deriving (Generic, Typeable, Show, Eq)++genSimple :: Gen Simple+genSimple = Simple <$> genFloat <*> genInt++instance AlignedStorable Std140 Simple+instance AlignedStorable Std430 Simple+instance AlignedStorable Scalar Simple++newtype SimpleStd140 = SimpleStd140 Simple+  deriving (Generic, Typeable, Show, Eq)++instance Storable SimpleStd140 where+  sizeOf _ = 16+  alignment _ = 16+  peek ptr = SimpleStd140 <$> (Simple <$> peekByteOff ptr 0 <*> peekByteOff ptr 4)+  poke ptr (SimpleStd140 Simple{..}) = do+    pokeByteOff ptr 0 simpleA+    pokeByteOff ptr 4 simpleB++unit_simple_std140_packed_size :: Assertion+unit_simple_std140_packed_size =+  packedAlignedSizeOf @Std140 @Simple Proxy Proxy @?= 8++hprop_simple_std140_round_trip :: Property+hprop_simple_std140_round_trip = property do+  simple <- forAll genSimple+  let sut = Strided @Std140 simple+      oracle = SimpleStd140 simple+  ptrTripping sut oracle++newtype SimpleStd430 = SimpleStd430 Simple+  deriving (Generic, Typeable, Show, Eq)++instance Storable SimpleStd430 where+  sizeOf _ = 8+  alignment _ = 4+  peek ptr = SimpleStd430 <$> (Simple <$> peekByteOff ptr 0 <*> peekByteOff ptr 4)+  poke ptr (SimpleStd430 Simple{..}) = do+    pokeByteOff ptr 0 simpleA+    pokeByteOff ptr 4 simpleB++unit_simple_std430_packed_size :: Assertion+unit_simple_std430_packed_size =+  packedAlignedSizeOf @Std430 @Simple Proxy Proxy @?= 8++hprop_simple_std430_round_trip :: Property+hprop_simple_std430_round_trip = property do+  val <- forAll genSimple+  let sut = Strided @Std430 val+  let oracle = SimpleStd430 val+  ptrTripping sut oracle++newtype SimpleScalar = SimpleScalar Simple+  deriving (Generic, Typeable, Show, Eq)++instance Storable SimpleScalar where+  sizeOf _ = 8+  alignment _ = 4+  peek ptr = SimpleScalar <$> (Simple <$> peekByteOff ptr 0 <*> peekByteOff ptr 4)+  poke ptr (SimpleScalar Simple{..}) = do+    pokeByteOff ptr 0 simpleA+    pokeByteOff ptr 4 simpleB++unit_simple_scalar_packed_size :: Assertion+unit_simple_scalar_packed_size =+  packedAlignedSizeOf @Scalar @Simple Proxy Proxy @?= 8++hprop_simple_scalar_round_trip :: Property+hprop_simple_scalar_round_trip = property do+  val <- forAll genSimple+  let sut = Strided @Scalar val+  let oracle = SimpleScalar val+  ptrTripping sut oracle++--------------------------------------------------------------------------------+-- Nonsquare+--------------------------------------------------------------------------------++-- | Needs to be documented, but Mnm -> matnxm+data TestNonSquare = TestNonSquare+  { matA :: M32 Half+  , matB :: M43 Double+  }+  deriving (Generic, Typeable, Show, Eq)++genTestNonSquare :: Gen TestNonSquare+genTestNonSquare = TestNonSquare <$> genMat genFloat <*> genMat genFloat++instance AlignedStorable Std140 TestNonSquare+instance AlignedStorable Std430 TestNonSquare+instance AlignedStorable Scalar TestNonSquare++newtype TestNonSquareStd140 = TestNonSquareStd140 TestNonSquare+  deriving (Generic, Typeable, Show, Eq)++instance Storable TestNonSquareStd140 where+  sizeOf _ = 192+  alignment _ = 32+  peek ptr =+    TestNonSquareStd140+      <$> (TestNonSquare <$> peekMat3Oracle Std140 ptr 0 <*> peekMat4Oracle Std140 ptr 64)+  poke ptr (TestNonSquareStd140 TestNonSquare{..}) = do+    pokeMat3Oracle Std140 ptr 0 matA+    pokeMat4Oracle Std140 ptr 64 matB++hprop_testnonsquare_std140_round_trip :: Property+hprop_testnonsquare_std140_round_trip = property do+  value <- forAll genTestNonSquare+  let sut = Strided @Std140 value+      oracle = TestNonSquareStd140 value+  ptrTripping sut oracle++newtype TestNonSquareStd430 = TestNonSquareStd430 TestNonSquare+  deriving (Generic, Typeable, Show, Eq)++instance Storable TestNonSquareStd430 where+  sizeOf _ = 160+  alignment _ = 32+  peek ptr =+    TestNonSquareStd430+      <$> (TestNonSquare <$> peekMat3Oracle Std430 ptr 0 <*> peekMat4Oracle Std430 ptr 32)+  poke ptr (TestNonSquareStd430 TestNonSquare{..}) = do+    pokeMat3Oracle Std430 ptr 0 matA+    pokeMat4Oracle Std430 ptr 32 matB++hprop_testnonsquare_std430_round_trip :: Property+hprop_testnonsquare_std430_round_trip = property do+  value <- forAll genTestNonSquare+  let sut = Strided @Std430 value+      oracle = TestNonSquareStd430 value+  ptrTripping sut oracle++newtype TestNonSquareScalar = TestNonSquareScalar TestNonSquare+  deriving (Generic, Typeable, Show, Eq)++instance Storable TestNonSquareScalar where+  sizeOf _ = 112+  alignment _ = 8+  peek ptr = TestNonSquareScalar <$> (TestNonSquare <$> peekByteOff ptr 0 <*> peekByteOff ptr 16)+  poke ptr (TestNonSquareScalar TestNonSquare{..}) = do+    pokeByteOff ptr 0 matA+    pokeByteOff ptr 16 matB++hprop_testnonsquare_scalar_round_trip :: Property+hprop_testnonsquare_scalar_round_trip = property do+  value <- forAll genTestNonSquare+  let sut = Strided @Scalar value+      oracle = TestNonSquareScalar value+  ptrTripping sut oracle++--------------------------------------------------------------------------------+-- D2+--------------------------------------------------------------------------------++data D2 = D2+  { d2A :: Half+  , d2B :: V2 Float+  , d2C :: Half+  , d2D :: M22 Float+  , d2E :: Half+  }+  deriving (Generic, Typeable, Show, Eq)++genD2 :: Gen D2+genD2 = D2 <$> genFloat <*> genV genFloat <*> genFloat <*> genMat genFloat <*> genFloat++instance AlignedStorable Std140 D2+instance AlignedStorable Std430 D2+instance AlignedStorable Scalar D2++newtype D2Std140 = D2Std140 D2+  deriving (Generic, Typeable, Show, Eq)++instance Storable D2Std140 where+  sizeOf _ = 80+  alignment _ = 16+  peek ptr =+    D2Std140+      <$> ( D2+              <$> peekByteOff ptr 0+              <*> peekByteOff ptr 8+              <*> peekByteOff ptr 16+              <*> peekMat2Oracle Std140 ptr 32+              <*> peekByteOff ptr 64+          )+  poke ptr (D2Std140 D2{..}) = do+    pokeByteOff ptr 0 d2A+    pokeByteOff ptr 8 d2B+    pokeByteOff ptr 16 d2C+    pokeMat2Oracle Std140 ptr 32 d2D+    pokeByteOff ptr 64 d2E++unit_d2_std140_packed_size :: Assertion+unit_d2_std140_packed_size =+  packedAlignedSizeOf @Std140 @D2 Proxy Proxy @?= 66++hprop_d2_std140_round_trip :: Property+hprop_d2_std140_round_trip = property do+  d2 <- forAll genD2+  let sut = Strided @Std140 d2+      oracle = D2Std140 d2+  ptrTripping sut oracle++newtype D2Std430 = D2Std430 D2+  deriving (Generic, Typeable, Show, Eq)++instance Storable D2Std430 where+  sizeOf _ = 48+  alignment _ = 8+  peek ptr =+    D2Std430+      <$> ( D2+              <$> peekByteOff ptr 0+              <*> peekByteOff ptr 8+              <*> peekByteOff ptr 16+              <*> peekMat2Oracle Std430 ptr 24+              <*> peekByteOff ptr 40+          )+  poke ptr (D2Std430 D2{..}) = do+    pokeByteOff ptr 0 d2A+    pokeByteOff ptr 8 d2B+    pokeByteOff ptr 16 d2C+    pokeMat2Oracle Std430 ptr 24 d2D+    pokeByteOff ptr 40 d2E++unit_d2_std430_packed_size :: Assertion+unit_d2_std430_packed_size =+  packedAlignedSizeOf @Std430 @D2 Proxy Proxy @?= 42++hprop_d2_std430_round_trip :: Property+hprop_d2_std430_round_trip = property do+  val <- forAll genD2+  let sut = Strided @Std430 val+      oracle = D2Std430 val+  ptrTripping sut oracle++newtype D2Scalar = D2Scalar D2+  deriving (Generic, Typeable, Show, Eq)++instance Storable D2Scalar where+  sizeOf _ = 36+  alignment _ = 4+  peek ptr =+    D2Scalar+      <$> ( D2+              <$> peekByteOff ptr 0+              <*> peekByteOff ptr 4+              <*> peekByteOff ptr 12+              <*> peekByteOff ptr 16+              <*> peekByteOff ptr 32+          )+  poke ptr (D2Scalar D2{..}) = do+    pokeByteOff ptr 0 d2A+    pokeByteOff ptr 4 d2B+    pokeByteOff ptr 12 d2C+    pokeByteOff ptr 16 d2D+    pokeByteOff ptr 32 d2E++unit_d2_scalar_packed_size :: Assertion+unit_d2_scalar_packed_size =+  packedAlignedSizeOf @Scalar @D2 Proxy Proxy @?= 34++hprop_d2_scalar_round_trip :: Property+hprop_d2_scalar_round_trip = property do+  val <- forAll genD2+  let sut = Strided @Scalar val+      oracle = D2Scalar val+  ptrTripping sut oracle++--------------------------------------------------------------------------------+-- Kitchen sink+--------------------------------------------------------------------------------++-- | Every shader primitive, ordered to be pretty close to worst case for padding+-- rules+data KitchenSink = KitchenSink+  { ksA :: Half+  , ksB :: V3 Double+  , ksC :: Float+  , ksD :: M33 Float+  , ksE :: Int32+  , ksF :: M33 Float+  , ksG :: Word8+  , ksH :: M32 Half+  , ksI :: Word16+  , ksJ :: M23 Half+  , ksK :: Word16+  , ksL :: M43 Float+  , ksM :: Int16+  , ksN :: M34 Double+  , ksO :: Bool+  , ksP :: Int8+  , ksQ :: M44 Half+  , ksR :: Int64+  , ksS :: M42 Double+  , ksT :: Word64+  , ksU :: M24 Half+  , ksV :: Half+  }+  deriving (Generic, Typeable, Show, Eq)++genKitchenSink :: Gen KitchenSink+genKitchenSink =+  KitchenSink+    <$> genFloat+    <*> genV genFloat+    <*> genFloat+    <*> genMat genFloat+    <*> genInt+    <*> genMat genFloat+    <*> genInt+    <*> genMat genFloat+    <*> genInt+    <*> genMat genFloat+    <*> genInt+    <*> genMat genFloat+    <*> genInt+    <*> genMat genFloat+    <*> Gen.bool+    <*> genInt+    <*> genMat genFloat+    <*> genInt+    <*> genMat genFloat+    <*> genInt+    <*> genMat genFloat+    <*> genFloat++instance AlignedStorable Std140 KitchenSink+instance AlignedStorable Std430 KitchenSink+instance AlignedStorable Scalar KitchenSink++newtype KitchenSinkStd140 = KitchenSinkStd140 KitchenSink+  deriving (Generic, Typeable, Show, Eq)++instance Storable KitchenSinkStd140 where+  sizeOf _ = 704+  alignment _ = 32+  peek ptr =+    KitchenSinkStd140+      <$> ( KitchenSink+              <$> peekByteOff ptr 0+              <*> peekByteOff ptr 32+              <*> peekByteOff ptr 56+              <*> peekMat3Oracle Std140 ptr 64+              <*> peekByteOff ptr 112+              <*> peekMat3Oracle Std140 ptr 128+              <*> peekByteOff ptr 176+              <*> peekMat3Oracle Std140 ptr 192+              <*> peekByteOff ptr 240+              <*> peekMat2Oracle Std140 ptr 256+              <*> peekByteOff ptr 288+              <*> peekMat4Oracle Std140 ptr 304+              <*> peekByteOff ptr 368+              <*> peekMat3Oracle Std140 ptr 384+              <*> peekByteOff ptr 480+              <*> peekByteOff ptr 484+              <*> peekMat4Oracle Std140 ptr 496+              <*> peekByteOff ptr 560+              <*> peekMat4Oracle Std140 ptr 576+              <*> peekByteOff ptr 640+              <*> peekMat2Oracle Std140 ptr 656+              <*> peekByteOff ptr 688+          )+  poke ptr (KitchenSinkStd140 KitchenSink{..}) = do+    pokeByteOff ptr 0 ksA+    pokeByteOff ptr 32 ksB+    pokeByteOff ptr 56 ksC+    pokeMat3Oracle Std140 ptr 64 ksD+    pokeByteOff ptr 112 ksE+    pokeMat3Oracle Std140 ptr 128 ksF+    pokeByteOff ptr 176 ksG+    pokeMat3Oracle Std140 ptr 192 ksH+    pokeByteOff ptr 240 ksI+    pokeMat2Oracle Std140 ptr 256 ksJ+    pokeByteOff ptr 288 ksK+    pokeMat4Oracle Std140 ptr 304 ksL+    pokeByteOff ptr 368 ksM+    pokeMat3Oracle Std140 ptr 384 ksN+    pokeByteOff ptr 480 ksO+    pokeByteOff ptr 484 ksP+    pokeMat4Oracle Std140 ptr 496 ksQ+    pokeByteOff ptr 560 ksR+    pokeMat4Oracle Std140 ptr 576 ksS+    pokeByteOff ptr 640 ksT+    pokeMat2Oracle Std140 ptr 656 ksU+    pokeByteOff ptr 688 ksV++hprop_kitchensink_std140_round_trip :: Property+hprop_kitchensink_std140_round_trip = property do+  val <- forAll genKitchenSink+  let sut = Strided @Std140 val+      oracle = KitchenSinkStd140 val+  ptrTripping sut oracle++newtype KitchenSinkStd430 = KitchenSinkStd430 KitchenSink+  deriving (Generic, Typeable, Show, Eq)++instance Storable KitchenSinkStd430 where+  sizeOf _ = 576+  alignment _ = 32+  peek ptr =+    KitchenSinkStd430+      <$> ( KitchenSink+              <$> peekByteOff ptr 0+              <*> peekByteOff ptr 32+              <*> peekByteOff ptr 56+              <*> peekMat3Oracle Std430 ptr 64+              <*> peekByteOff ptr 112+              <*> peekMat3Oracle Std430 ptr 128+              <*> peekByteOff ptr 176+              <*> peekMat3Oracle Std430 ptr 180+              <*> peekByteOff ptr 192+              <*> peekMat2Oracle Std430 ptr 200+              <*> peekByteOff ptr 216+              <*> peekMat4Oracle Std430 ptr 224+              <*> peekByteOff ptr 288+              <*> peekMat3Oracle Std430 ptr 320+              <*> peekByteOff ptr 416+              <*> peekByteOff ptr 420+              <*> peekMat4Oracle Std430 ptr 424+              <*> peekByteOff ptr 456+              <*> peekMat4Oracle Std430 ptr 464+              <*> peekByteOff ptr 528+              <*> peekMat2Oracle Std430 ptr 536+              <*> peekByteOff ptr 552+          )+  poke ptr (KitchenSinkStd430 KitchenSink{..}) = do+    pokeByteOff ptr 0 ksA+    pokeByteOff ptr 32 ksB+    pokeByteOff ptr 56 ksC+    pokeMat3Oracle Std430 ptr 64 ksD+    pokeByteOff ptr 112 ksE+    pokeMat3Oracle Std430 ptr 128 ksF+    pokeByteOff ptr 176 ksG+    pokeMat3Oracle Std430 ptr 180 ksH+    pokeByteOff ptr 192 ksI+    pokeMat2Oracle Std430 ptr 200 ksJ+    pokeByteOff ptr 216 ksK+    pokeMat4Oracle Std430 ptr 224 ksL+    pokeByteOff ptr 288 ksM+    pokeMat3Oracle Std430 ptr 320 ksN+    pokeByteOff ptr 416 ksO+    pokeByteOff ptr 420 ksP+    pokeMat4Oracle Std430 ptr 424 ksQ+    pokeByteOff ptr 456 ksR+    pokeMat4Oracle Std430 ptr 464 ksS+    pokeByteOff ptr 528 ksT+    pokeMat2Oracle Std430 ptr 536 ksU+    pokeByteOff ptr 552 ksV++hprop_kitchensink_std430_round_trip :: Property+hprop_kitchensink_std430_round_trip = property do+  val <- forAll genKitchenSink+  let sut = Strided @Std430 val+      oracle = KitchenSinkStd430 val+  ptrTripping sut oracle++-- Oracle for scalar layout+newtype KitchenSinkScalar = KitchenSinkScalar KitchenSink+  deriving (Generic, Typeable, Show, Eq)++instance Storable KitchenSinkScalar where+  sizeOf _ = 440+  alignment _ = 8 -- Based on alignment of dvec3+  peek ptr =+    KitchenSinkScalar+      <$> ( KitchenSink+              <$> peekByteOff ptr 0+              <*> peekByteOff ptr 8+              <*> peekByteOff ptr 32+              <*> peekByteOff ptr 36+              <*> peekByteOff ptr 72+              <*> peekByteOff ptr 76+              <*> peekByteOff ptr 112+              <*> peekByteOff ptr 114+              <*> peekByteOff ptr 126+              <*> peekByteOff ptr 128+              <*> peekByteOff ptr 140+              <*> peekByteOff ptr 144+              <*> peekByteOff ptr 192+              <*> peekByteOff ptr 200+              <*> peekByteOff ptr 296+              <*> peekByteOff ptr 300+              <*> peekByteOff ptr 302+              <*> peekByteOff ptr 336+              <*> peekByteOff ptr 344+              <*> peekByteOff ptr 408+              <*> peekByteOff ptr 416+              <*> peekByteOff ptr 432+          )+  poke ptr (KitchenSinkScalar KitchenSink{..}) = do+    pokeByteOff ptr 0 ksA+    pokeByteOff ptr 8 ksB+    pokeByteOff ptr 32 ksC+    pokeByteOff ptr 36 ksD+    pokeByteOff ptr 72 ksE+    pokeByteOff ptr 76 ksF+    pokeByteOff ptr 112 ksG+    pokeByteOff ptr 114 ksH+    pokeByteOff ptr 126 ksI+    pokeByteOff ptr 128 ksJ+    pokeByteOff ptr 140 ksK+    pokeByteOff ptr 144 ksL+    pokeByteOff ptr 192 ksM+    pokeByteOff ptr 200 ksN+    pokeByteOff ptr 296 ksO+    pokeByteOff ptr 300 ksP+    pokeByteOff ptr 302 ksQ+    pokeByteOff ptr 336 ksR+    pokeByteOff ptr 344 ksS+    pokeByteOff ptr 408 ksT+    pokeByteOff ptr 416 ksU+    pokeByteOff ptr 432 ksV++hprop_kitchensink_scalar_round_trip :: Property+hprop_kitchensink_scalar_round_trip = property do+  val <- forAll genKitchenSink+  let sut = Strided @Scalar val+      oracle = KitchenSinkScalar val+  ptrTripping sut oracle++--------------------------------------------------------------------------------+-- LayoutBug+--------------------------------------------------------------------------------++data LayoutBug = LayoutBug+  { fieldA :: Float+  , fieldB :: Float+  , fieldC :: Double+  }+  deriving (Generic, Typeable, Show, Eq)++genLayoutBug :: Gen LayoutBug+genLayoutBug = LayoutBug <$> genFloat <*> genFloat <*> genFloat++instance AlignedStorable Std140 LayoutBug+instance AlignedStorable Std430 LayoutBug+instance AlignedStorable Scalar LayoutBug++newtype LayoutBugStd140 = LayoutBugStd140 LayoutBug+  deriving (Generic, Typeable, Show, Eq)++instance Storable LayoutBugStd140 where+  sizeOf _ = 16+  alignment _ = 16+  peek ptr = LayoutBugStd140 <$> (LayoutBug <$> peekByteOff ptr 0 <*> peekByteOff ptr 4 <*> peekByteOff ptr 8)+  poke ptr (LayoutBugStd140 LayoutBug{..}) = do+    pokeByteOff ptr 0 fieldA+    pokeByteOff ptr 4 fieldB+    pokeByteOff ptr 8 fieldC++unit_layoutbug_std140_packed_size :: Assertion+unit_layoutbug_std140_packed_size =+  packedAlignedSizeOf @Std140 @LayoutBug Proxy Proxy @?= 16++hprop_layoutbug_std140_round_trip :: Property+hprop_layoutbug_std140_round_trip = property do+  val <- forAll genLayoutBug+  let sut = Strided @Std140 val+      oracle = LayoutBugStd140 val+  ptrTripping sut oracle++newtype LayoutBugStd430 = LayoutBugStd430 LayoutBug+  deriving (Generic, Typeable, Show, Eq)++instance Storable LayoutBugStd430 where+  sizeOf _ = 16+  alignment _ = 8+  peek ptr = LayoutBugStd430 <$> (LayoutBug <$> peekByteOff ptr 0 <*> peekByteOff ptr 4 <*> peekByteOff ptr 8)+  poke ptr (LayoutBugStd430 LayoutBug{..}) = do+    pokeByteOff ptr 0 fieldA+    pokeByteOff ptr 4 fieldB+    pokeByteOff ptr 8 fieldC++unit_layoutbug_std430_packed_size :: Assertion+unit_layoutbug_std430_packed_size =+  packedAlignedSizeOf @Std430 @LayoutBug Proxy Proxy @?= 16++hprop_layoutbug_std430_round_trip :: Property+hprop_layoutbug_std430_round_trip = property do+  val <- forAll genLayoutBug+  let sut = Strided @Std430 val+  let oracle = LayoutBugStd430 val+  ptrTripping sut oracle++newtype LayoutBugScalar = LayoutBugScalar LayoutBug+  deriving (Generic, Typeable, Show, Eq)++instance Storable LayoutBugScalar where+  sizeOf _ = 16+  alignment _ = 8+  peek ptr = LayoutBugScalar <$> (LayoutBug <$> peekByteOff ptr 0 <*> peekByteOff ptr 4 <*> peekByteOff ptr 8)+  poke ptr (LayoutBugScalar LayoutBug{..}) = do+    pokeByteOff ptr 0 fieldA+    pokeByteOff ptr 4 fieldB+    pokeByteOff ptr 8 fieldC++unit_layoutbug_scalar_packed_size :: Assertion+unit_layoutbug_scalar_packed_size =+  packedAlignedSizeOf @Scalar @LayoutBug Proxy Proxy @?= 16++hprop_layoutbug_scalar_round_trip :: Property+hprop_layoutbug_scalar_round_trip = property do+  val <- forAll genLayoutBug+  let sut = Strided @Scalar val+  let oracle = LayoutBugScalar val+  ptrTripping sut oracle++--------------------------------------------------------------------------------+-- PaddingTest+--------------------------------------------------------------------------------++data PaddingTest = PaddingTest+  { f :: Float+  , v :: V4 Float+  }+  deriving (Generic, Typeable, Show, Eq)++genPaddingTest :: Gen PaddingTest+genPaddingTest = PaddingTest <$> genFloat <*> genV genFloat++instance AlignedStorable Std140 PaddingTest+instance AlignedStorable Std430 PaddingTest+instance AlignedStorable Scalar PaddingTest++newtype PaddingTestStd140 = PaddingTestStd140 PaddingTest+  deriving (Generic, Typeable, Show, Eq)++instance Storable PaddingTestStd140 where+  sizeOf _ = 32+  alignment _ = 16+  peek ptr = PaddingTestStd140 <$> (PaddingTest <$> peekByteOff ptr 0 <*> peekByteOff ptr 16)+  poke ptr (PaddingTestStd140 PaddingTest{..}) = do+    pokeByteOff ptr 0 f+    pokeByteOff ptr 16 v++unit_paddingtest_std140_packed_size :: Assertion+unit_paddingtest_std140_packed_size =+  packedAlignedSizeOf @Std140 @PaddingTest Proxy Proxy @?= 32++hprop_paddingtest_std140_round_trip :: Property+hprop_paddingtest_std140_round_trip = property do+  val <- forAll genPaddingTest+  let sut = Strided @Std140 val+  let oracle = PaddingTestStd140 val+  ptrTripping sut oracle++-- Oracle for Std430 layout.+-- Layout is identical to Std140 for this struct, but we define a separate+-- oracle to maintain a 1-to-1 mapping between tests and layouts.+newtype PaddingTestStd430 = PaddingTestStd430 PaddingTest+  deriving (Generic, Typeable, Show, Eq)++instance Storable PaddingTestStd430 where+  sizeOf _ = 32+  alignment _ = 16+  peek ptr = PaddingTestStd430 <$> (PaddingTest <$> peekByteOff ptr 0 <*> peekByteOff ptr 16)+  poke ptr (PaddingTestStd430 PaddingTest{..}) = do+    pokeByteOff ptr 0 f+    pokeByteOff ptr 16 v++unit_paddingtest_std430_packed_size :: Assertion+unit_paddingtest_std430_packed_size =+  packedAlignedSizeOf @Std430 @PaddingTest Proxy Proxy @?= 32++hprop_paddingtest_std430_round_trip :: Property+hprop_paddingtest_std430_round_trip = property do+  val <- forAll genPaddingTest+  let sut = Strided @Std430 val+  let oracle = PaddingTestStd430 val+  ptrTripping sut oracle++newtype PaddingTestScalar = PaddingTestScalar PaddingTest+  deriving (Generic, Typeable, Show, Eq)++instance Storable PaddingTestScalar where+  sizeOf _ = 20+  alignment _ = 4+  peek ptr = PaddingTestScalar <$> (PaddingTest <$> peekByteOff ptr 0 <*> peekByteOff ptr 4)+  poke ptr (PaddingTestScalar PaddingTest{..}) = do+    pokeByteOff ptr 0 f+    pokeByteOff ptr 4 v++unit_paddingtest_scalar_packed_size :: Assertion+unit_paddingtest_scalar_packed_size =+  packedAlignedSizeOf @Scalar @PaddingTest Proxy Proxy @?= 20++hprop_paddingtest_scalar_round_trip :: Property+hprop_paddingtest_scalar_round_trip = property do+  val <- forAll genPaddingTest+  let sut = Strided @Scalar val+  let oracle = PaddingTestScalar val+  ptrTripping sut oracle++--------------------------------------------------------------------------------+-- Std140Test+--------------------------------------------------------------------------------++data Std140Test = Std140Test+  { v3 :: V3 Float+  , f1 :: Float+  }+  deriving (Generic, Typeable, Show, Eq)++genStd140Test :: Gen Std140Test+genStd140Test =+  Std140Test+    <$> (V3 <$> genFloat <*> genFloat <*> genFloat)+    <*> genFloat++instance AlignedStorable Std140 Std140Test+instance AlignedStorable Std430 Std140Test+instance AlignedStorable Scalar Std140Test++newtype Std140TestStd140 = Std140TestStd140 Std140Test+  deriving (Generic, Typeable, Show, Eq)++instance Storable Std140TestStd140 where+  sizeOf _ = 16+  alignment _ = 16+  peek ptr = Std140TestStd140 <$> (Std140Test <$> peekByteOff ptr 0 <*> peekByteOff ptr 12)+  poke ptr (Std140TestStd140 Std140Test{..}) = do+    pokeByteOff ptr 0 v3+    pokeByteOff ptr 12 f1++unit_std140test_std140_packed_size :: Assertion+unit_std140test_std140_packed_size =+  packedAlignedSizeOf @Std140 @Std140Test Proxy Proxy @?= 16++hprop_std140test_std140_round_trip :: Property+hprop_std140test_std140_round_trip = property do+  val <- forAll genStd140Test+  let sut = Strided @Std140 val+      oracle = Std140TestStd140 val+  ptrTripping sut oracle++-- Oracle for Std430 layout. For this type, it is identical to std140.+newtype Std140TestStd430 = Std140TestStd430 Std140Test+  deriving (Generic, Typeable, Show, Eq)++instance Storable Std140TestStd430 where+  sizeOf _ = 16+  alignment _ = 16+  peek ptr = Std140TestStd430 <$> (Std140Test <$> peekByteOff ptr 0 <*> peekByteOff ptr 12)+  poke ptr (Std140TestStd430 Std140Test{..}) = do+    pokeByteOff ptr 0 v3+    pokeByteOff ptr 12 f1++unit_std140test_std430_packed_size :: Assertion+unit_std140test_std430_packed_size =+  packedAlignedSizeOf @Std430 @Std140Test Proxy Proxy @?= 16++hprop_std140test_std430_round_trip :: Property+hprop_std140test_std430_round_trip = property do+  val <- forAll genStd140Test+  let sut = Strided @Std430 val+  let oracle = Std140TestStd430 val+  ptrTripping sut oracle++newtype Std140TestScalar = Std140TestScalar Std140Test+  deriving (Generic, Typeable, Show, Eq)++instance Storable Std140TestScalar where+  sizeOf _ = 16+  alignment _ = 4+  peek ptr = Std140TestScalar <$> (Std140Test <$> peekByteOff ptr 0 <*> peekByteOff ptr 12)+  poke ptr (Std140TestScalar Std140Test{..}) = do+    pokeByteOff ptr 0 v3+    pokeByteOff ptr 12 f1++unit_std140test_scalar_packed_size :: Assertion+unit_std140test_scalar_packed_size =+  packedAlignedSizeOf @Scalar @Std140Test Proxy Proxy @?= 16++hprop_std140test_scalar_round_trip :: Property+hprop_std140test_scalar_round_trip = property do+  val <- forAll genStd140Test+  let sut = Strided @Scalar val+  let oracle = Std140TestScalar val+  ptrTripping sut oracle++--------------------------------------------------------------------------------+-- ComplexPadding+--------------------------------------------------------------------------------++-- |+--   complexpaddingA : float (size=4, align=4); tSize=4+--   complexpaddingB : vec3 (size=12, align=16); tSize=16+12=28; align to 16, start at 16+--   complexpaddingC : mat3 (size=3*16=48, align=16); tSize=32+48=80; align to 16, start at 32+--   complexpaddingD : float (size=4, align=4); tSize=80+4=4; align to 4, start at 80+--   complexpaddingE : mat4 (size=4*4=64, align=16); tSize=96+64=160; align to 16, start at 96+--   complexpaddingF : float (size=4, align=4); tSize=160+4=164; align to 4, start at 160+--+--   overall size: alignTo 16 164+--               = 176+data ComplexPadding = ComplexPadding+  { complexpaddingA :: Float+  , complexpaddingB :: V3 Float+  , complexpaddingC :: M33 Float+  , complexpaddingD :: Float+  , complexpaddingE :: M44 Float+  , complexpaddingF :: Float+  }+  deriving (Generic, Typeable, Show, Eq)++-- >>> alignedSizeOf (Data.Proxy.Proxy @Std430) (Data.Proxy.Proxy @ComplexPadding)+-- 176++genComplexPadding :: Gen ComplexPadding+genComplexPadding =+  ComplexPadding+    <$> genFloat+    <*> genV genFloat+    <*> genMat genFloat+    <*> genFloat+    <*> genMat genFloat+    <*> genFloat++instance AlignedStorable Std140 ComplexPadding+instance AlignedStorable Std430 ComplexPadding+instance AlignedStorable Scalar ComplexPadding++newtype ComplexPaddingStd140 = ComplexPaddingStd140 ComplexPadding+  deriving (Generic, Typeable, Show, Eq)++instance Storable ComplexPaddingStd140 where+  sizeOf _ = 176+  alignment _ = 16+  peek ptr =+    ComplexPaddingStd140+      <$> ( ComplexPadding+              <$> peekByteOff ptr 0+              <*> peekByteOff ptr 16+              <*> peekMat3Oracle Std140 ptr 32+              <*> peekByteOff ptr 80+              <*> peekByteOff ptr 96+              <*> peekByteOff ptr 160+          )+  poke ptr (ComplexPaddingStd140 ComplexPadding{..}) = do+    pokeByteOff ptr 0 complexpaddingA+    pokeByteOff ptr 16 complexpaddingB+    pokeMat3Oracle Std140 ptr 32 complexpaddingC+    pokeByteOff ptr 80 complexpaddingD+    pokeByteOff ptr 96 complexpaddingE+    pokeByteOff ptr 160 complexpaddingF++unit_complexpadding_std140_packed_size :: Assertion+unit_complexpadding_std140_packed_size =+  packedAlignedSizeOf @Std140 @ComplexPadding Proxy Proxy @?= 164++hprop_complexpadding_std140_round_trip :: Property+hprop_complexpadding_std140_round_trip = property do+  complexpadding <- forAll genComplexPadding+  let sut = Strided @Std140 complexpadding+      oracle = ComplexPaddingStd140 complexpadding+  ptrTripping sut oracle++newtype ComplexPaddingStd430 = ComplexPaddingStd430 ComplexPadding+  deriving (Generic, Typeable, Show, Eq)++instance Storable ComplexPaddingStd430 where+  sizeOf _ = 176+  alignment _ = 16+  peek ptr =+    ComplexPaddingStd430+      <$> ( ComplexPadding+              <$> peekByteOff ptr 0+              <*> peekByteOff ptr 16+              <*> peekMat3Oracle Std430 ptr 32+              <*> peekByteOff ptr 80+              <*> peekByteOff ptr 96+              <*> peekByteOff ptr 160+          )+  poke ptr (ComplexPaddingStd430 ComplexPadding{..}) = do+    pokeByteOff ptr 0 complexpaddingA+    pokeByteOff ptr 16 complexpaddingB+    pokeMat3Oracle Std430 ptr 32 complexpaddingC+    pokeByteOff ptr 80 complexpaddingD+    pokeByteOff ptr 96 complexpaddingE+    pokeByteOff ptr 160 complexpaddingF++unit_complexpadding_std430_packed_size :: Assertion+unit_complexpadding_std430_packed_size =+  packedAlignedSizeOf @Std430 @ComplexPadding Proxy Proxy @?= 164++hprop_complexpadding_std430_round_trip :: Property+hprop_complexpadding_std430_round_trip = property do+  val <- forAll genComplexPadding+  let sut = Strided @Std430 val+  let oracle = ComplexPaddingStd430 val+  ptrTripping sut oracle++newtype ComplexPaddingScalar = ComplexPaddingScalar ComplexPadding+  deriving (Generic, Typeable, Show, Eq)++instance Storable ComplexPaddingScalar where+  sizeOf _ = 124+  alignment _ = 4+  peek ptr =+    ComplexPaddingScalar+      <$> ( ComplexPadding+              <$> peekByteOff ptr 0+              <*> peekByteOff ptr 4+              <*> peekByteOff ptr 16+              <*> peekByteOff ptr 52+              <*> peekByteOff ptr 56+              <*> peekByteOff ptr 120+          )+  poke ptr (ComplexPaddingScalar ComplexPadding{..}) = do+    pokeByteOff ptr 0 complexpaddingA+    pokeByteOff ptr 4 complexpaddingB+    pokeByteOff ptr 16 complexpaddingC+    pokeByteOff ptr 52 complexpaddingD+    pokeByteOff ptr 56 complexpaddingE+    pokeByteOff ptr 120 complexpaddingF++unit_complexpadding_scalar_packed_size :: Assertion+unit_complexpadding_scalar_packed_size =+  packedAlignedSizeOf @Scalar @ComplexPadding Proxy Proxy @?= 124++hprop_complexpadding_scalar_round_trip :: Property+hprop_complexpadding_scalar_round_trip = property do+  val <- forAll genComplexPadding+  let sut = Strided @Scalar val+  let oracle = ComplexPaddingScalar val+  ptrTripping sut oracle++--------------------------------------------------------------------------------+-- Vertex+--------------------------------------------------------------------------------++data Vertex = Vertex+  { position :: V3 Float+  , normal :: V3 Float+  , uv :: V2 Float+  }+  deriving (Generic, Typeable, Show, Eq)++genVertex :: Gen Vertex+genVertex = Vertex <$> genV genFloat <*> genV genFloat <*> genV genFloat++instance AlignedStorable Std140 Vertex+instance AlignedStorable Std430 Vertex+instance AlignedStorable Scalar Vertex++newtype VertexStd140 = VertexStd140 Vertex+  deriving (Generic, Typeable, Show, Eq)++instance Storable VertexStd140 where+  sizeOf _ = 48+  alignment _ = 16+  peek ptr = VertexStd140 <$> (Vertex <$> peekByteOff ptr 0 <*> peekByteOff ptr 16 <*> peekByteOff ptr 32)+  poke ptr (VertexStd140 Vertex{..}) = do+    pokeByteOff ptr 0 position+    pokeByteOff ptr 16 normal+    pokeByteOff ptr 32 uv++unit_vertex_std140_packed_size :: Assertion+unit_vertex_std140_packed_size =+  packedAlignedSizeOf @Std140 @Vertex Proxy Proxy @?= 40++hprop_vertex_std140_round_trip :: Property+hprop_vertex_std140_round_trip = property do+  val <- forAll genVertex+  let sut = Strided @Std140 val+      oracle = VertexStd140 val+  ptrTripping sut oracle++newtype VertexStd430 = VertexStd430 Vertex+  deriving (Generic, Typeable, Show, Eq)++instance Storable VertexStd430 where+  sizeOf _ = 48+  alignment _ = 16+  peek ptr = VertexStd430 <$> (Vertex <$> peekByteOff ptr 0 <*> peekByteOff ptr 16 <*> peekByteOff ptr 32)+  poke ptr (VertexStd430 Vertex{..}) = do+    pokeByteOff ptr 0 position+    pokeByteOff ptr 16 normal+    pokeByteOff ptr 32 uv++unit_vertex_std430_packed_size :: Assertion+unit_vertex_std430_packed_size =+  packedAlignedSizeOf @Std430 @Vertex Proxy Proxy @?= 40++hprop_vertex_std430_round_trip :: Property+hprop_vertex_std430_round_trip = property do+  val <- forAll genVertex+  let sut = Strided @Std430 val+      oracle = VertexStd430 val+  ptrTripping sut oracle++newtype VertexScalar = VertexScalar Vertex+  deriving (Generic, Typeable, Show, Eq)++instance Storable VertexScalar where+  sizeOf _ = 32+  alignment _ = 4+  peek ptr = VertexScalar <$> (Vertex <$> peekByteOff ptr 0 <*> peekByteOff ptr 12 <*> peekByteOff ptr 24)+  poke ptr (VertexScalar Vertex{..}) = do+    pokeByteOff ptr 0 position+    pokeByteOff ptr 12 normal+    pokeByteOff ptr 24 uv++unit_vertex_scalar_packed_size :: Assertion+unit_vertex_scalar_packed_size =+  packedAlignedSizeOf @Scalar @Vertex Proxy Proxy @?= 32++hprop_vertex_scalar_round_trip :: Property+hprop_vertex_scalar_round_trip = property do+  val <- forAll genVertex+  let sut = Strided @Scalar val+      oracle = VertexScalar val+  ptrTripping sut oracle++--------------------------------------------------------------------------------+-- LargePrimitives+--------------------------------------------------------------------------------++data LargePrimitives = LargePrimitives+  { d :: Double+  , l :: Int64+  }+  deriving (Generic, Typeable, Show, Eq)++genLargePrimitives :: Gen LargePrimitives+genLargePrimitives = LargePrimitives <$> genFloat <*> genInt++instance AlignedStorable Std140 LargePrimitives+instance AlignedStorable Std430 LargePrimitives+instance AlignedStorable Scalar LargePrimitives++newtype LargePrimitivesStd140 = LargePrimitivesStd140 LargePrimitives+  deriving (Generic, Typeable, Show, Eq)++instance Storable LargePrimitivesStd140 where+  sizeOf _ = 16+  alignment _ = 16+  peek ptr = LargePrimitivesStd140 <$> (LargePrimitives <$> peekByteOff ptr 0 <*> peekByteOff ptr 8)+  poke ptr (LargePrimitivesStd140 LargePrimitives{..}) = do+    pokeByteOff ptr 0 d+    pokeByteOff ptr 8 l++unit_largeprimitives_std140_packed_size :: Assertion+unit_largeprimitives_std140_packed_size =+  packedAlignedSizeOf @Std140 @LargePrimitives Proxy Proxy @?= 16++hprop_largeprimitives_std140_round_trip :: Property+hprop_largeprimitives_std140_round_trip = property do+  val <- forAll genLargePrimitives+  let sut = Strided @Std140 val+  let oracle = LargePrimitivesStd140 val+  ptrTripping sut oracle++newtype LargePrimitivesStd430 = LargePrimitivesStd430 LargePrimitives+  deriving (Generic, Typeable, Show, Eq)++instance Storable LargePrimitivesStd430 where+  sizeOf _ = 16+  alignment _ = 8+  peek ptr = LargePrimitivesStd430 <$> (LargePrimitives <$> peekByteOff ptr 0 <*> peekByteOff ptr 8)+  poke ptr (LargePrimitivesStd430 LargePrimitives{..}) = do+    pokeByteOff ptr 0 d+    pokeByteOff ptr 8 l++unit_largeprimitives_std430_packed_size :: Assertion+unit_largeprimitives_std430_packed_size =+  packedAlignedSizeOf @Std430 @LargePrimitives Proxy Proxy @?= 16++hprop_largeprimitives_std430_round_trip :: Property+hprop_largeprimitives_std430_round_trip = property do+  val <- forAll genLargePrimitives+  let sut = Strided @Std430 val+  let oracle = LargePrimitivesStd430 val+  ptrTripping sut oracle++newtype LargePrimitivesScalar = LargePrimitivesScalar LargePrimitives+  deriving (Generic, Typeable, Show, Eq)++instance Storable LargePrimitivesScalar where+  sizeOf _ = 16+  alignment _ = 8+  peek ptr = LargePrimitivesScalar <$> (LargePrimitives <$> peekByteOff ptr 0 <*> peekByteOff ptr 8)+  poke ptr (LargePrimitivesScalar LargePrimitives{..}) = do+    pokeByteOff ptr 0 d+    pokeByteOff ptr 8 l++hprop_largeprimitives_scalar_round_trip :: Property+hprop_largeprimitives_scalar_round_trip = property do+  val <- forAll genLargePrimitives+  let sut = Strided @Scalar val+  let oracle = LargePrimitivesScalar val+  ptrTripping sut oracle++--------------------------------------------------------------------------------+-- Uniforms+--------------------------------------------------------------------------------++data Uniforms = Uniforms+  { modelView :: V4 (V4 Float)+  , cameraPos :: V4 Float+  }+  deriving (Generic, Typeable, Show, Eq)++genUniforms :: Gen Uniforms+genUniforms = Uniforms <$> genMat genFloat <*> genV genFloat++instance AlignedStorable Std140 Uniforms+instance AlignedStorable Std430 Uniforms+instance AlignedStorable Scalar Uniforms++newtype UniformsStd140 = UniformsStd140 Uniforms+  deriving (Generic, Typeable, Show, Eq)++instance Storable UniformsStd140 where+  sizeOf _ = 80+  alignment _ = 16+  peek ptr = UniformsStd140 <$> (Uniforms <$> peekByteOff ptr 0 <*> peekByteOff ptr 64)+  poke ptr (UniformsStd140 Uniforms{..}) = do+    pokeByteOff ptr 0 modelView+    pokeByteOff ptr 64 cameraPos++hprop_uniforms_std140_round_trip :: Property+hprop_uniforms_std140_round_trip = property do+  val <- forAll genUniforms+  let sut = Strided @Std140 val+  let oracle = UniformsStd140 val+  ptrTripping sut oracle++newtype UniformsStd430 = UniformsStd430 Uniforms+  deriving (Generic, Typeable, Show, Eq)++instance Storable UniformsStd430 where+  sizeOf _ = 80+  alignment _ = 16+  peek ptr = UniformsStd430 <$> (Uniforms <$> peekByteOff ptr 0 <*> peekByteOff ptr 64)+  poke ptr (UniformsStd430 Uniforms{..}) = do+    pokeByteOff ptr 0 modelView+    pokeByteOff ptr 64 cameraPos++hprop_uniforms_std430_round_trip :: Property+hprop_uniforms_std430_round_trip = property do+  val <- forAll genUniforms+  let sut = Strided @Std430 val+  let oracle = UniformsStd430 val+  ptrTripping sut oracle++newtype UniformsScalar = UniformsScalar Uniforms+  deriving (Generic, Typeable, Show, Eq)++instance Storable UniformsScalar where+  sizeOf _ = 80+  alignment _ = 4+  peek ptr = UniformsScalar <$> (Uniforms <$> peekByteOff ptr 0 <*> peekByteOff ptr 64)+  poke ptr (UniformsScalar Uniforms{..}) = do+    pokeByteOff ptr 0 modelView+    pokeByteOff ptr 64 cameraPos++hprop_uniforms_scalar_round_trip :: Property+hprop_uniforms_scalar_round_trip = property do+  val <- forAll genUniforms+  let sut = Strided @Scalar val+  let oracle = UniformsScalar val+  ptrTripping sut oracle++--------------------------------------------------------------------------------+-- MixedAlign (explicitly tests the difference between std140 and std430)+--------------------------------------------------------------------------------++data MixedAlign = MixedAlign+  { a :: Int16+  , b :: Double+  , c :: Int32+  }+  deriving (Generic, Typeable, Show, Eq)++genMixedAlign :: Gen MixedAlign+genMixedAlign = MixedAlign <$> genInt <*> genFloat <*> genInt++instance AlignedStorable Std140 MixedAlign+instance AlignedStorable Std430 MixedAlign+instance AlignedStorable Scalar MixedAlign++newtype MixedAlignStd140 = MixedAlignStd140 MixedAlign+  deriving (Generic, Typeable, Show, Eq)++instance Storable MixedAlignStd140 where+  sizeOf _ = 32+  alignment _ = 16+  peek ptr =+    MixedAlignStd140 <$> (MixedAlign <$> peekByteOff ptr 0 <*> peekByteOff ptr 8 <*> peekByteOff ptr 16)+  poke ptr (MixedAlignStd140 MixedAlign{..}) = do+    pokeByteOff ptr 0 a+    pokeByteOff ptr 8 b+    pokeByteOff ptr 16 c++hprop_mixedalign_std140_round_trip :: Property+hprop_mixedalign_std140_round_trip = property do+  val <- forAll genMixedAlign+  let sut = Strided @Std140 val+  let oracle = MixedAlignStd140 val+  ptrTripping sut oracle++newtype MixedAlignStd430 = MixedAlignStd430 MixedAlign+  deriving (Generic, Typeable, Show, Eq)++instance Storable MixedAlignStd430 where+  sizeOf _ = 24+  alignment _ = 8+  peek ptr =+    MixedAlignStd430 <$> (MixedAlign <$> peekByteOff ptr 0 <*> peekByteOff ptr 8 <*> peekByteOff ptr 16)+  poke ptr (MixedAlignStd430 MixedAlign{..}) = do+    pokeByteOff ptr 0 a+    pokeByteOff ptr 8 b+    pokeByteOff ptr 16 c++hprop_mixedalign_std430_round_trip :: Property+hprop_mixedalign_std430_round_trip = property do+  val <- forAll genMixedAlign+  let sut = Strided @Std430 val+  let oracle = MixedAlignStd430 val+  ptrTripping sut oracle++newtype MixedAlignScalar = MixedAlignScalar MixedAlign+  deriving (Generic, Typeable, Show, Eq)++instance Storable MixedAlignScalar where+  sizeOf _ = 24+  alignment _ = 8+  peek ptr =+    MixedAlignScalar <$> (MixedAlign <$> peekByteOff ptr 0 <*> peekByteOff ptr 8 <*> peekByteOff ptr 16)+  poke ptr (MixedAlignScalar MixedAlign{..}) = do+    pokeByteOff ptr 0 a+    pokeByteOff ptr 8 b+    pokeByteOff ptr 16 c++hprop_mixedalign_scalar_round_trip :: Property+hprop_mixedalign_scalar_round_trip = property do+  val <- forAll genMixedAlign+  let sut = Strided @Scalar val+  let oracle = MixedAlignScalar val+  ptrTripping sut oracle++--------------------------------------------------------------------------------+-- FinalPaddingTest+--------------------------------------------------------------------------------++data FinalPaddingTest = FinalPaddingTest+  { fptA :: V4 Float+  , fptB :: Int32+  }+  deriving (Generic, Typeable, Show, Eq)++genFinalPaddingTest :: Gen FinalPaddingTest+genFinalPaddingTest = FinalPaddingTest <$> genV genFloat <*> genInt++instance AlignedStorable Std140 FinalPaddingTest+instance AlignedStorable Std430 FinalPaddingTest+instance AlignedStorable Scalar FinalPaddingTest++newtype FinalPaddingTestStd140 = FinalPaddingTestStd140 FinalPaddingTest+  deriving (Generic, Typeable, Show, Eq)++instance Storable FinalPaddingTestStd140 where+  sizeOf _ = 32+  alignment _ = 16+  peek ptr = FinalPaddingTestStd140 <$> (FinalPaddingTest <$> peekByteOff ptr 0 <*> peekByteOff ptr 16)+  poke ptr (FinalPaddingTestStd140 FinalPaddingTest{..}) = do+    pokeByteOff ptr 0 fptA+    pokeByteOff ptr 16 fptB++hprop_finalpaddingtest_std140_round_trip :: Property+hprop_finalpaddingtest_std140_round_trip = property do+  val <- forAll genFinalPaddingTest+  let sut = Strided @Std140 val+  let oracle = FinalPaddingTestStd140 val+  ptrTripping sut oracle++newtype FinalPaddingTestStd430 = FinalPaddingTestStd430 FinalPaddingTest+  deriving (Generic, Typeable, Show, Eq)++instance Storable FinalPaddingTestStd430 where+  sizeOf _ = 32+  alignment _ = 16+  peek ptr = FinalPaddingTestStd430 <$> (FinalPaddingTest <$> peekByteOff ptr 0 <*> peekByteOff ptr 16)+  poke ptr (FinalPaddingTestStd430 FinalPaddingTest{..}) = do+    pokeByteOff ptr 0 fptA+    pokeByteOff ptr 16 fptB++hprop_finalpaddingtest_std430_round_trip :: Property+hprop_finalpaddingtest_std430_round_trip = property do+  val <- forAll genFinalPaddingTest+  let sut = Strided @Std430 val+  let oracle = FinalPaddingTestStd430 val+  ptrTripping sut oracle++newtype FinalPaddingTestScalar = FinalPaddingTestScalar FinalPaddingTest+  deriving (Generic, Typeable, Show, Eq)++instance Storable FinalPaddingTestScalar where+  sizeOf _ = 20+  alignment _ = 4+  peek ptr = FinalPaddingTestScalar <$> (FinalPaddingTest <$> peekByteOff ptr 0 <*> peekByteOff ptr 16)+  poke ptr (FinalPaddingTestScalar FinalPaddingTest{..}) = do+    pokeByteOff ptr 0 fptA+    pokeByteOff ptr 16 fptB++hprop_finalpaddingtest_scalar_round_trip :: Property+hprop_finalpaddingtest_scalar_round_trip = property do+  val <- forAll genFinalPaddingTest+  let sut = Strided @Scalar val+  let oracle = FinalPaddingTestScalar val+  ptrTripping sut oracle++--------------------------------------------------------------------------------+-- BoolTest+--------------------------------------------------------------------------------++data BoolTest = BoolTest+  { isEnabled :: Bool+  , value :: Float+  }+  deriving (Generic, Typeable, Show, Eq)++genBoolTest :: Gen BoolTest+genBoolTest = BoolTest <$> Gen.bool <*> genFloat++instance AlignedStorable Std140 BoolTest+instance AlignedStorable Std430 BoolTest+instance AlignedStorable Scalar BoolTest++newtype BoolTestStd140 = BoolTestStd140 BoolTest+  deriving (Generic, Typeable, Show, Eq)++instance Storable BoolTestStd140 where+  sizeOf _ = 16+  alignment _ = 16+  peek ptr = BoolTestStd140 <$> (BoolTest <$> peekByteOff ptr 0 <*> peekByteOff ptr 4)+  poke ptr (BoolTestStd140 BoolTest{..}) = do+    pokeByteOff ptr 0 isEnabled+    pokeByteOff ptr 4 value++hprop_booltest_std140_round_trip :: Property+hprop_booltest_std140_round_trip = property do+  val <- forAll genBoolTest+  let sut = Strided @Std140 val+      oracle = BoolTestStd140 val+  ptrTripping sut oracle++newtype BoolTestStd430 = BoolTestStd430 BoolTest+  deriving (Generic, Typeable, Show, Eq)++instance Storable BoolTestStd430 where+  sizeOf _ = 8+  alignment _ = 4+  peek ptr = BoolTestStd430 <$> (BoolTest <$> peekByteOff ptr 0 <*> peekByteOff ptr 4)+  poke ptr (BoolTestStd430 BoolTest{..}) = do+    pokeByteOff ptr 0 isEnabled+    pokeByteOff ptr 4 value++hprop_booltest_std430_round_trip :: Property+hprop_booltest_std430_round_trip = property do+  val <- forAll genBoolTest+  let sut = Strided @Std430 val+      oracle = BoolTestStd430 val+  ptrTripping sut oracle++newtype BoolTestScalar = BoolTestScalar BoolTest+  deriving (Generic, Typeable, Show, Eq)++instance Storable BoolTestScalar where+  sizeOf _ = 8+  alignment _ = 4+  peek ptr = BoolTestScalar <$> (BoolTest <$> peekByteOff ptr 0 <*> peekByteOff ptr 4)+  poke ptr (BoolTestScalar BoolTest{..}) = do+    pokeByteOff ptr 0 isEnabled+    pokeByteOff ptr 4 value++hprop_booltest_scalar_round_trip :: Property+hprop_booltest_scalar_round_trip = property do+  val <- forAll genBoolTest+  let sut = Strided @Scalar val+      oracle = BoolTestScalar val+  ptrTripping sut oracle++data Nested = Nested+  { nestedV3 :: V3 Float+  , nestedSimple :: Simple+  , nestedMixed :: MixedAlign+  , nestedBoolTest :: BoolTest+  }+  deriving (Generic, Typeable, Show, Eq)++genNested :: Gen Nested+genNested =+  Nested+    <$> genV genFloat+    <*> genSimple+    <*> genMixedAlign+    <*> genBoolTest++instance AlignedStorable Std140 Nested+instance AlignedStorable Std430 Nested+instance AlignedStorable Scalar Nested++newtype NestedStd140 = NestedStd140 Nested+  deriving (Generic, Typeable, Show, Eq)++instance Storable NestedStd140 where+  sizeOf _ = 80+  alignment _ = 16+  peek ptr =+    NestedStd140+      <$> ( Nested+              <$> peekByteOff ptr 0+              <*> (coerce <$> peekByteOff @(Strided Std140 Simple) ptr 16)+              <*> (coerce <$> peekByteOff @(Strided Std140 MixedAlign) ptr 32)+              <*> (coerce <$> peekByteOff @(Strided Std140 BoolTest) ptr 64)+          )+  poke ptr (NestedStd140 Nested{..}) = do+    pokeByteOff ptr 0 nestedV3+    pokeByteOff ptr 16 (Strided @Std140 nestedSimple)+    pokeByteOff ptr 32 (Strided @Std140 nestedMixed)+    pokeByteOff ptr 64 (Strided @Std140 nestedBoolTest)++hprop_nested_std140_round_trip :: Property+hprop_nested_std140_round_trip = property do+  val <- forAll genNested+  let sut = Strided @Std140 val+      oracle = NestedStd140 val+  ptrTripping sut oracle++newtype NestedStd430 = NestedStd430 Nested+  deriving (Generic, Typeable, Show, Eq)++instance Storable NestedStd430 where+  sizeOf _ = 64+  alignment _ = 16+  peek ptr =+    NestedStd430+      <$> ( Nested+              <$> peekByteOff ptr 0+              <*> (coerce <$> peekByteOff @(Strided Std430 Simple) ptr 12)+              <*> (coerce <$> peekByteOff @(Strided Std430 MixedAlign) ptr 24)+              <*> (coerce <$> peekByteOff @(Strided Std430 BoolTest) ptr 48)+          )+  poke ptr (NestedStd430 Nested{..}) = do+    pokeByteOff ptr 0 nestedV3+    pokeByteOff ptr 12 (Strided @Std430 nestedSimple)+    pokeByteOff ptr 24 (Strided @Std430 nestedMixed)+    pokeByteOff ptr 48 (Strided @Std430 nestedBoolTest)++hprop_nested_std430_round_trip :: Property+hprop_nested_std430_round_trip = property do+  val <- forAll genNested+  let sut = Strided @Std430 val+      oracle = NestedStd430 val+  ptrTripping sut oracle++newtype NestedScalar = NestedScalar Nested+  deriving (Generic, Typeable, Show, Eq)++instance Storable NestedScalar where+  sizeOf _ = 56+  alignment _ = 8+  peek ptr =+    NestedScalar+      <$> ( Nested+              <$> peekByteOff ptr 0+              <*> (coerce <$> peekByteOff @(Strided Scalar Simple) ptr 12)+              <*> (coerce <$> peekByteOff @(Strided Scalar MixedAlign) ptr 24)+              <*> (coerce <$> peekByteOff @(Strided Scalar BoolTest) ptr 44)+          )+  poke ptr (NestedScalar Nested{..}) = do+    pokeByteOff ptr 0 nestedV3+    pokeByteOff ptr 12 (Strided @Scalar nestedSimple)+    pokeByteOff ptr 24 (Strided @Scalar nestedMixed)+    pokeByteOff ptr 44 (Strided @Scalar nestedBoolTest)++hprop_nested_scalar_round_trip :: Property+hprop_nested_scalar_round_trip = property do+  val <- forAll genNested+  let sut = Strided @Scalar val+      oracle = NestedScalar val+  ptrTripping sut oracle++newtype NestedNewtype = NestedNewtype Nested+  deriving (Generic, Typeable, Show, Eq)++genNestedNewtype :: Gen NestedNewtype+genNestedNewtype = NestedNewtype <$> genNested++instance AlignedStorable Std140 NestedNewtype+instance AlignedStorable Std430 NestedNewtype+instance AlignedStorable Scalar NestedNewtype++newtype NestedNewtypeStd140 = NestedNewtypeStd140 NestedNewtype+  deriving (Generic, Typeable, Show, Eq)++instance Storable NestedNewtypeStd140 where+  sizeOf _ = sizeOf @(Strided Std140 Nested) undefined+  alignment _ = alignment @(Strided Std140 Nested) undefined+  peek ptr = NestedNewtypeStd140 . coerce <$> peek @(Strided Std140 Nested) (castPtr ptr)+  poke ptr (NestedNewtypeStd140 nested) = poke @(Strided Std140 Nested) (castPtr ptr) (coerce nested)++hprop_nested_newtype_std140_round_trip :: Property+hprop_nested_newtype_std140_round_trip = property do+  val <- forAll genNestedNewtype+  let sut = Strided @Std140 val+      oracle = NestedNewtypeStd140 val+  ptrTripping sut oracle++newtype NestedNewtypeStd430 = NestedNewtypeStd430 NestedNewtype+  deriving (Generic, Typeable, Show, Eq)++instance Storable NestedNewtypeStd430 where+  sizeOf _ = sizeOf @(Strided Std430 Nested) undefined+  alignment _ = alignment @(Strided Std430 Nested) undefined+  peek ptr = NestedNewtypeStd430 . coerce <$> peek @(Strided Std430 Nested) (castPtr ptr)+  poke ptr (NestedNewtypeStd430 nested) = poke @(Strided Std430 Nested) (castPtr ptr) (coerce nested)++hprop_nested_newtype_std430_round_trip :: Property+hprop_nested_newtype_std430_round_trip = property do+  val <- forAll genNestedNewtype+  let sut = Strided @Std430 val+      oracle = NestedNewtypeStd430 val+  ptrTripping sut oracle++newtype NestedNewtypeScalar = NestedNewtypeScalar NestedNewtype+  deriving (Generic, Typeable, Show, Eq)++instance Storable NestedNewtypeScalar where+  sizeOf _ = sizeOf @(Strided Scalar Nested) undefined+  alignment _ = alignment @(Strided Scalar Nested) undefined+  peek ptr =+    NestedNewtypeScalar . coerce <$> peek @(Strided Scalar Nested) (castPtr ptr)+  poke ptr (NestedNewtypeScalar nested) = poke @(Strided Scalar Nested) (castPtr ptr) (coerce nested)++hprop_nested_newtype_scalar_round_trip :: Property+hprop_nested_newtype_scalar_round_trip = property do+  val <- forAll genNestedNewtype+  let sut = Strided @Scalar val+      oracle = NestedNewtypeScalar val+  ptrTripping sut oracle++--------------------------------------------------------------------------------+-- DoubleTrouble+--------------------------------------------------------------------------------++data DoubleTrouble = DoubleTrouble+  { dtD0 :: Double+  , dtM0 :: M33 Double+  , dtF0 :: Float+  , dtV0 :: V3 Double+  , dtF1 :: Float+  , dtV1 :: V4 Double+  , dtF2 :: Float+  , dtM1 :: M44 Double+  }+  deriving (Generic, Typeable, Show, Eq)++genDoubleTrouble :: Gen DoubleTrouble+genDoubleTrouble =+  DoubleTrouble+    <$> genFloat+    <*> genMat genFloat+    <*> genFloat+    <*> genV genFloat+    <*> genFloat+    <*> genV genFloat+    <*> genFloat+    <*> genMat genFloat++instance AlignedStorable Std140 DoubleTrouble+instance AlignedStorable Std430 DoubleTrouble+instance AlignedStorable Scalar DoubleTrouble++newtype DoubleTroubleStd140 = DoubleTroubleStd140 DoubleTrouble+  deriving (Generic, Typeable, Show, Eq)++instance Storable DoubleTroubleStd140 where+  sizeOf _ = 384+  alignment _ = 32+  peek ptr =+    DoubleTroubleStd140+      <$> ( DoubleTrouble+              <$> peekByteOff ptr 0+              <*> peekMat3Oracle Std140 ptr 32+              <*> peekByteOff ptr 128+              <*> peekByteOff ptr 160+              <*> peekByteOff ptr 184+              <*> peekByteOff ptr 192+              <*> peekByteOff ptr 224+              <*> peekByteOff ptr 256+          )+  poke ptr (DoubleTroubleStd140 DoubleTrouble{..}) = do+    pokeByteOff ptr 0 dtD0+    pokeMat3Oracle Std140 ptr 32 dtM0+    pokeByteOff ptr 128 dtF0+    pokeByteOff ptr 160 dtV0+    pokeByteOff ptr 184 dtF1+    pokeByteOff ptr 192 dtV1+    pokeByteOff ptr 224 dtF2+    pokeByteOff ptr 256 dtM1++hprop_doubletrouble_std140_round_trip :: Property+hprop_doubletrouble_std140_round_trip = property do+  val <- forAll genDoubleTrouble+  let sut = Strided @Std140 val+      oracle = DoubleTroubleStd140 val+  ptrTripping sut oracle++--------------------------------------------------------------------------------+-- VectorStruct+--------------------------------------------------------------------------------++data VectorStruct = VectorStruct+  { vsA :: Float+  , vsB :: SSV.Vector 2 (V3 Float)+  , vsC :: Int32+  }+  deriving (Generic, Typeable, Show, Eq)++genVectorStruct :: Gen VectorStruct+genVectorStruct =+  VectorStruct+    <$> genFloat+    <*> SSV.replicateM (genV genFloat)+    <*> genInt++instance AlignedStorable Std140 VectorStruct+instance AlignedStorable Std430 VectorStruct+instance AlignedStorable Scalar VectorStruct++newtype VectorStructStd140 = VectorStructStd140 VectorStruct+  deriving (Generic, Typeable, Show, Eq)++instance Storable VectorStructStd140 where+  sizeOf _ = 64+  alignment _ = 16+  peek ptr =+    VectorStructStd140+      <$> ( VectorStruct+              <$> peekByteOff ptr 0+              <*> (coerce <$> peekByteOff @(Packed Std140 (SSV.Vector 2 (V3 Float))) ptr 16)+              <*> peekByteOff ptr 48+          )+  poke ptr (VectorStructStd140 VectorStruct{..}) = do+    pokeByteOff ptr 0 vsA+    pokeByteOff ptr 16 (Packed @Std140 vsB)+    pokeByteOff ptr 48 vsC++hprop_vectorstruct_std140_round_trip :: Property+hprop_vectorstruct_std140_round_trip = property do+  val <- forAll genVectorStruct+  let sut = Strided @Std140 val+      oracle = VectorStructStd140 val+  ptrTripping sut oracle++newtype VectorStructStd430 = VectorStructStd430 VectorStruct+  deriving (Generic, Typeable, Show, Eq)++instance Storable VectorStructStd430 where+  sizeOf _ = 64+  alignment _ = 16+  peek ptr =+    VectorStructStd430+      <$> ( VectorStruct+              <$> peekByteOff ptr 0+              <*> (coerce <$> peekByteOff @(Packed Std430 (SSV.Vector 2 (V3 Float))) ptr 16)+              <*> peekByteOff ptr 48+          )+  poke ptr (VectorStructStd430 VectorStruct{..}) = do+    pokeByteOff ptr 0 vsA+    pokeByteOff ptr 16 (Packed @Std430 vsB)+    pokeByteOff ptr 48 vsC++hprop_vectorstruct_std430_round_trip :: Property+hprop_vectorstruct_std430_round_trip = property do+  val <- forAll genVectorStruct+  let sut = Strided @Std430 val+      oracle = VectorStructStd430 val+  ptrTripping sut oracle++newtype VectorStructScalar = VectorStructScalar VectorStruct+  deriving (Generic, Typeable, Show, Eq)++instance Storable VectorStructScalar where+  sizeOf _ = 32+  alignment _ = 4+  peek ptr =+    VectorStructScalar+      <$> ( VectorStruct+              <$> peekByteOff ptr 0+              <*> (coerce <$> peekByteOff @(Packed Scalar (SSV.Vector 2 (V3 Float))) ptr 4)+              <*> peekByteOff ptr 28+          )+  poke ptr (VectorStructScalar VectorStruct{..}) = do+    pokeByteOff ptr 0 vsA+    pokeByteOff ptr 4 (Packed @Scalar vsB)+    pokeByteOff ptr 28 vsC++hprop_vectorstruct_scalar_round_trip :: Property+hprop_vectorstruct_scalar_round_trip = property do+  val <- forAll genVectorStruct+  let sut = Strided @Scalar val+      oracle = VectorStructScalar val+  ptrTripping sut oracle++--------------------------------------------------------------------------------+-- ComplexVectorStruct+--------------------------------------------------------------------------------++data ComplexVectorStruct = ComplexVectorStruct+  { cvsA :: Float+  , cvsB :: SSV.Vector 3 (V3 Word16)+  , cvsC :: SSV.Vector 2 (V2 Double)+  , cvsD :: Float+  , cvsE :: Double+  }+  deriving (Generic, Typeable, Show, Eq)++genComplexVectorStruct :: Gen ComplexVectorStruct+genComplexVectorStruct =+  ComplexVectorStruct+    <$> genFloat+    <*> SSV.replicateM (genV genInt)+    <*> SSV.replicateM (genV genFloat)+    <*> genFloat+    <*> genFloat++instance AlignedStorable Std140 ComplexVectorStruct+instance AlignedStorable Std430 ComplexVectorStruct+instance AlignedStorable Scalar ComplexVectorStruct++newtype ComplexVectorStructStd140 = ComplexVectorStructStd140 ComplexVectorStruct+  deriving (Generic, Typeable, Show, Eq)++instance Storable ComplexVectorStructStd140 where+  sizeOf _ = 112+  alignment _ = 16+  peek ptr =+    ComplexVectorStructStd140+      <$> ( ComplexVectorStruct+              <$> peekByteOff ptr 0+              <*> (coerce <$> peekByteOff @(Packed Std140 (SSV.Vector 3 (V3 Word16))) ptr 16)+              <*> (coerce <$> peekByteOff @(Packed Std140 (SSV.Vector 2 (V2 Double))) ptr 64)+              <*> peekByteOff ptr 96+              <*> peekByteOff ptr 104+          )+  poke ptr (ComplexVectorStructStd140 ComplexVectorStruct{..}) = do+    pokeByteOff ptr 0 cvsA+    pokeByteOff ptr 16 (Packed @Std140 cvsB)+    pokeByteOff ptr 64 (Packed @Std140 cvsC)+    pokeByteOff ptr 96 cvsD+    pokeByteOff ptr 104 cvsE++hprop_complexvectorstruct_std140_round_trip :: Property+hprop_complexvectorstruct_std140_round_trip = property do+  val <- forAll genComplexVectorStruct+  let sut = Strided @Std140 val+      oracle = ComplexVectorStructStd140 val+  ptrTripping sut oracle++newtype ComplexVectorStructStd430 = ComplexVectorStructStd430 ComplexVectorStruct+  deriving (Generic, Typeable, Show, Eq)++instance Storable ComplexVectorStructStd430 where+  sizeOf _ = 80+  alignment _ = 16+  peek ptr =+    ComplexVectorStructStd430+      <$> ( ComplexVectorStruct+              <$> peekByteOff ptr 0+              <*> (coerce <$> peekByteOff @(Packed Std430 (SSV.Vector 3 (V3 Word16))) ptr 8)+              <*> (coerce <$> peekByteOff @(Packed Std430 (SSV.Vector 2 (V2 Double))) ptr 32)+              <*> peekByteOff ptr 64+              <*> peekByteOff ptr 72+          )+  poke ptr (ComplexVectorStructStd430 ComplexVectorStruct{..}) = do+    pokeByteOff ptr 0 cvsA+    pokeByteOff ptr 8 (Packed @Std430 cvsB)+    pokeByteOff ptr 32 (Packed @Std430 cvsC)+    pokeByteOff ptr 64 cvsD+    pokeByteOff ptr 72 cvsE++hprop_complexvectorstruct_std430_round_trip :: Property+hprop_complexvectorstruct_std430_round_trip = property do+  val <- forAll genComplexVectorStruct+  let sut = Strided @Std430 val+      oracle = ComplexVectorStructStd430 val+  ptrTripping sut oracle++newtype ComplexVectorStructScalar = ComplexVectorStructScalar ComplexVectorStruct+  deriving (Generic, Typeable, Show, Eq)++instance Storable ComplexVectorStructScalar where+  sizeOf _ = 72+  alignment _ = 8+  peek ptr =+    ComplexVectorStructScalar+      <$> ( ComplexVectorStruct+              <$> peekByteOff ptr 0+              <*> (coerce <$> peekByteOff @(Packed Scalar (SSV.Vector 3 (V3 Word16))) ptr 4)+              <*> (coerce <$> peekByteOff @(Packed Scalar (SSV.Vector 2 (V2 Double))) ptr 24)+              <*> peekByteOff ptr 56+              <*> peekByteOff ptr 64+          )+  poke ptr (ComplexVectorStructScalar ComplexVectorStruct{..}) = do+    pokeByteOff ptr 0 cvsA+    pokeByteOff ptr 4 (Packed @Scalar cvsB)+    pokeByteOff ptr 24 (Packed @Scalar cvsC)+    pokeByteOff ptr 56 (Packed @Scalar cvsD)+    pokeByteOff ptr 64 (Packed @Scalar cvsE)++hprop_complexvectorstruct_scalar_round_trip :: Property+hprop_complexvectorstruct_scalar_round_trip = property do+  val <- forAll genComplexVectorStruct+  let sut = Strided @Scalar val+      oracle = ComplexVectorStructScalar val+  ptrTripping sut oracle++--------------------------------------------------------------------------------+-- Insanity+--------------------------------------------------------------------------------++data Insanity = Insanity+  { ina :: Float+  , inb :: SV.Vector 7 ComplexVectorStruct+  , inc :: Word8+  , ind :: Word64+  , ine :: Word16+  , inf :: V3 Bool+  , ing :: SV.Vector 5 Nested+  , inh :: V3 Word16+  , ini :: SV.Vector 5 (SV.Vector 2 (SV.Vector 4 Nested))+  , inj :: Bool+  , ink :: V3 Double+  }+  deriving (Generic, Typeable, Show, Eq)++instance AlignedStorable Std140 Insanity+instance AlignedStorable Std430 Insanity+instance AlignedStorable Scalar Insanity++genInsanity :: Gen Insanity+genInsanity =+  Insanity+    <$> genFloat+    <*> SV.replicateM genComplexVectorStruct+    <*> genInt+    <*> genInt+    <*> genInt+    <*> genV Gen.bool+    <*> SV.replicateM genNested+    <*> genV genInt+    <*> SV.replicateM (SV.replicateM (SV.replicateM genNested))+    <*> Gen.bool+    <*> genV genFloat++newtype InsanityStd140 = InsanityStd140 Insanity+  deriving (Generic, Typeable, Show, Eq)++instance Storable InsanityStd140 where+  sizeOf _ = 4512+  alignment _ = 32++  peek ptr =+    InsanityStd140+      <$> ( Insanity+              <$> peekByteOff ptr 0+              <*> peekSizedVector (Proxy @ComplexVectorStructStd140) ptr 16+              <*> peekByteOff ptr 800+              <*> peekByteOff ptr 808+              <*> peekByteOff ptr 816+              <*> peekByteOff ptr 832+              <*> peekSizedVector (Proxy @NestedStd140) ptr 848+              <*> peekStd140U16Vec3OracleByteOff ptr 1248+              <*> peekSized3DVector (Proxy @NestedStd140) ptr 1264+              <*> peekByteOff ptr 4464+              <*> peekByteOff ptr 4480+          )++  poke ptr (InsanityStd140 Insanity{..}) = do+    pokeByteOff ptr 0 ina+    pokeSizedVector ptr 16 (SV.map ComplexVectorStructStd140 inb)+    pokeByteOff ptr 800 inc+    pokeByteOff ptr 808 ind+    pokeByteOff ptr 816 ine+    pokeByteOff ptr 832 inf+    pokeSizedVector ptr 848 (SV.map NestedStd140 ing)+    pokeStd140U16Vec3OracleByteOff ptr 1248 inh+    pokeSized3DVector (Proxy @NestedStd140) ptr 1264 ini+    pokeByteOff ptr 4464 inj+    pokeByteOff ptr 4480 ink++hprop_insanity_std140_round_trips :: Property+hprop_insanity_std140_round_trips = withShrinks 10 $ property do+  val <- forAll genInsanity+  let sut = Strided @Std140 val+      oracle = InsanityStd140 val+  ptrTripping sut oracle++newtype InsanityStd430 = InsanityStd430 Insanity+  deriving (Generic, Typeable, Show, Eq)++instance Storable InsanityStd430 where+  sizeOf _ = 3584+  alignment _ = 32++  peek ptr =+    InsanityStd430+      <$> ( Insanity+              <$> peekByteOff ptr 0+              <*> peekSizedVector (Proxy @ComplexVectorStructStd430) ptr 16+              <*> peekByteOff ptr 576+              <*> peekByteOff ptr 584+              <*> peekByteOff ptr 592+              <*> peekByteOff ptr 608+              <*> peekSizedVector (Proxy @NestedStd430) ptr 624+              <*> peekStd430U16Vec3OracleByteOff ptr 944+              <*> peekSized3DVector (Proxy @NestedStd430) ptr 960+              <*> peekByteOff ptr 3520+              <*> peekByteOff ptr 3552+          )++  poke ptr (InsanityStd430 Insanity{..}) = do+    pokeByteOff ptr 0 ina+    pokeSizedVector ptr 16 (SV.map ComplexVectorStructStd430 inb)+    pokeByteOff ptr 576 inc+    pokeByteOff ptr 584 ind+    pokeByteOff ptr 592 ine+    pokeByteOff ptr 608 inf+    pokeSizedVector ptr 624 (SV.map NestedStd430 ing)+    pokeStd430U16Vec3OracleByteOff ptr 944 inh+    pokeSized3DVector (Proxy @NestedStd430) ptr 960 ini+    pokeByteOff ptr 3520 inj+    pokeByteOff ptr 3552 ink++hprop_insanity_std430_round_trips :: Property+hprop_insanity_std430_round_trips = withShrinks 10 $ property do+  val <- forAll genInsanity+  let sut = Strided @Std430 val+      oracle = InsanityStd430 val+  ptrTripping sut oracle++newtype InsanityScalar = InsanityScalar Insanity+  deriving (Generic, Typeable, Show, Eq)++instance Storable InsanityScalar where+  sizeOf _ = 3096+  alignment _ = 8++  peek ptr =+    InsanityScalar+      <$> ( Insanity+              <$> peekByteOff ptr 0+              <*> peekSizedVector (Proxy @ComplexVectorStructScalar) ptr 8+              <*> peekByteOff ptr 512+              <*> peekByteOff ptr 520+              <*> peekByteOff ptr 528+              <*> peekByteOff ptr 532+              <*> peekSizedVector (Proxy @NestedScalar) ptr 544+              <*> peekStd430U16Vec3OracleByteOff ptr 820+              <*> peekSized3DVector (Proxy @NestedScalar) ptr 832+              <*> peekByteOff ptr 3068+              <*> peekByteOff ptr 3072+          )++  poke ptr (InsanityScalar Insanity{..}) = do+    pokeByteOff ptr 0 ina+    pokeSizedVector ptr 8 (SV.map ComplexVectorStructScalar inb)+    pokeByteOff ptr 512 inc+    pokeByteOff ptr 520 ind+    pokeByteOff ptr 528 ine+    pokeByteOff ptr 532 inf+    pokeSizedVector ptr 544 (SV.map NestedScalar ing)+    pokeStd430U16Vec3OracleByteOff ptr 820 inh+    pokeSized3DVector (Proxy @NestedScalar) ptr 832 ini+    pokeByteOff ptr 3068 inj+    pokeByteOff ptr 3072 ink++hprop_insanity_scalar_round_trips :: Property+hprop_insanity_scalar_round_trips = withShrinks 10 $ property do+  val <- forAll genInsanity+  let sut = Strided @Scalar val+      oracle = InsanityScalar val+  ptrTripping sut oracle++--------------------------------------------------------------------------------+-- Utils+--------------------------------------------------------------------------------+genFloat :: (RealFloat a) => Gen a+genFloat = Gen.realFloat (Range.linearFrac (-infinity) infinity)++genInt :: (Bounded a, Integral a) => Gen a+genInt = Gen.integral (Range.linear minBound maxBound)++genV :: (Traversable t, Applicative t) => Gen a -> Gen (t a)+genV = sequence . pure++genMat :: (Traversable t, Applicative t, Traversable f, Applicative f) => Gen a -> Gen (t (f a))+genMat = sequence . pure . genV++infinity :: (Fractional a) => a+infinity = 1 / 0++peekSizedVector+  :: forall n a b c v+   . (KnownNat n, Storable a, Coercible a b, GV.Vector v a, GV.Vector v b)+  => Proxy a+  -> Ptr c+  -> Int+  -> IO (SGV.Vector v n b)+peekSizedVector _ p baseOffset = SGV.generateM \i ->+  coerce <$> peekByteOff @a p (baseOffset + fromIntegral i * sizeOf @a undefined)++pokeSizedVector+  :: forall n a b v+   . (KnownNat n, Storable a, GV.Vector v a)+  => Ptr b+  -> Int+  -> SGV.Vector v n a+  -> IO ()+pokeSizedVector p baseOffset = SGV.imapM_ \i a -> pokeByteOff p (baseOffset + sizeOf @a undefined * fromIntegral i) a++peekSized3DVector+  :: forall n m o a b c v+   . ( KnownNat n+     , KnownNat m+     , KnownNat o+     , Storable a+     , Coercible a b+     , GV.Vector v a+     , GV.Vector v b+     , GV.Vector v (SGV.Vector v o b)+     , GV.Vector v (SGV.Vector v m (SGV.Vector v o b))+     )+  => Proxy a+  -> Ptr c+  -> Int+  -> IO (SGV.Vector v n (SGV.Vector v m (SGV.Vector v o b)))+peekSized3DVector _ p baseOffset =+  let strideO = sizeOf @a undefined+      strideM = strideO * fromIntegral (natVal @o Proxy)+      strideN = strideM * fromIntegral (natVal @m Proxy)+   in SGV.generateM \i ->+        SGV.generateM \j ->+          SGV.generateM \k ->+            let offset = baseOffset + fromIntegral i * strideN + fromIntegral j * strideM + fromIntegral k * strideO+             in coerce <$> peekByteOff @a p offset++pokeSized3DVector+  :: forall n m o a b c v+   . ( KnownNat n+     , KnownNat m+     , KnownNat o+     , Storable a+     , Coercible a b+     , GV.Vector v a+     , GV.Vector v b+     , GV.Vector v c+     , GV.Vector v (SGV.Vector v o b)+     , GV.Vector v (SGV.Vector v m (SGV.Vector v o b))+     )+  => Proxy a+  -> Ptr c+  -> Int+  -> SGV.Vector v n (SGV.Vector v m (SGV.Vector v o b))+  -> IO ()+pokeSized3DVector _ p baseOffset =+  let strideO = sizeOf @a undefined+      strideM = strideO * fromIntegral (natVal @o Proxy)+      strideN = strideM * fromIntegral (natVal @m Proxy)+   in SGV.imapM_ \i ->+        SGV.imapM_ \j ->+          SGV.imapM_ \k a ->+            let offset = baseOffset + fromIntegral i * strideN + fromIntegral j * strideM + fromIntegral k * strideO+             in pokeByteOff @a p offset (coerce a)++class MatrixStride v a where+  matStride :: Proxy (v a) -> MemoryLayout -> Int++instance MatrixStride V2 Half where+  matStride _ = \case+    Std140 -> 16+    Std430 -> 4+    Scalar -> 4++instance MatrixStride V2 Float where+  matStride _ = \case+    Std140 -> 16+    Std430 -> 8+    Scalar -> 8++instance MatrixStride V2 Double where+  matStride _ = \case+    Std140 -> 16+    Std430 -> 16+    Scalar -> 8++instance MatrixStride V3 Half where+  matStride _ = \case+    Std140 -> 16+    Std430 -> 8+    Scalar -> 6++instance MatrixStride V3 Float where+  matStride _ = \case+    Std140 -> 16+    Std430 -> 16+    Scalar -> 12++instance MatrixStride V3 Double where+  matStride _ = \case+    Std140 -> 32+    Std430 -> 32+    Scalar -> 24++instance MatrixStride V4 Half where+  matStride _ = \case+    Std140 -> 16+    Std430 -> 8+    Scalar -> 8++instance MatrixStride V4 Float where+  matStride _ _ = 16++instance MatrixStride V4 Double where+  matStride _ _ = 32++peekMat2Oracle+  :: forall a b v. (MatrixStride v a, Storable (v a)) => MemoryLayout -> Ptr b -> Int -> IO (V2 (v a))+peekMat2Oracle layout ptr off =+  let stride = matStride (Proxy @(v a)) layout+   in V2 <$> peekByteOff ptr off <*> peekByteOff ptr (off + stride)++pokeMat2Oracle+  :: forall a b v+   . (MatrixStride v a, Storable (v a))+  => MemoryLayout+  -> Ptr b+  -> Int+  -> V2 (v a)+  -> IO ()+pokeMat2Oracle layout ptr off (V2 r1 r2) = do+  let stride = matStride (Proxy @(v a)) layout+  pokeByteOff ptr off r1+  pokeByteOff ptr (off + stride) r2++peekMat3Oracle+  :: forall a b v. (MatrixStride v a, Storable (v a)) => MemoryLayout -> Ptr b -> Int -> IO (V3 (v a))+peekMat3Oracle layout ptr off =+  let stride = matStride (Proxy @(v a)) layout+   in V3+        <$> peekByteOff ptr off+        <*> peekByteOff ptr (off + stride)+        <*> peekByteOff ptr (off + stride * 2)++pokeMat3Oracle+  :: forall a b v+   . (MatrixStride v a, Storable (v a))+  => MemoryLayout+  -> Ptr b+  -> Int+  -> V3 (v a)+  -> IO ()+pokeMat3Oracle layout ptr off (V3 r1 r2 r3) = do+  let stride = matStride (Proxy @(v a)) layout+  pokeByteOff ptr off r1+  pokeByteOff ptr (off + stride) r2+  pokeByteOff ptr (off + stride * 2) r3++peekMat4Oracle+  :: forall a b v. (MatrixStride v a, Storable (v a)) => MemoryLayout -> Ptr b -> Int -> IO (V4 (v a))+peekMat4Oracle layout ptr off =+  let stride = matStride (Proxy @(v a)) layout+   in V4+        <$> peekByteOff ptr off+        <*> peekByteOff ptr (off + stride)+        <*> peekByteOff ptr (off + stride * 2)+        <*> peekByteOff ptr (off + stride * 3)++pokeMat4Oracle+  :: forall a b v+   . (MatrixStride v a, Storable (v a))+  => MemoryLayout+  -> Ptr b+  -> Int+  -> V4 (v a)+  -> IO ()+pokeMat4Oracle layout ptr off (V4 r1 r2 r3 r4) = do+  let stride = matStride (Proxy @(v a)) layout+  pokeByteOff ptr off r1+  pokeByteOff ptr (off + stride) r2+  pokeByteOff ptr (off + stride * 2) r3+  pokeByteOff ptr (off + stride * 3) r4++peekStd140U16Vec3OracleByteOff :: (Storable a) => Ptr b -> Int -> IO (V3 a)+peekStd140U16Vec3OracleByteOff ptr off =+  V3+    <$> peekByteOff ptr off+    <*> peekByteOff ptr (off + 4)+    <*> peekByteOff ptr (off + 8)++peekStd140U16Mat3OracleByteOff :: Ptr b -> Int -> IO (M33 Word16)+peekStd140U16Mat3OracleByteOff ptr off =+  V3+    <$> peekStd140U16Vec3OracleByteOff ptr off+    <*> peekStd140U16Vec3OracleByteOff ptr (off + 16)+    <*> peekStd140U16Vec3OracleByteOff ptr (off + 32)++peekStd430U16Vec3OracleByteOff :: (Storable a) => Ptr b -> Int -> IO (V3 a)+peekStd430U16Vec3OracleByteOff ptr off =+  V3+    <$> peekByteOff ptr off+    <*> peekByteOff ptr (off + 2)+    <*> peekByteOff ptr (off + 4)++pokeStd140U16Vec3OracleByteOff :: Ptr b -> Int -> V3 Word16 -> IO ()+pokeStd140U16Vec3OracleByteOff ptr off (V3 x y z) = do+  pokeByteOff ptr off x+  pokeByteOff ptr (off + 4) y+  pokeByteOff ptr (off + 8) z++pokeStd140U16Mat3OracleByteOff :: Ptr b -> Int -> M33 Word16 -> IO ()+pokeStd140U16Mat3OracleByteOff ptr off (V3 r1 r2 r3) = do+  pokeStd140U16Vec3OracleByteOff ptr off r1+  pokeStd140U16Vec3OracleByteOff ptr (off + 16) r2+  pokeStd140U16Vec3OracleByteOff ptr (off + 32) r3++pokeStd430U16Vec3OracleByteOff :: Ptr b -> Int -> V3 Word16 -> IO ()+pokeStd430U16Vec3OracleByteOff ptr off (V3 x y z) = do+  pokeByteOff ptr off x+  pokeByteOff ptr (off + 2) y+  pokeByteOff ptr (off + 4) z++-- Duplicating this from the main module so it doesn't need to be exported.+roundUpTo :: (Bits a, Num a) => a -> a -> a+roundUpTo multiple val = (val + multiple - 1) .&. complement (multiple - 1)