From 275847827d7550436eaf8cd10969f1430dae821d Mon Sep 17 00:00:00 2001
From: Tom Smeding <tom@tomsmeding.com>
Date: Thu, 13 Jun 2024 12:54:55 +0200
Subject: s{from,to}Orthotope

---
 src/Data/Array/Nested.hs                 |  1 +
 src/Data/Array/Nested/Internal/Shaped.hs | 11 +++++++++++
 2 files changed, 12 insertions(+)

diff --git a/src/Data/Array/Nested.hs b/src/Data/Array/Nested.hs
index f75a71c..65d619a 100644
--- a/src/Data/Array/Nested.hs
+++ b/src/Data/Array/Nested.hs
@@ -38,6 +38,7 @@ module Data.Array.Nested (
   -- ** Conversions
   stoXArrayPrim, sfromXArrayPrim,
   stoRanked,
+  sfromOrthotope, stoOrthotope,
 
   -- * Mixed arrays
   Mixed,
diff --git a/src/Data/Array/Nested/Internal/Shaped.hs b/src/Data/Array/Nested/Internal/Shaped.hs
index e453e51..5765595 100644
--- a/src/Data/Array/Nested/Internal/Shaped.hs
+++ b/src/Data/Array/Nested/Internal/Shaped.hs
@@ -21,6 +21,10 @@ import Prelude hiding (mappend, mconcat)
 
 import Control.DeepSeq (NFData)
 import Control.Monad.ST
+import Data.Array.Internal.ShapedS qualified as SS
+import Data.Array.Internal.ShapedG qualified as SG
+import Data.Array.Internal.RankedS qualified as RS
+import Data.Array.Internal.RankedG qualified as RG
 import Data.Bifunctor (first)
 import Data.Coerce (coerce)
 import Data.Kind (Type)
@@ -316,6 +320,13 @@ sfromListPrimLinear sh l =
   let M_Primitive _ xarr = toPrimitive (mfromListPrim l)
   in Shaped $ fromPrimitive $ M_Primitive (shCvtSX sh) (X.reshape (SUnknown () :!% ZKX) (shCvtSX sh) xarr)
 
+sfromOrthotope :: PrimElt a => ShS sh -> SS.Array sh a -> Shaped sh a
+sfromOrthotope sh (SS.A (SG.A arr)) =
+  Shaped (fromPrimitive (M_Primitive (shCvtSX sh) (X.XArray (RS.A (RG.A (shsToList sh) arr)))))
+
+stoOrthotope :: PrimElt a => Shaped sh a -> SS.Array sh a
+stoOrthotope (stoPrimitive -> Shaped (M_Primitive _ (X.XArray (RS.A (RG.A _ arr))))) = SS.A (SG.A arr)
+
 sunScalar :: Elt a => Shaped '[] a -> a
 sunScalar arr = sindex arr ZIS
 
-- 
cgit v1.2.3-70-g09d2