{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE LinearTypes #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneKindSignatures #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_HADDOCK hide #-}
module Data.V.Linear.Internal
( V (..),
empty,
consume,
map,
pure,
(<*>),
uncons#,
uncons,
Elim,
elim,
cons,
fromReplicator,
dupV,
theLength,
Make,
make,
ArityV,
)
where
import Data.Arity.Linear.Internal
import Data.Kind
import Data.Replicator.Linear.Internal (Replicator)
import qualified Data.Replicator.Linear.Internal as Replicator
import Data.Unrestricted.Linear.Internal.Dupable (Dupable (dupR))
import Data.Vector (Vector)
import qualified Data.Vector as Vector
import GHC.Exts (proxy#)
import GHC.TypeLits
import Prelude.Linear.Internal
import qualified Unsafe.Linear as Unsafe
import qualified Prelude
newtype V (n :: Nat) (a :: Type) = V (Vector a)
deriving (V n a -> V n a -> Bool
(V n a -> V n a -> Bool) -> (V n a -> V n a -> Bool) -> Eq (V n a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (n :: Nat) a. Eq a => V n a -> V n a -> Bool
/= :: V n a -> V n a -> Bool
$c/= :: forall (n :: Nat) a. Eq a => V n a -> V n a -> Bool
== :: V n a -> V n a -> Bool
$c== :: forall (n :: Nat) a. Eq a => V n a -> V n a -> Bool
Prelude.Eq, Eq (V n a)
Eq (V n a)
-> (V n a -> V n a -> Ordering)
-> (V n a -> V n a -> Bool)
-> (V n a -> V n a -> Bool)
-> (V n a -> V n a -> Bool)
-> (V n a -> V n a -> Bool)
-> (V n a -> V n a -> V n a)
-> (V n a -> V n a -> V n a)
-> Ord (V n a)
V n a -> V n a -> Bool
V n a -> V n a -> Ordering
V n a -> V n a -> V n a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {n :: Nat} {a}. Ord a => Eq (V n a)
forall (n :: Nat) a. Ord a => V n a -> V n a -> Bool
forall (n :: Nat) a. Ord a => V n a -> V n a -> Ordering
forall (n :: Nat) a. Ord a => V n a -> V n a -> V n a
min :: V n a -> V n a -> V n a
$cmin :: forall (n :: Nat) a. Ord a => V n a -> V n a -> V n a
max :: V n a -> V n a -> V n a
$cmax :: forall (n :: Nat) a. Ord a => V n a -> V n a -> V n a
>= :: V n a -> V n a -> Bool
$c>= :: forall (n :: Nat) a. Ord a => V n a -> V n a -> Bool
> :: V n a -> V n a -> Bool
$c> :: forall (n :: Nat) a. Ord a => V n a -> V n a -> Bool
<= :: V n a -> V n a -> Bool
$c<= :: forall (n :: Nat) a. Ord a => V n a -> V n a -> Bool
< :: V n a -> V n a -> Bool
$c< :: forall (n :: Nat) a. Ord a => V n a -> V n a -> Bool
compare :: V n a -> V n a -> Ordering
$ccompare :: forall (n :: Nat) a. Ord a => V n a -> V n a -> Ordering
Prelude.Ord, (forall a b. (a -> b) -> V n a -> V n b)
-> (forall a b. a -> V n b -> V n a) -> Functor (V n)
forall a b. a -> V n b -> V n a
forall a b. (a -> b) -> V n a -> V n b
forall (n :: Nat) a b. a -> V n b -> V n a
forall (n :: Nat) a b. (a -> b) -> V n a -> V n b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> V n b -> V n a
$c<$ :: forall (n :: Nat) a b. a -> V n b -> V n a
fmap :: forall a b. (a -> b) -> V n a -> V n b
$cfmap :: forall (n :: Nat) a b. (a -> b) -> V n a -> V n b
Prelude.Functor)
empty :: forall a. V 0 a
empty :: forall a. V 0 a
empty = Vector a -> V 0 a
forall (n :: Nat) a. Vector a -> V n a
V Vector a
forall a. Vector a
Vector.empty
consume :: V 0 a %1 -> ()
consume :: forall a. V 0 a %1 -> ()
consume = (V 0 a -> ()) %1 -> V 0 a %1 -> ()
forall a b (p :: Multiplicity) (x :: Multiplicity).
(a %p -> b) %1 -> a %x -> b
Unsafe.toLinear (\V 0 a
_ -> ())
{-# INLINEABLE consume #-}
map :: (a %1 -> b) -> V n a %1 -> V n b
map :: forall a b (n :: Nat). (a %1 -> b) -> V n a %1 -> V n b
map a %1 -> b
f (V Vector a
xs) = Vector b %1 -> V n b
forall (n :: Nat) a. Vector a -> V n a
V (Vector b %1 -> V n b) -> Vector b %1 -> V n b
forall a b (p :: Multiplicity) (q :: Multiplicity).
(a %p -> b) %q -> a %p -> b
$ (Vector a -> Vector b) %1 -> Vector a %1 -> Vector b
forall a b (p :: Multiplicity) (x :: Multiplicity).
(a %p -> b) %1 -> a %x -> b
Unsafe.toLinear ((a -> b) -> Vector a -> Vector b
forall a b. (a -> b) -> Vector a -> Vector b
Vector.map (\a
x -> a %1 -> b
f a
x)) Vector a
xs
(<*>) :: V n (a %1 -> b) %1 -> V n a %1 -> V n b
(V Vector (a %1 -> b)
fs) <*> :: forall (n :: Nat) a b. V n (a %1 -> b) %1 -> V n a %1 -> V n b
<*> (V Vector a
xs) =
Vector b %1 -> V n b
forall (n :: Nat) a. Vector a -> V n a
V (Vector b %1 -> V n b) -> Vector b %1 -> V n b
forall a b (p :: Multiplicity) (q :: Multiplicity).
(a %p -> b) %q -> a %p -> b
$
(Vector (a %1 -> b) -> Vector a -> Vector b)
%1 -> Vector (a %1 -> b) %1 -> Vector a %1 -> Vector b
forall a b c (p :: Multiplicity) (q :: Multiplicity)
(x :: Multiplicity) (y :: Multiplicity).
(a %p -> b %q -> c) %1 -> a %x -> b %y -> c
Unsafe.toLinear2 (((a %1 -> b) -> a -> b)
-> Vector (a %1 -> b) -> Vector a -> Vector b
forall a b c. (a -> b -> c) -> Vector a -> Vector b -> Vector c
Vector.zipWith (\a %1 -> b
f a
x -> a %1 -> b
f (a %1 -> b) -> a %1 -> b
forall a b (p :: Multiplicity) (q :: Multiplicity).
(a %p -> b) %q -> a %p -> b
$ a
x)) Vector (a %1 -> b)
fs Vector a
xs
infixl 4 <*>
uncons# :: 1 <= n => V n a %1 -> (# a, V (n - 1) a #)
uncons# :: forall (n :: Nat) a. (1 <= n) => V n a %1 -> (# a, V (n - 1) a #)
uncons# = (V n a -> (# a, V (n - 1) a #))
%1 -> V n a %1 -> (# a, V (n - 1) a #)
forall a b (p :: Multiplicity) (x :: Multiplicity).
(a %p -> b) %1 -> a %x -> b
Unsafe.toLinear V n a -> (# a, V (n - 1) a #)
forall (n :: Nat) a. (1 <= n) => V n a -> (# a, V (n - 1) a #)
uncons'#
where
uncons'# :: 1 <= n => V n a -> (# a, V (n - 1) a #)
uncons'# :: forall (n :: Nat) a. (1 <= n) => V n a -> (# a, V (n - 1) a #)
uncons'# (V Vector a
xs) = (# Vector a -> a
forall a. Vector a -> a
Vector.head Vector a
xs, Vector a -> V (n - 1) a
forall (n :: Nat) a. Vector a -> V n a
V (Vector a -> Vector a
forall a. Vector a -> Vector a
Vector.tail Vector a
xs) #)
{-# INLINEABLE uncons# #-}
uncons :: 1 <= n => V n a %1 -> (a, V (n - 1) a)
uncons :: forall (n :: Nat) a. (1 <= n) => V n a %1 -> (a, V (n - 1) a)
uncons = (V n a -> (a, V (n - 1) a)) %1 -> V n a %1 -> (a, V (n - 1) a)
forall a b (p :: Multiplicity) (x :: Multiplicity).
(a %p -> b) %1 -> a %x -> b
Unsafe.toLinear V n a -> (a, V (n - 1) a)
forall (n :: Nat) a. (1 <= n) => V n a -> (a, V (n - 1) a)
uncons'
where
uncons' :: 1 <= n => V n a -> (a, V (n - 1) a)
uncons' :: forall (n :: Nat) a. (1 <= n) => V n a -> (a, V (n - 1) a)
uncons' (V Vector a
xs) = (Vector a -> a
forall a. Vector a -> a
Vector.head Vector a
xs, Vector a -> V (n - 1) a
forall (n :: Nat) a. Vector a -> V n a
V (Vector a -> Vector a
forall a. Vector a -> Vector a
Vector.tail Vector a
xs))
{-# INLINEABLE uncons #-}
elim ::
forall (n :: Nat) a b f.
(
n ~ PeanoToNat (NatToPeano n),
Elim (NatToPeano n) a b,
IsFunN a b f,
f ~ FunN (NatToPeano n) a b,
n ~ Arity b f
) =>
f %1 ->
V n a %1 ->
b
elim :: forall (n :: Nat) a b f.
(n ~ PeanoToNat (NatToPeano n), Elim (NatToPeano n) a b,
IsFunN a b f, f ~ FunN (NatToPeano n) a b, n ~ Arity b f) =>
f %1 -> V n a %1 -> b
elim f
f V n a
v = forall (n :: Peano) a b.
Elim n a b =>
FunN n a b %1 -> V (PeanoToNat n) a %1 -> b
elim' @(NatToPeano n) f
FunN (NatToPeano n) a b
f V n a
V (PeanoToNat (NatToPeano n)) a
v
type Elim :: Peano -> Type -> Type -> Constraint
class Elim n a b where
elim' :: FunN n a b %1 -> V (PeanoToNat n) a %1 -> b
instance Elim 'Z a b where
elim' :: FunN 'Z a b %1 -> V (PeanoToNat 'Z) a %1 -> b
elim' FunN 'Z a b
b V (PeanoToNat 'Z) a
v =
V 0 a %1 -> ()
forall a. V 0 a %1 -> ()
consume V 0 a
V (PeanoToNat 'Z) a
v () %1 -> (() %1 -> b) %1 -> b
forall a b (p :: Multiplicity) (q :: Multiplicity).
a %p -> (a %p -> b) %q -> b
& \case
() -> b
FunN 'Z a b
b
{-# INLINE elim' #-}
instance (1 <= 1 + PeanoToNat n, (1 + PeanoToNat n) - 1 ~ PeanoToNat n, Elim n a b) => Elim ('S n) a b where
elim' :: FunN ('S n) a b %1 -> V (PeanoToNat ('S n)) a %1 -> b
elim' FunN ('S n) a b
g V (PeanoToNat ('S n)) a
v =
V (1 + PeanoToNat n) a %1 -> (a, V ((1 + PeanoToNat n) - 1) a)
forall (n :: Nat) a. (1 <= n) => V n a %1 -> (a, V (n - 1) a)
uncons V (1 + PeanoToNat n) a
V (PeanoToNat ('S n)) a
v (a, V ((1 + PeanoToNat n) - 1) a)
%1 -> ((a, V ((1 + PeanoToNat n) - 1) a) %1 -> b) %1 -> b
forall a b (p :: Multiplicity) (q :: Multiplicity).
a %p -> (a %p -> b) %q -> b
& \case
(a
a, V ((1 + PeanoToNat n) - 1) a
v') -> forall (n :: Peano) a b.
Elim n a b =>
FunN n a b %1 -> V (PeanoToNat n) a %1 -> b
elim' @n (FunN ('S n) a b
a %1 -> FunN n a b
g a
a) V ((1 + PeanoToNat n) - 1) a
V (PeanoToNat n) a
v'
{-# INLINE elim' #-}
cons :: forall n a. a %1 -> V (n - 1) a %1 -> V n a
cons :: forall (n :: Nat) a. a %1 -> V (n - 1) a %1 -> V n a
cons = (a -> V (n - 1) a -> V n a) %1 -> a %1 -> V (n - 1) a %1 -> V n a
forall a b c (p :: Multiplicity) (q :: Multiplicity)
(x :: Multiplicity) (y :: Multiplicity).
(a %p -> b %q -> c) %1 -> a %x -> b %y -> c
Unsafe.toLinear2 ((a -> V (n - 1) a -> V n a) %1 -> a %1 -> V (n - 1) a %1 -> V n a)
-> (a -> V (n - 1) a -> V n a)
%1 -> a
%1 -> V (n - 1) a
%1 -> V n a
forall a b (p :: Multiplicity) (q :: Multiplicity).
(a %p -> b) %q -> a %p -> b
$ \a
x (V Vector a
v) -> Vector a -> V n a
forall (n :: Nat) a. Vector a -> V n a
V (a -> Vector a -> Vector a
forall a. a -> Vector a -> Vector a
Vector.cons a
x Vector a
v)
type family ArityV f where
ArityV (V _ _) = 0
ArityV (a %1 -> f) = 1 + ArityV f
ArityV f =
TypeError
( 'Text "Arity: "
':<>: 'ShowType f
':<>: 'Text " isn't a linear function with head (V _ _)"
)
make ::
forall (n :: Nat) a f.
(
n ~ PeanoToNat (NatToPeano n),
Make (NatToPeano n) (NatToPeano n) a,
IsFunN a (V n a) f,
f ~ FunN (NatToPeano n) a (V n a),
n ~ ArityV f
) =>
f
make :: forall (n :: Nat) a f.
(n ~ PeanoToNat (NatToPeano n),
Make (NatToPeano n) (NatToPeano n) a, IsFunN a (V n a) f,
f ~ FunN (NatToPeano n) a (V n a), n ~ ArityV f) =>
f
make = forall (m :: Peano) (n :: Peano) a.
Make m n a =>
(V (PeanoToNat m) a %1 -> V (PeanoToNat n) a)
%1 -> FunN m a (V (PeanoToNat n) a)
make' @(NatToPeano n) @(NatToPeano n) @a V (PeanoToNat (NatToPeano n)) a
%1 -> V (PeanoToNat (NatToPeano n)) a
forall a (q :: Multiplicity). a %q -> a
id
{-# INLINE make #-}
type Make :: Peano -> Peano -> Type -> Constraint
class Make m n a where
make' :: (V (PeanoToNat m) a %1 -> V (PeanoToNat n) a) %1 -> FunN m a (V (PeanoToNat n) a)
instance Make 'Z n a where
make' :: (V (PeanoToNat 'Z) a %1 -> V (PeanoToNat n) a)
%1 -> FunN 'Z a (V (PeanoToNat n) a)
make' V (PeanoToNat 'Z) a %1 -> V (PeanoToNat n) a
produceFrom = V (PeanoToNat 'Z) a %1 -> V (PeanoToNat n) a
produceFrom V (PeanoToNat 'Z) a
forall a. V 0 a
empty
{-# INLINE make' #-}
instance ((1 + PeanoToNat m) - 1 ~ PeanoToNat m, Make m n a) => Make ('S m) n a where
make' :: (V (PeanoToNat ('S m)) a %1 -> V (PeanoToNat n) a)
%1 -> FunN ('S m) a (V (PeanoToNat n) a)
make' V (PeanoToNat ('S m)) a %1 -> V (PeanoToNat n) a
produceFrom = \a
x -> forall (m :: Peano) (n :: Peano) a.
Make m n a =>
(V (PeanoToNat m) a %1 -> V (PeanoToNat n) a)
%1 -> FunN m a (V (PeanoToNat n) a)
make' @m @n @a (\V (PeanoToNat m) a
s -> V (1 + PeanoToNat m) a %1 -> V (PeanoToNat n) a
V (PeanoToNat ('S m)) a %1 -> V (PeanoToNat n) a
produceFrom (V (1 + PeanoToNat m) a %1 -> V (PeanoToNat n) a)
%1 -> V (1 + PeanoToNat m) a %1 -> V (PeanoToNat n) a
forall a b (p :: Multiplicity) (q :: Multiplicity).
(a %p -> b) %q -> a %p -> b
$ a %1 -> V ((1 + PeanoToNat m) - 1) a %1 -> V (1 + PeanoToNat m) a
forall (n :: Nat) a. a %1 -> V (n - 1) a %1 -> V n a
cons a
x V ((1 + PeanoToNat m) - 1) a
V (PeanoToNat m) a
s)
{-# INLINE make' #-}
theLength :: forall n. KnownNat n => Prelude.Int
theLength :: forall (n :: Nat). KnownNat n => Int
theLength = Integer -> Int
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral (forall (n :: Nat). KnownNat n => Proxy# n -> Integer
natVal' @n (forall {k} (a :: k). Proxy# a
forall (a :: Nat). Proxy# a
proxy# @_))
pure :: forall n a. KnownNat n => a -> V n a
pure :: forall (n :: Nat) a. KnownNat n => a -> V n a
pure a
a = Vector a -> V n a
forall (n :: Nat) a. Vector a -> V n a
V (Vector a -> V n a) -> Vector a -> V n a
forall a b (p :: Multiplicity) (q :: Multiplicity).
(a %p -> b) %q -> a %p -> b
$ Int -> a -> Vector a
forall a. Int -> a -> Vector a
Vector.replicate (forall (n :: Nat). KnownNat n => Int
theLength @n) a
a
fromReplicator :: forall n a. KnownNat n => Replicator a %1 -> V n a
fromReplicator :: forall (n :: Nat) a. KnownNat n => Replicator a %1 -> V n a
fromReplicator = let n' :: Int
n' = forall (n :: Nat). KnownNat n => Int
theLength @n in Vector a %1 -> V n a
forall (n :: Nat) a. Vector a -> V n a
V (Vector a %1 -> V n a)
-> (Replicator a %1 -> Vector a) -> Replicator a %1 -> V n a
forall b c a (q :: Multiplicity) (m :: Multiplicity)
(n :: Multiplicity).
(b %1 -> c) %q -> (a %1 -> b) %m -> a %n -> c
. ([a] -> Vector a) %1 -> [a] %1 -> Vector a
forall a b (p :: Multiplicity) (x :: Multiplicity).
(a %p -> b) %1 -> a %x -> b
Unsafe.toLinear [a] -> Vector a
forall a. [a] -> Vector a
Vector.fromList ([a] %1 -> Vector a)
-> (Replicator a %1 -> [a]) -> Replicator a %1 -> Vector a
forall b c a (q :: Multiplicity) (m :: Multiplicity)
(n :: Multiplicity).
(b %1 -> c) %q -> (a %1 -> b) %m -> a %n -> c
. Int -> Replicator a %1 -> [a]
forall a. Int -> Replicator a %1 -> [a]
Replicator.take Int
n'
dupV :: forall n a. (KnownNat n, Dupable a) => a %1 -> V n a
dupV :: forall (n :: Nat) a. (KnownNat n, Dupable a) => a %1 -> V n a
dupV = Replicator a %1 -> V n a
forall (n :: Nat) a. KnownNat n => Replicator a %1 -> V n a
fromReplicator (Replicator a %1 -> V n a)
-> (a %1 -> Replicator a) -> a %1 -> V n a
forall b c a (q :: Multiplicity) (m :: Multiplicity)
(n :: Multiplicity).
(b %1 -> c) %q -> (a %1 -> b) %m -> a %n -> c
. a %1 -> Replicator a
forall a. Dupable a => a %1 -> Replicator a
dupR