From 6a8520f957531bd0e41bd8adde9dedbf1cc916be Mon Sep 17 00:00:00 2001
From: Tom Smeding <tom@tomsmeding.com>
Date: Thu, 23 May 2024 23:10:23 +0200
Subject: fromList1Prim

---
 src/Data/Array/Nested.hs          |  8 ++++----
 src/Data/Array/Nested/Internal.hs | 12 ++++++++++++
 2 files changed, 16 insertions(+), 4 deletions(-)

(limited to 'src/Data/Array')

diff --git a/src/Data/Array/Nested.hs b/src/Data/Array/Nested.hs
index 292eba4..49923d8 100644
--- a/src/Data/Array/Nested.hs
+++ b/src/Data/Array/Nested.hs
@@ -5,11 +5,11 @@ module Data.Array.Nested (
   Ranked(Ranked),
   ListR(ZR, (:::)),
   IxR(.., ZIR, (:.:)), IIxR,
-  ShR(.., ZSR, (:$:)),
+  ShR(.., ZSR, (:$:)), IShR,
   rshape, rindex, rindexPartial, rgenerate, rsumOuter1,
   rtranspose, rappend, rscalar, rfromVector, rtoVector, runScalar,
   rrerank,
-  rreplicate, rfromListOuter, rfromList1, rtoListOuter, rtoList1,
+  rreplicate, rfromListOuter, rfromList1, rfromList1Prim, rtoListOuter, rtoList1,
   rslice, rrev1, rreshape, riota,
   -- ** Lifting orthotope operations to 'Ranked' arrays
   rlift, rlift2,
@@ -26,7 +26,7 @@ module Data.Array.Nested (
   sshape, sindex, sindexPartial, sgenerate, ssumOuter1,
   stranspose, sappend, sscalar, sfromVector, stoVector, sunScalar,
   srerank,
-  sreplicate, sfromListOuter, sfromList1, stoListOuter, stoList1,
+  sreplicate, sfromListOuter, sfromList1, sfromList1Prim, stoListOuter, stoList1,
   sslice, srev1, sreshape, siota,
   -- ** Lifting orthotope operations to 'Shaped' arrays
   slift, slift2,
@@ -41,7 +41,7 @@ module Data.Array.Nested (
   mshape, mindex, mindexPartial, mgenerate, msumOuter1,
   mtranspose, mappend, mscalar, mfromVector, mtoVector, munScalar,
   mrerank,
-  mreplicate, mfromListOuter, mfromList1, mtoListOuter, mtoList1,
+  mreplicate, mfromListOuter, mfromList1, mfromList1Prim, mtoListOuter, mtoList1,
   mslice, mrev1, mreshape, miota,
   -- ** Lifting orthotope operations to 'Mixed' arrays
   mlift, mlift2,
diff --git a/src/Data/Array/Nested/Internal.hs b/src/Data/Array/Nested/Internal.hs
index 118612f..c70da54 100644
--- a/src/Data/Array/Nested/Internal.hs
+++ b/src/Data/Array/Nested/Internal.hs
@@ -926,6 +926,12 @@ mtoVector arr = mtoVectorP (toPrimitive arr)
 mfromList1 :: Elt a => NonEmpty a -> Mixed '[Nothing] a
 mfromList1 = mfromListOuter . fmap mscalar  -- TODO: optimise?
 
+mfromList1Prim :: PrimElt a => [a] -> Mixed '[Nothing] a
+mfromList1Prim l =
+  let ssh = SUnknown () :!% ZKX
+      xarr = X.fromList1 ssh l
+  in fromPrimitive $ M_Primitive (X.shape ssh xarr) xarr
+
 mtoList1 :: Elt a => Mixed '[n] a -> [a]
 mtoList1 = map munScalar . mtoListOuter
 
@@ -1521,6 +1527,9 @@ rfromListOuter l
 rfromList1 :: Elt a => NonEmpty a -> Ranked 1 a
 rfromList1 l = Ranked (mfromList1 l)
 
+rfromList1Prim :: PrimElt a => [a] -> Ranked 1 a
+rfromList1Prim l = Ranked (mfromList1Prim l)
+
 rtoListOuter :: forall n a. Elt a => Ranked (n + 1) a -> [Ranked n a]
 rtoListOuter (Ranked arr)
   | Refl <- X.lemReplicateSucc @(Nothing @Nat) @n
@@ -1832,6 +1841,9 @@ sfromListOuter sn l = Shaped (mcast (SUnknown () :!% ZKX) (SKnown sn :$% ZSX) Pr
 sfromList1 :: Elt a => SNat n -> NonEmpty a -> Shaped '[n] a
 sfromList1 sn = Shaped . mcast (SUnknown () :!% ZKX) (SKnown sn :$% ZSX) Proxy . mfromList1
 
+sfromList1Prim :: (PrimElt a, Elt a) => SNat n -> [a] -> Shaped '[n] a
+sfromList1Prim sn = Shaped . mcast (SUnknown () :!% ZKX) (SKnown sn :$% ZSX) Proxy . mfromList1Prim
+
 stoListOuter :: Elt a => Shaped (n : sh) a -> [Shaped sh a]
 stoListOuter (Shaped arr) = coerce (mtoListOuter arr)
 
-- 
cgit v1.2.3-70-g09d2