25 | import public Control.Monad.State
26 | import Control.Monad.Error.Either
27 | import Syntax.PreorderReasoning
29 | import Compiler.Eval
31 | import Compiler.Array
32 | import Compiler.LiteralRW
33 | import Compiler.Passes
36 | import public Literal
42 | data Tensor : Shape -> DType -> Type where
43 | MkTensor : Value -> {shape : _} -> {dtype : _} -> Tensor shape dtype
45 | (.type) : Tensor shape dtype -> ValueType
46 | (.type) (MkTensor {shape, dtype} _) = TensorType shape dtype
48 | (.value) : Tensor s t -> Value
49 | (.value) (MkTensor v) = v
53 | data TagT : (Type -> Type) -> Type -> Type where
54 | MkTagT : StateT Env m a -> TagT m a
61 | Functor m => Functor (TagT m) where
62 | map f (MkTagT x) = MkTagT (map f x)
65 | Monad m => Applicative (TagT m) where
66 | pure x = MkTagT (pure x)
67 | (MkTagT f) <*> (MkTagT x) = MkTagT (f <*> x)
70 | Monad m => Monad (TagT m) where
71 | (MkTagT x) >>= f = MkTagT $
x >>= (\y => let MkTagT z = f y in z)
74 | MonadTrans TagT where
75 | lift = MkTagT . lift
78 | interface Taggable a where
95 | tag : Monad m => a -> TagT m a
97 | Taggable OpRef where
98 | tag = MkTagT . tagOpRef
101 | Taggable (Tensor shape dtype) where
102 | tag (MkTensor $
V idx op) = map (\op => MkTensor $
V idx op) (tag op)
105 | (Taggable a, Taggable b) => Taggable (a, b) where
106 | tag (a, b) = [| (tag a, tag b) |]
109 | val0 = V 0 . Concrete
111 | t0 : {shape : _} -> {dtype : _} -> Op -> Tensor shape dtype
112 | t0 x = MkTensor $
val0 x
121 | tensor : {shape : _} -> {dtype : _} -> Literal shape (idrisType dtype) -> Tensor shape dtype
122 | tensor lit = t0 $
Lit shape dtype lit
126 | fromDouble : Double -> Tensor [] F64
127 | fromDouble = tensor . Scalar
129 | try : Show e => EitherT e IO a -> IO a
130 | try = eitherT (\e => assert_total $
idris_crash $
show e) pure
132 | %hide Literal.All2.All2
150 | forall shapes, dtypes .
152 | Tag (All2 Tensor shapes dtypes) ->
153 | IO (All2 Literal shapes (DType.idrisType <$> dtypes))
154 | eval device (MkTagT xs) =
155 | let (env, xs) = runState empty xs
156 | main = MkFn 0 [] (extract (.type) xs) (extract (.value) xs) env
157 | types = mapProperty (\(MkTensor _) => MkTensorData ()) xs
158 | in try $
readAll <$> execute device main types
162 | extract : (forall s, t . Tensor s t -> a) -> All2 Tensor ss tt -> Vect (length ss) a
164 | extract f (x :: xs) = f x :: extract f xs
167 | All2 (TensorData $
\_ => Array . DType.idrisType) s t ->
168 | All2 Literal s (DType.idrisType <$> t)
170 | readAll (MkTensorData {dtype} l :: ls) = read dtype l :: readAll ls
175 | forall shapes, dtypes .
177 | All2 Tensor shapes dtypes ->
178 | IO (All2 Literal shapes (DType.idrisType <$> dtypes))
179 | eval device xs = eval device (pure xs)
189 | eval : Device -> Tag (Tensor shape dtype) -> IO (Literal shape (DType.idrisType dtype))
190 | eval device x = map (\[z] => z) $
List.Tag.eval device $
map (\z => [z]) x
194 | eval : Device -> Tensor shape dtype -> IO (Literal shape (DType.idrisType dtype))
195 | eval device x = eval device (pure x)
201 | Show (Tag $
Tensor shape dtype) where
203 | let (env, MkTensor x) = runState empty x
204 | in show (MkFn 0 [] [TensorType shape dtype] [x] env)
207 | Show (Tensor shape dtype) where show = show . pure {f = Tag}
211 | inf : Tensor [] F64
215 | nan : Tensor [] F64
220 | min : Ord dtype => Tensor [] dtype
221 | min @{OrdS32} = t0 $
MinValue S32
222 | min @{OrdS64} = t0 $
MinValue S64
223 | min @{OrdU32} = t0 $
MinValue U32
224 | min @{OrdU64} = t0 $
MinValue U64
225 | min @{OrdF64} = tensor $
Scalar $
-1.0 / 0.0
229 | max : Ord dtype => Tensor [] dtype
230 | max @{OrdS32} = t0 $
MaxValue S32
231 | max @{OrdS64} = t0 $
MaxValue S64
232 | max @{OrdU32} = t0 $
MaxValue U32
233 | max @{OrdU64} = t0 $
MaxValue U64
234 | max @{OrdF64} = tensor $
Scalar $
1.0 / 0.0
238 | minFinite : Tensor [] F64
239 | minFinite = t0 MinFiniteFloat
243 | maxFinite : Tensor [] F64
244 | maxFinite = t0 MaxFiniteFloat
249 | castDtype : Integral dtype => Tensor shape dtype -> Tensor shape F64
250 | castDtype $
MkTensor {shape} x = t0 $
Convert F64 shape x
254 | Func : Vect arity Type -> Type -> Type
256 | Func (t :: ts) r = t -> Func ts r
258 | mapFunc : (a -> b) -> {arity : Nat} -> {0 xs : Vect arity Type} -> Func xs a -> Func xs b
259 | mapFunc f {arity = 0} {xs = []} g = f g
260 | mapFunc f {arity = (S k)} {xs = _ :: _} g = \x => mapFunc f (g x)
263 | forall arity, rshapes, rdtypes . (shapes : Vect arity Shape) -> (dtypes : Vect arity DType) ->
264 | Func [| Tensor shapes dtypes |] (Tag $
All2 Tensor rshapes rdtypes) ->
265 | Tag (Fn arity, All2 Tensor rshapes rdtypes)
266 | mkFn' shapes dtypes f = MkTagT $
do
269 | let leq : length shapes === arity
270 | leq = lengthCorrect shapes
272 | let MkTagT res = applyNary addr (length shapes) _ _ $
rewrite leq in f
273 | (env, results) = runState (emptyFrom !get) res
274 | resAndTys = fromList $
resultsAndTypes results
275 | argValueTypes = zipWith TensorType shapes dtypes
276 | f : Fn arity = MkFn addr argValueTypes (snd <$> resAndTys) (fst <$> resAndTys) env
278 | updateCounterFrom env
285 | (addr, ar : Nat) ->
286 | (ss : Vect ar Shape) ->
287 | (ds : Vect ar DType) ->
288 | Func [| Tensor ss ds |] a -> a
289 | applyNary addr 0 [] [] f = f
290 | applyNary addr (S a) (s :: ss) (t :: ts) f =
291 | applyNary addr a ss ts (f $
MkTensor $
V (length shapes `minus` S a) $
BoundSet addr)
293 | resultsAndTypes : All2 Tensor s d -> List (Value, ValueType)
294 | resultsAndTypes [] = []
295 | resultsAndTypes ((MkTensor {shape, dtype} x) :: xs) =
296 | (x, TensorType shape dtype) :: resultsAndTypes xs
299 | {arity : _} -> (shapes : Vect arity Shape) -> (dtypes : Vect arity DType) ->
300 | forall rshapes, rdtypes .
301 | Func [| Tensor shapes dtypes |] (Tag $
All2 Tensor rshapes rdtypes) -> Tag $
Fn arity
302 | mkFn shapes dtypes f = fst <$> mkFn' shapes dtypes f
305 | {arity : _} -> (shapes : Vect arity Shape) -> (dtypes : Vect arity DType) ->
306 | Func [| Tensor shapes dtypes |] (Tag $
Tensor rshape rdtype) -> Tag $
Fn arity
307 | mkFn1 shapes dtypes f =
308 | mkFn shapes dtypes $
mapFunc (\x => pure $
the (All2 _ _ _) [!x]) f
312 | {arity : _} -> {shapes : Vect arity Shape} -> {dtypes : Vect arity DType} ->
313 | forall rshapes, rdtypes .
314 | (shapeFn : Shape -> Shape) ->
315 | (forall extra . Fn (arity + extra) -> Vect arity Value -> Vect extra Value -> Op) ->
316 | Func [| Tensor shapes dtypes |] (Tag $
All2 Tensor rshapes rdtypes) ->
317 | Tag $
Func [| Tensor (shapeFn <$> shapes) dtypes |] $
318 | Tag $
All2 Tensor (shapeFn <$> rshapes) rdtypes
319 | namedFunc shapeFn remapResults f = do
320 | (f, results) <- mkFn' shapes dtypes {rshapes, rdtypes} f
321 | let (extraArgs, f) = snd $
removeCaptures {n = arity} f
322 | MkTagT $
modify {ops $= ((f.tag, NamedFunc f) ::)}
323 | let remap = \args =>
324 | retarget 0 results <$> tag (Concrete $
remapResults f args extraArgs)
325 | pure $
mapFunc remap $
args [] arity (shapeFn <$> shapes) dtypes
330 | (acc : Vect p Value) ->
332 | (ss : Vect ar Shape) ->
333 | (ds : Vect ar DType) ->
334 | Func [| Tensor ss ds |] $
Vect (p + ar) Value
335 | args acc 0 [] [] = rewrite plusZeroRightNeutral p in acc
336 | args acc (S a) (s :: ss) (t :: ts) = \(MkTensor x) =>
337 | rewrite sym $
plusSuccRightSucc p a in args (snoc acc x) a ss ts
339 | retarget : Nat -> All2 Tensor ss ds -> OpRef -> All2 Tensor (shapeFn <$> ss) ds
340 | retarget k [] x = []
341 | retarget k (MkTensor {shape, dtype} _ :: xs) x =
342 | MkTensor {shape = shapeFn shape, dtype} (V k x) :: retarget (S k) xs x
356 | {shapes : Vect arity Shape} -> {dtypes : Vect arity DType} -> forall rshapes, rdtypes .
357 | let fn = Func [| Tensor shapes dtypes |] $
Tag $
All2 Tensor rshapes rdtypes in fn -> Tag fn
359 | rewrite sym $
functorIdentity shapes in
360 | rewrite sym $
functorIdentity rshapes in
361 | let lc = lengthCorrect (map id shapes) in
363 | namedFunc {arity = length (map id shapes)} id (rewrite lc in remapResults) (rewrite lc in f)
366 | remapResults : Fn (arity + extra) -> Vect arity Value -> Vect extra Value -> Op
367 | remapResults f explicitArgs extraArgs =
368 | CallByName f.tag (toList $
f.resultTypes) (toList $
explicitArgs ++ extraArgs)
393 | {shapes : Vect arity Shape} -> {dtypes : Vect arity DType} ->
394 | {rshapes : _} -> {rdtypes : _} ->
395 | Func [| Tensor shapes dtypes |] (Tag $
All2 Tensor rshapes rdtypes) ->
396 | Tag $
Func [| Tensor (Prelude.map (n ::) shapes) dtypes |]
397 | (Tag $
All2 Tensor (Prelude.map (n ::) rshapes) rdtypes)
399 | let lc = lengthCorrect shapes in
401 | namedFunc {arity = length shapes} (n ::) (rewrite lc in remapResults) (rewrite lc in f)
404 | remapResults : Fn (arity + extra) -> Vect arity Value -> Vect extra Value -> Op
405 | remapResults f explicitArgs extraArgs =
406 | let extraArgs = Prelude.map (V 0 . Concrete . Broadcast (AddLeading [n])) extraArgs
407 | outTys = zipWith (TensorType . (n ::)) rshapes rdtypes
408 | in Vectorize outTys [n] f.tag (toList $
explicitArgs ++ extraArgs)
428 | grad : (Tensor shape F64 -> Tag $
Tensor [] F64) -> Tensor shape F64 -> Tag $
Tensor shape F64
429 | grad f (MkTensor x) = pure $
t0 $
Grad shape !(mkFn1 [shape] [_] f) x
436 | {auto 0 sizesEqual : product from = product to} ->
437 | Tensor from dtype ->
439 | reshape $
MkTensor {shape} x = t0 $
Reshape dtype to x
447 | {auto 0 inBounds : axis `LTE` length shape} ->
448 | Tensor shape dtype ->
449 | Tensor (insertAt axis 1 shape) dtype
450 | expand axis $
MkTensor {shape = _} x = t0 $
Reshape dtype (insertAt axis 1 shape) x
452 | namespace Squeezable
456 | data Squeezable : (0 from : Shape) -> (0 to : Shape) -> Type where
461 | Same : Squeezable x x
467 | Match : Squeezable from to -> Squeezable (x :: from) (x :: to)
472 | Nest : Squeezable from to -> Squeezable (1 :: from) to
493 | {auto 0 shapesSqueezable : Squeezable from to} ->
494 | Tensor from dtype ->
496 | squeeze $
MkTensor {shape} x = t0 $
Reshape dtype to x
501 | data SliceOrIndex : Nat -> Type where
503 | (from, to : Nat) ->
505 | {auto 0 fromTo : from + size = to} ->
506 | {auto 0 inDim : LTE to d} ->
508 | Index : (idx : Nat) -> {auto 0 inDim : LT idx d} -> SliceOrIndex d
509 | DynamicSlice : Tensor [] U64 -> (size : Nat) -> {auto 0 inDim : LTE size d} -> SliceOrIndex d
510 | DynamicIndex : Tensor [] U64 -> SliceOrIndex d
514 | at : (idx : Nat) -> {auto 0 inDim : LT idx d} -> SliceOrIndex d
520 | at : Tensor [] U64 -> SliceOrIndex d
526 | (from, to : Nat) ->
528 | {auto 0 fromTo : from + size = to} ->
529 | {auto 0 inDim : LTE to d} ->
535 | (.size) : Tensor [] U64 -> (size : Nat) -> {auto 0 inDim : LTE size d} -> SliceOrIndex d
536 | (.size) = DynamicSlice
540 | all : {d : _} -> SliceOrIndex d
541 | all = Slice 0 @{%search} @{reflexive {ty = Nat}} d
546 | data MultiSlice : Shape -> Type where
547 | Nil : MultiSlice ds
548 | (::) : SliceOrIndex d -> MultiSlice ds -> MultiSlice (d :: ds)
550 | namespace MultiSlice
554 | slice : {shape : _} -> MultiSlice shape -> Shape
555 | slice {shape} [] = shape
556 | slice {shape = (_ :: _)} (Slice {size} _ _ :: xs) = size :: slice xs
557 | slice {shape = (_ :: _)} (Index _ :: xs) = slice xs
558 | slice {shape = (_ :: _)} (DynamicSlice _ size :: xs) = size :: slice xs
559 | slice {shape = (_ :: _)} (DynamicIndex _ :: xs) = slice xs
647 | slice : (at : MultiSlice shape) -> Tensor shape dtype -> Tensor (slice at) dtype
648 | slice at $
MkTensor x = MkTensor $
649 | let x = val0 $
Slice (mapd start (const 0) at) (mapd stop id at) (replicate (length shape) 1) x
651 | x = if isDynamic at then val0 $
DynamicSlice (dynStarts [] at) (mapd size id at) x else x
652 | in val0 $
Reshape dtype (MultiSlice.slice at) x
655 | mapd : ((Nat -> a) -> {d : Nat} -> SliceOrIndex d -> a) ->
658 | MultiSlice shape ->
660 | mapd _ dflt {shape} [] = Prelude.map dflt shape
661 | mapd f dflt (x :: xs) = f dflt x :: mapd f dflt xs
663 | start : (Nat -> Nat) -> {d : Nat} -> SliceOrIndex d -> Nat
664 | start _ (Slice from _) = from
665 | start _ (Index idx) = idx
666 | start f {d} _ = f d
668 | stop : (Nat -> Nat) -> {d : Nat} -> SliceOrIndex d -> Nat
669 | stop _ (Slice _ to) = to
670 | stop _ (Index idx) = S idx
673 | size : (Nat -> Nat) -> {d : Nat} -> SliceOrIndex d -> Nat
674 | size _ (Slice {size = size'} _ _) = size'
675 | size _ (Index _) = 1
676 | size _ (DynamicSlice _ size') = size'
677 | size _ (DynamicIndex _) = 1
680 | zero = val0 $
Lit [] U64 $
Scalar 0
682 | isDynamic : {shape : _} -> MultiSlice shape -> Bool
683 | isDynamic [] = False
684 | isDynamic {shape = (_ :: _)} (DynamicSlice _ _ :: _) = True
685 | isDynamic {shape = (_ :: _)} (DynamicIndex _ :: _) = True
686 | isDynamic (_ :: ds) = isDynamic ds
688 | dynStarts : List Value -> {shape : _} -> MultiSlice shape -> List Value
689 | dynStarts idxs {shape} [] = replicate (length shape) zero ++ idxs
690 | dynStarts idxs (DynamicSlice (MkTensor i) _ :: ds) = i :: dynStarts idxs ds
691 | dynStarts idxs (DynamicIndex (MkTensor i) :: ds) = i :: dynStarts idxs ds
692 | dynStarts idxs (_ :: ds) = zero :: dynStarts idxs ds
703 | {auto 0 inBounds : (InBounds axis s, InBounds axis s')} ->
704 | {auto 0 shapesConcatenable : deleteAt axis s = deleteAt axis s'} ->
705 | Tensor (replaceAt axis (index axis s + index axis s') s) dtype
706 | concat axis (MkTensor x) (MkTensor x') = t0 $
Concat axis [x, x']
710 | (.T) : Tensor [m, n] dtype -> Tensor [n, m] dtype
711 | (MkTensor x).T = t0 $
Transpose [1, 0] x
759 | (ordering : List Nat) ->
760 | Tensor shape dtype ->
761 | {auto 0 lengths : length ordering = length shape} ->
762 | {auto 0 axesUnique : unique ordering = True} ->
763 | {auto 0 inBounds : All (flip InBounds shape) ordering} ->
764 | Tensor (multiIndex ordering shape) dtype
765 | transpose ordering $
MkTensor x = t0 $
Transpose ordering x
770 | data DimBroadcastable : (0 from : Nat) -> (0 to : Nat) -> Type where
773 | Same : DimBroadcastable x x
777 | Stack : DimBroadcastable 1 _
780 | Zero : DimBroadcastable _ 0
782 | namespace Broadcastable
786 | data Broadcastable : (0 from : Shape) -> (0 to : Shape) -> Type where
795 | Same : Broadcastable x x
803 | Match : forall from, to .
804 | {auto 0 ranksEq : length from = length to} ->
805 | {auto 0 dimBroadcastable : DimBroadcastable f t} ->
806 | Broadcastable from to ->
807 | Broadcastable (f :: from) (t :: to)
813 | Nest : Broadcastable f t -> Broadcastable f (_ :: t)
819 | broadcastableByLeading : (leading : List Nat) -> Broadcastable shape (leading ++ shape)
820 | broadcastableByLeading [] = Same
821 | broadcastableByLeading (l :: ls) = Nest (broadcastableByLeading ls)
826 | scalarToAnyOk : (to : Shape) -> Broadcastable [] to
827 | scalarToAnyOk to = rewrite sym $
appendNilRightNeutral to in broadcastableByLeading to
841 | {to : _} -> {dtype : _} ->
842 | {auto shapesOK : Broadcastable from to} ->
843 | Tensor from dtype ->
845 | broadcast $
MkTensor {shape = _} x = t0 $
Broadcast (Explicit to) x
859 | fill : {shape : _} -> {dtype : _} -> idrisType dtype -> Tensor shape dtype
860 | fill x = broadcast {shapesOK = scalarToAnyOk shape} (tensor (Scalar x))
890 | {auto 0 _ : Num dtype} ->
892 | {auto 0 inBounds : InBounds axis shape} ->
894 | iota dimension = t0 $
Iota shape dtype dimension
909 | (condition : Tensor shape dtype -> Tag $
Tensor [] PRED) ->
910 | (body : Tensor shape dtype -> Tag $
Tensor shape dtype) ->
911 | (initial : Tensor shape dtype) ->
912 | Tag $
Tensor shape dtype
913 | while1 condition body (MkTensor i0) =
914 | pure $
t0 $
While !(mkFn1 [_] [_] condition) !(mkFn1 [_] [_] body) [i0]
930 | (condition : Tensor s a -> Tensor s' a' -> Tag $
Tensor [] PRED) ->
931 | (body : Tensor s a -> Tensor s' a' -> Tag $
All2 Tensor [s, s'] [a, a']) ->
932 | (initial : Tensor s a) -> (initial' : Tensor s' a') ->
933 | Tag $
All2 Tensor [s, s'] [a, a']
934 | while2 condition body (MkTensor i) (MkTensor i') = do
935 | res <- tag $
Concrete $
While !(mkFn1 [_, _] [_, _] condition) !(mkFn [_, _] [_, _] body) [i, i']
936 | pure [MkTensor $
V 0 res, MkTensor $
V 1 res]
950 | map : {b : _} -> (Tensor [] a -> Tag $
Tensor [] b) -> Tensor shape a -> Tag $
Tensor shape b
951 | map f $
MkTensor {shape = _} x =
952 | pure $
t0 $
Map !(mkFn1 [_] [_] f) [x] (TensorType shape b) (range $
length shape)
968 | (Tensor [] a -> Tensor [] b -> Tag $
Tensor [] c) ->
969 | Tensor shape a -> Tensor shape b -> Tag $
Tensor shape c
970 | map2 f (MkTensor {shape = _} x) (MkTensor x') =
971 | pure $
t0 $
Map !(mkFn1 [_, _] [_, _] f) [x, x'] (TensorType shape c) (range $
length shape)
989 | (reducer : Monoid (Tensor [] dtype)) =>
990 | (axes : List Nat) ->
991 | {auto 0 axesUnique : Sorted LT axes} ->
992 | {auto 0 axesInBounds : All (flip InBounds shape) axes} ->
993 | Tensor shape dtype ->
994 | Tag $
Tensor (deleteAt axes shape) dtype
995 | reduce axes $
MkTensor x = do
996 | let semigroup : Monoid a -> Semigroup a
997 | semigroup _ = %search
999 | g <- mkFn1 [_, _] [_, _] (pure .: (<+>) @{semigroup reducer})
1000 | let MkTensor neutral' = neutral @{reducer}
1001 | pure $
t0 $
Reduce g [neutral'] axes [x]
1022 | (Tensor [] dtype -> Tensor [] dtype -> Tensor [] PRED) ->
1025 | {auto 0 dimInBounds : InBounds dimension shape} ->
1026 | Tag $
Tensor shape dtype
1027 | sort comp dimension $
MkTensor x =
1028 | pure $
t0 $
Sort !(mkFn1 [_, _] [_, _] $
pure .: comp) dimension False x
1061 | {auto 0 axesUnique : Sorted LT axes} ->
1062 | {auto 0 axesInBounds : All (flip InBounds shape) axes} ->
1065 | reverse axes $
MkTensor x = t0 $
Reverse axes x
1067 | ewUnary : UnaryOp -> Tensor s a -> Tensor s a
1068 | ewUnary op $
MkTensor x = t0 $
UnaryElementwise op x
1070 | ewBinary : BinaryOp -> Tensor s a -> Tensor s a -> Tensor s a
1071 | ewBinary op (MkTensor x) (MkTensor x') = t0 $
BinaryElementwise op x x'
1073 | ewBinary' : {out : _} -> BinaryOp -> Tensor s a -> Tensor s a -> Tensor s out
1074 | ewBinary' op (MkTensor x) (MkTensor x') = t0 $
BinaryElementwise op x x'
1079 | (==) : Eq dtype => Tensor shape dtype -> Tensor shape dtype -> Tensor shape PRED
1080 | (==) = ewBinary' $
Compare Eq
1085 | (/=) : Eq dtype => Tensor shape dtype -> Tensor shape dtype -> Tensor shape PRED
1086 | (/=) = ewBinary' $
Compare Ne
1091 | (<) : Ord dtype => Tensor shape dtype -> Tensor shape dtype -> Tensor shape PRED
1092 | (<) = ewBinary' $
Compare Lt
1097 | (>) : Ord dtype => Tensor shape dtype -> Tensor shape dtype -> Tensor shape PRED
1098 | (>) = ewBinary' $
Compare Gt
1103 | (<=) : Ord dtype => Tensor shape dtype -> Tensor shape dtype -> Tensor shape PRED
1104 | (<=) = ewBinary' $
Compare Le
1109 | (>=) : Ord dtype => Tensor shape dtype -> Tensor shape dtype -> Tensor shape PRED
1110 | (>=) = ewBinary' $
Compare Ge
1116 | (&&) : Tensor shape PRED -> Tensor shape PRED -> Tensor shape PRED
1121 | [All] Semigroup (Tensor shape PRED) where
1126 | [All] {shape : _} -> Monoid (Tensor shape PRED) using Tensor.Semigroup.All where
1133 | (||) : Tensor shape PRED -> Tensor shape PRED -> Tensor shape PRED
1138 | [Any] Semigroup (Tensor shape PRED) where
1143 | [Any] {shape : _} -> Monoid (Tensor shape PRED) using Tensor.Semigroup.Any where
1149 | not : Tensor shape PRED -> Tensor shape PRED
1172 | (onTrue, onFalse : Tensor shape dtype) ->
1174 | select (MkTensor p) (MkTensor t) (MkTensor f) = t0 $
Select p t f
1195 | {shape : _} -> {dtype : _} ->
1197 | (onTrue, onFalse : Tag $
Tensor shape dtype) ->
1198 | Tag $
Tensor shape dtype
1199 | if_ (MkTensor pred) onTrue onFalse =
1200 | pure $
t0 $
If (TensorType shape dtype) pred !(mkFn1 [] [] onTrue) !(mkFn1 [] [] onFalse)
1214 | identity : {n : _} -> {dtype : _} -> Num dtype => Tensor [n, n] dtype
1216 | let MkTensor x = iota 0 {shape = [n, n], dtype = U64} == iota 1
1217 | in t0 $
Convert dtype [n, n] x
1227 | (@@) : Num dtype => Tensor [S m] dtype -> Tensor [S m] dtype -> Tensor [] dtype
1228 | (MkTensor x) @@ (MkTensor x') = t0 $
DotGeneral [] [] [0] [0] (TensorType [] dtype) x x'
1251 | Tensor [n, S m] dtype ->
1252 | Tensor (S m :: tl) dtype ->
1253 | {auto 0 vectorTail : length tl `LTE` 1} ->
1255 | (MkTensor x) @@ (MkTensor x') = t0 $
DotGeneral [] [] [1] [0] (TensorType (n :: tl) dtype) x x'
1259 | contract : (lBatch, rBatch, lContract, rContract : List Nat) ->
1261 | {auto 0 lInBoundsBatch : All (flip InBounds ls) lBatch} ->
1262 | {auto 0 rInBoundsBatch : All (flip InBounds rs) rBatch} ->
1263 | {auto 0 lInBoundsContract : All (flip InBounds ls) lContract} ->
1264 | {auto 0 rInBoundsContract : All (flip InBounds rs) rContract} ->
1266 | contract lBatch rBatch lContract rContract ls rs =
1267 | let lResultDims = deleteAt {inBounds = lInBoundsBatch ++ lInBoundsContract}
1268 | (lBatch ++ lContract) ls
1269 | rResultDims = deleteAt {inBounds = rInBoundsBatch ++ rInBoundsContract}
1270 | (rBatch ++ rContract) rs
1271 | in multiIndex lBatch ls ++ lResultDims ++ rResultDims
1301 | (lBatch, rBatch, lContract, rContract : List Nat) ->
1302 | {auto 0 lUnique : unique (lBatch ++ lContract) = True} ->
1303 | {auto 0 rUnique : unique (rBatch ++ rContract) = True} ->
1304 | {auto 0 lInBoundsBatch : All (flip InBounds ls) lBatch} ->
1305 | {auto 0 rInBoundsBatch : All (flip InBounds rs) rBatch} ->
1306 | {auto 0 lInBoundsContract : All (flip InBounds ls) lContract} ->
1307 | {auto 0 rInBoundsContract : All (flip InBounds rs) rContract} ->
1308 | {auto 0 batchDimsEq : multiIndex lBatch ls = multiIndex rBatch rs} ->
1309 | {auto 0 contractDimsEq : multiIndex lContract ls = multiIndex rContract rs} ->
1312 | Tensor (contract lBatch rBatch lContract rContract ls rs) dtype
1313 | dotGeneral lb rb lc rc (MkTensor x) (MkTensor y) =
1314 | let resultType = TensorType (contract lb rb lc rc ls rs) dtype
1315 | in t0 $
DotGeneral lb rb lc rc resultType x y
1320 | (+) : Num dtype => Tensor shape dtype -> Tensor shape dtype -> Tensor shape dtype
1325 | [Sum] Num dtype => Semigroup (Tensor shape dtype) where
1330 | [Sum] {shape : _} -> {dtype : _} -> Prelude.Num (idrisType dtype) => Num dtype =>
1331 | Monoid (Tensor shape dtype) using Semigroup.Sum where
1336 | negate : Neg dtype => Tensor shape dtype -> Tensor shape dtype
1337 | negate $
MkTensor i = t0 $
UnaryElementwise Neg i
1342 | (-) : Neg dtype => Tensor shape dtype -> Tensor shape dtype -> Tensor shape dtype
1348 | (*) : Num dtype => Tensor shape dtype -> Tensor shape dtype -> Tensor shape dtype
1357 | (*) : Num dtype => Tensor [] dtype -> Tensor (d :: ds) dtype -> Tensor (d :: ds) dtype
1359 | let MkTensor {shape = _ :: _} _ = r
1360 | in broadcast {shapesOK = scalarToAnyOk (d :: ds)} l * r
1364 | [Prod] Num dtype => Semigroup (Tensor shape dtype) where
1369 | [Prod] {shape : _} -> {dtype : _} -> Prelude.Num (idrisType dtype) => Num dtype =>
1370 | Monoid (Tensor shape dtype) using Semigroup.Prod where
1376 | (/) : Fractional dtype => Tensor shape dtype -> Tensor shape dtype -> Tensor shape dtype
1385 | (/) : Fractional dtype => Tensor (d :: ds) dtype -> Tensor [] dtype -> Tensor (d :: ds) dtype
1387 | let MkTensor {shape = _ :: _} _ = l
1388 | in l / broadcast {shapesOK = scalarToAnyOk (d :: ds)} r
1390 | inf = tensor 1.0 / tensor 0.0
1391 | nan = tensor 0.0 / tensor 0.0
1396 | div : Tensor shape U64 ->
1397 | (denom : Literal shape Nat) ->
1398 | {auto 0 isSucc : All IsSucc denom} ->
1401 | _ | (MkTensor {shape = _} _) = ewBinary Div x (tensor {dtype = U64} $
cast <$> y)
1407 | rem : Tensor shape U64 ->
1408 | (denom : Literal shape Nat) ->
1409 | {auto 0 isSucc : All IsSucc denom} ->
1412 | _ | (MkTensor {shape = _} _) = ewBinary Rem x (tensor {dtype = U64} $
cast <$> y)
1424 | (^) : Tensor shape F64 -> Tensor shape F64 -> Tensor shape F64
1427 | (>>) : Tensor shape U64 -> Tensor shape U64 -> Tensor shape U64
1428 | (>>) = ewBinary ShiftRightLogical
1432 | abs : Abs dtype => Tensor shape dtype -> Tensor shape dtype
1438 | exp : Tensor shape F64 -> Tensor shape F64
1445 | floor : Tensor shape F64 -> Tensor shape F64
1452 | ceil : Tensor shape F64 -> Tensor shape F64
1458 | log : Tensor shape F64 -> Tensor shape F64
1463 | logistic : Tensor shape F64 -> Tensor shape F64
1464 | logistic = ewUnary Logistic
1468 | sin : Tensor shape F64 -> Tensor shape F64
1473 | cos : Tensor shape F64 -> Tensor shape F64
1478 | tan : Tensor shape F64 -> Tensor shape F64
1483 | asin : Tensor shape F64 -> Tensor shape F64
1488 | acos : Tensor shape F64 -> Tensor shape F64
1493 | atan : Tensor shape F64 -> Tensor shape F64
1498 | sinh : Tensor shape F64 -> Tensor shape F64
1503 | cosh : Tensor shape F64 -> Tensor shape F64
1508 | tanh : Tensor shape F64 -> Tensor shape F64
1513 | asinh : Tensor shape F64 -> Tensor shape F64
1518 | acosh : Tensor shape F64 -> Tensor shape F64
1523 | atanh : Tensor shape F64 -> Tensor shape F64
1528 | erf : Tensor shape F64 -> Tensor shape F64
1531 | erfInv : Tensor shape F64 -> Tensor shape F64
1532 | erfInv = ewUnary ErfInv
1537 | square : Tensor shape F64 -> Tensor shape F64
1538 | square = ewUnary Square
1543 | sqrt : Tensor shape F64 -> Tensor shape F64
1549 | min : Ord dtype => Tensor shape dtype -> Tensor shape dtype -> Tensor shape dtype
1550 | min (MkTensor x) (MkTensor x') = t0 $
BinaryElementwise Min x x'
1554 | [Min] {shape : _} -> Ord dtype => Semigroup (Tensor shape dtype) where
1559 | [Min] {shape : _} -> {dtype : _} -> Ord dtype =>
1560 | Monoid (Tensor shape dtype) using Semigroup.Min where
1561 | neutral = broadcast max
1566 | max : Ord dtype => Tensor shape dtype -> Tensor shape dtype -> Tensor shape dtype
1567 | max (MkTensor x) (MkTensor x') = t0 $
BinaryElementwise Max x x'
1571 | [Max] Ord dtype => Semigroup (Tensor shape dtype) where
1576 | [Max] {shape : _} -> {dtype : _} -> Ord dtype =>
1577 | Monoid (Tensor shape dtype) using Semigroup.Max where
1578 | neutral = broadcast min
1589 | diag : Num dtype => Prelude.Num (idrisType dtype) => Tensor [n, n] dtype -> Tensor [n] dtype
1590 | diag {n = 0} x@(MkTensor {shape = [0, 0]} _) = reshape x
1591 | diag {n = S n} x@(MkTensor {shape = [S n, S n]} _) = (x * identity) @@ fill 1
1595 | (Tensor [] dtype -> Tensor [] dtype -> Tensor [] PRED) ->
1599 | argmxx cmp (MkTensor bound) x@(MkTensor {shape = _} _) = do
1600 | let MkTensor idxs : Tensor [S n] U64 = iota 0
1602 | MkTensor zero = tensor {dtype = U64} 0
1605 | Tensor [] dtype -> Tensor [] U64 ->
1606 | Tensor [] dtype -> Tensor [] U64 ->
1607 | Tag (Tensor [] dtype, Tensor [] U64)
1609 | let useNext = x == x && (cmp x' x || x' /= x')
1610 | in pure (select useNext x' x, select useNext y' y)
1616 | (MkTensor $
V 0 $
BoundSet addr)
1617 | (MkTensor $
V 1 $
BoundSet addr)
1618 | (MkTensor $
V 2 $
BoundSet addr)
1619 | (MkTensor $
V 3 $
BoundSet addr)
1620 | (env, (MkTensor m, MkTensor i)) = runState (emptyFrom !get) res
1621 | argTys = [TensorType [] dtype, TensorType [] U64]
1622 | f = MkFn addr (argTys ++ argTys) argTys [m, i] env
1625 | pure $
MkTensor $
V 1 $
Concrete $
Reduce f [bound, zero] [0] [x, idxs]
1631 | argmax : Ord dtype => Tensor [S n] dtype -> Tag $
Tensor [] U64
1632 | argmax x@(MkTensor {dtype} _) = argmxx (>) min x
1638 | argmin : Ord dtype => Tensor [S n] dtype -> Tag $
Tensor [] U64
1639 | argmin x@(MkTensor {dtype} _) = argmxx (<) max x
1643 | data Triangle = Upper | Lower
1662 | Prelude.Num (idrisType dtype) =>
1665 | Tag $
Tensor [n, n] dtype
1666 | triangle tri (MkTensor x) = do
1667 | let range : Tensor [n * n] U64 = iota 0
1668 | indices <- tag $
reshape {to = [n, n], sizesEqual = productSquare n} range
1672 | pure $
select (op indices indices.T) (fill $
fromInteger 0) (MkTensor x)
1676 | productSquare : (m : Nat) -> product (the Shape [m * m]) = product (the Shape [m, m])
1680 | ~~ m * m ... plusZeroRightNeutral (m * m)
1681 | ~~ (m + 0) * m ..< cong (* m) (plusZeroRightNeutral m)
1688 | cholesky : Tensor [S n, S n] F64 -> Tag $
Tensor [S n, S n] F64
1689 | cholesky $
MkTensor x = triangle Lower (t0 $
Cholesky x)
1702 | (|\) : Tensor [m, m] F64 -> Tensor [m, n] F64 -> Tensor [m, n] F64
1703 | (MkTensor a) |\ (MkTensor b) = t0 $
TriangularSolve a b True
1713 | (\|) : Tensor [m, m] F64 -> Tensor [m, n] F64 -> Tensor [m, n] F64
1714 | (MkTensor a) \| (MkTensor b) = t0 $
TriangularSolve a b False
1725 | (|\) : Tensor [m, m] F64 -> Tensor [m] F64 -> Tensor [m] F64
1726 | a |\ b = let (MkTensor {shape = [_]} _) = b in squeeze (a |\ expand 1 b)
1736 | (\|) : Tensor [m, m] F64 -> Tensor [m] F64 -> Tensor [m] F64
1737 | a \| b = let (MkTensor {shape = [_]} _) = b in squeeze (a \| expand 1 b)
1742 | trace : Num dtype => Prelude.Num (idrisType dtype) =>
1743 | Tensor [S n, S n] dtype ->
1746 | _ | MkTensor {shape = [_, _]} _ = reduce @{Sum} [0, 1] $
x * identity
1752 | Rand = StateT (Tensor [2] U64) Tag
1765 | rng : {shape : _} -> Rand $
Tensor shape U64
1766 | rng = ST $
\(MkTensor state) => do
1767 | res <- tag $
Concrete $
Rng state (TensorType shape U64)
1768 | pure (MkTensor $
V 0 res, MkTensor $
V 1 res)
1781 | uniform : {shape : _} -> Rand $
Tensor shape F64
1783 | let numMantissaBits : Bits64 = 52
1784 | scale = broadcast $
2.0 ^ tensor (Scalar $
- cast {to = Double} numMantissaBits)
1785 | shift = fill $
64 - numMantissaBits
1786 | in rng {shape} <&> \x => castDtype (x >> shift) * scale
1800 | normal : {shape : _} -> Rand $
Tensor shape F64
1801 | normal = uniform <&> \x => sqrt (broadcast 2.0) * erfInv (broadcast 2.0 * x - broadcast 1.0)