{-# LANGUAGE TupleSections #-}

module C.Trans ( writeC ) where

import           A
import           Bits
import           C
import           CF.AL                      (AL (..))
import qualified CF.AL                      as AL
import           Control.Composition        (thread)
import           Control.Monad              (zipWithM)
import           Control.Monad.State.Strict (State, gets, modify, runState, state)
import           Data.Bifunctor             (first, second)
import           Data.Functor               (($>))
import           Data.Int                   (Int64)
import qualified Data.IntMap                as IM
import qualified Data.IntSet                as IS
import           Data.List                  (scanl')
import           Data.Maybe                 (catMaybes, isJust)
import           Data.Word                  (Word64)
import           GHC.Float                  (castDoubleToWord64)
import           Nm
import           Nm.IntMap
import           Op

data CSt = CSt { CSt -> Int
tempU       :: !Int
               , CSt -> AL
arrU        :: !AL
               , CSt -> Int
assemblerSt :: !Int
               , CSt -> Label
label       :: !Label
               , CSt -> IntMap Temp
vars        :: IM.IntMap Temp -- track vars so that (Var x) can be replaced at the site
               , CSt -> IntMap BTemp
pvars       :: IM.IntMap BTemp
               , CSt -> IntMap FTemp
dvars       :: IM.IntMap FTemp
               , CSt -> IntMap (Maybe AL, Temp)
avars       :: IM.IntMap (Maybe AL, Temp)
               , CSt -> IntMap (Label, [Arg], Either FTemp Temp)
fvars       :: IM.IntMap (Label, [Arg], Either FTemp Temp)
               , CSt -> AsmData
_aa         :: AsmData
               , CSt -> IntMap Temp
mts         :: IM.IntMap Temp
               }

nextI :: CM Int
nextI :: CM Int
nextI = (CSt -> (Int, CSt)) -> CM Int
forall a. (CSt -> (a, CSt)) -> StateT CSt Identity a
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state (\(CSt Int
tϵ AL
ar Int
as Label
l IntMap Temp
v IntMap BTemp
b IntMap FTemp
d IntMap (Maybe AL, Temp)
a IntMap (Label, [Arg], Either FTemp Temp)
f AsmData
aas IntMap Temp
ts) -> (Int
tϵ, Int
-> AL
-> Int
-> Label
-> IntMap Temp
-> IntMap BTemp
-> IntMap FTemp
-> IntMap (Maybe AL, Temp)
-> IntMap (Label, [Arg], Either FTemp Temp)
-> AsmData
-> IntMap Temp
-> CSt
CSt (Int
tϵInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) AL
ar Int
as Label
l IntMap Temp
v IntMap BTemp
b IntMap FTemp
d IntMap (Maybe AL, Temp)
a IntMap (Label, [Arg], Either FTemp Temp)
f AsmData
aas IntMap Temp
ts))

nextArr :: Temp -> CM AL
nextArr :: Temp -> CM AL
nextArr Temp
r = (CSt -> (AL, CSt)) -> CM AL
forall a. (CSt -> (a, CSt)) -> StateT CSt Identity a
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state (\(CSt Int
t a :: AL
a@(AL Int
i) Int
as Label
l IntMap Temp
v IntMap BTemp
b IntMap FTemp
d IntMap (Maybe AL, Temp)
aϵ IntMap (Label, [Arg], Either FTemp Temp)
f AsmData
aas IntMap Temp
ts) -> (AL
a, Int
-> AL
-> Int
-> Label
-> IntMap Temp
-> IntMap BTemp
-> IntMap FTemp
-> IntMap (Maybe AL, Temp)
-> IntMap (Label, [Arg], Either FTemp Temp)
-> AsmData
-> IntMap Temp
-> CSt
CSt Int
t (Int -> AL
AL(Int -> AL) -> Int -> AL
forall a b. (a -> b) -> a -> b
$Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
as Label
l IntMap Temp
v IntMap BTemp
b IntMap FTemp
d IntMap (Maybe AL, Temp)
aϵ IntMap (Label, [Arg], Either FTemp Temp)
f AsmData
aas (AL -> Temp -> IntMap Temp -> IntMap Temp
forall {a}. AL -> a -> IntMap a -> IntMap a
AL.insert AL
a Temp
r IntMap Temp
ts)))

nextAA :: CM Int
nextAA :: CM Int
nextAA = (CSt -> (Int, CSt)) -> CM Int
forall a. (CSt -> (a, CSt)) -> StateT CSt Identity a
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state (\(CSt Int
t AL
ar Int
as Label
l IntMap Temp
v IntMap BTemp
b IntMap FTemp
d IntMap (Maybe AL, Temp)
a IntMap (Label, [Arg], Either FTemp Temp)
f AsmData
aas IntMap Temp
ts) -> (Int
as, Int
-> AL
-> Int
-> Label
-> IntMap Temp
-> IntMap BTemp
-> IntMap FTemp
-> IntMap (Maybe AL, Temp)
-> IntMap (Label, [Arg], Either FTemp Temp)
-> AsmData
-> IntMap Temp
-> CSt
CSt Int
t AL
ar (Int
asInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Label
l IntMap Temp
v IntMap BTemp
b IntMap FTemp
d IntMap (Maybe AL, Temp)
a IntMap (Label, [Arg], Either FTemp Temp)
f AsmData
aas IntMap Temp
ts))

neL :: CM Label
neL :: CM Label
neL = (CSt -> (Label, CSt)) -> CM Label
forall a. (CSt -> (a, CSt)) -> StateT CSt Identity a
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state (\(CSt Int
t AL
ar Int
as Label
l IntMap Temp
v IntMap BTemp
b IntMap FTemp
d IntMap (Maybe AL, Temp)
a IntMap (Label, [Arg], Either FTemp Temp)
f AsmData
aas IntMap Temp
ts) -> (Label
l, Int
-> AL
-> Int
-> Label
-> IntMap Temp
-> IntMap BTemp
-> IntMap FTemp
-> IntMap (Maybe AL, Temp)
-> IntMap (Label, [Arg], Either FTemp Temp)
-> AsmData
-> IntMap Temp
-> CSt
CSt Int
t AL
ar Int
as (Label
lLabel -> Label -> Label
forall a. Num a => a -> a -> a
+Label
1) IntMap Temp
v IntMap BTemp
b IntMap FTemp
d IntMap (Maybe AL, Temp)
a IntMap (Label, [Arg], Either FTemp Temp)
f AsmData
aas IntMap Temp
ts))

nBT :: CM BTemp
nBT :: CM BTemp
nBT = Int -> BTemp
BTemp(Int -> BTemp) -> CM Int -> CM BTemp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>CM Int
nextI

newITemp :: CM Temp
newITemp :: CM Temp
newITemp = Int -> Temp
ITemp (Int -> Temp) -> CM Int -> CM Temp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CM Int
nextI

newFTemp :: CM FTemp
newFTemp :: CM FTemp
newFTemp = Int -> FTemp
FTemp (Int -> FTemp) -> CM Int -> CM FTemp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CM Int
nextI

addAA :: Int -> [Word64] -> CSt -> CSt
addAA :: Int -> [Word64] -> CSt -> CSt
addAA Int
i [Word64]
aa (CSt Int
t AL
ar Int
as Label
l IntMap Temp
v IntMap BTemp
b IntMap FTemp
d IntMap (Maybe AL, Temp)
a IntMap (Label, [Arg], Either FTemp Temp)
f AsmData
aas IntMap Temp
ts) = Int
-> AL
-> Int
-> Label
-> IntMap Temp
-> IntMap BTemp
-> IntMap FTemp
-> IntMap (Maybe AL, Temp)
-> IntMap (Label, [Arg], Either FTemp Temp)
-> AsmData
-> IntMap Temp
-> CSt
CSt Int
t AL
ar Int
as Label
l IntMap Temp
v IntMap BTemp
b IntMap FTemp
d IntMap (Maybe AL, Temp)
a IntMap (Label, [Arg], Either FTemp Temp)
f (Int -> [Word64] -> AsmData -> AsmData
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
i [Word64]
aa AsmData
aas) IntMap Temp
ts

addVar :: Nm a -> Temp -> CSt -> CSt
addVar :: forall a. Nm a -> Temp -> CSt -> CSt
addVar Nm a
n Temp
r (CSt Int
t AL
ar Int
as Label
l IntMap Temp
v IntMap BTemp
b IntMap FTemp
d IntMap (Maybe AL, Temp)
a IntMap (Label, [Arg], Either FTemp Temp)
f AsmData
aas IntMap Temp
ts) = Int
-> AL
-> Int
-> Label
-> IntMap Temp
-> IntMap BTemp
-> IntMap FTemp
-> IntMap (Maybe AL, Temp)
-> IntMap (Label, [Arg], Either FTemp Temp)
-> AsmData
-> IntMap Temp
-> CSt
CSt Int
t AL
ar Int
as Label
l (Nm a -> Temp -> IntMap Temp -> IntMap Temp
forall a b. Nm a -> b -> IntMap b -> IntMap b
insert Nm a
n Temp
r IntMap Temp
v) IntMap BTemp
b IntMap FTemp
d IntMap (Maybe AL, Temp)
a IntMap (Label, [Arg], Either FTemp Temp)
f AsmData
aas IntMap Temp
ts

addD :: Nm a -> FTemp -> CSt -> CSt
addD :: forall a. Nm a -> FTemp -> CSt -> CSt
addD Nm a
n FTemp
r (CSt Int
t AL
ar Int
as Label
l IntMap Temp
v IntMap BTemp
b IntMap FTemp
d IntMap (Maybe AL, Temp)
a IntMap (Label, [Arg], Either FTemp Temp)
f AsmData
aas IntMap Temp
ts) = Int
-> AL
-> Int
-> Label
-> IntMap Temp
-> IntMap BTemp
-> IntMap FTemp
-> IntMap (Maybe AL, Temp)
-> IntMap (Label, [Arg], Either FTemp Temp)
-> AsmData
-> IntMap Temp
-> CSt
CSt Int
t AL
ar Int
as Label
l IntMap Temp
v IntMap BTemp
b (Nm a -> FTemp -> IntMap FTemp -> IntMap FTemp
forall a b. Nm a -> b -> IntMap b -> IntMap b
insert Nm a
n FTemp
r IntMap FTemp
d) IntMap (Maybe AL, Temp)
a IntMap (Label, [Arg], Either FTemp Temp)
f AsmData
aas IntMap Temp
ts

addB :: Nm a -> BTemp -> CSt -> CSt
addB :: forall a. Nm a -> BTemp -> CSt -> CSt
addB Nm a
n BTemp
r (CSt Int
t AL
ar Int
as Label
l IntMap Temp
v IntMap BTemp
b IntMap FTemp
d IntMap (Maybe AL, Temp)
a IntMap (Label, [Arg], Either FTemp Temp)
f AsmData
aas IntMap Temp
ts) = Int
-> AL
-> Int
-> Label
-> IntMap Temp
-> IntMap BTemp
-> IntMap FTemp
-> IntMap (Maybe AL, Temp)
-> IntMap (Label, [Arg], Either FTemp Temp)
-> AsmData
-> IntMap Temp
-> CSt
CSt Int
t AL
ar Int
as Label
l IntMap Temp
v (Nm a -> BTemp -> IntMap BTemp -> IntMap BTemp
forall a b. Nm a -> b -> IntMap b -> IntMap b
insert Nm a
n BTemp
r IntMap BTemp
b) IntMap FTemp
d IntMap (Maybe AL, Temp)
a IntMap (Label, [Arg], Either FTemp Temp)
f AsmData
aas IntMap Temp
ts

addAVar :: Nm a -> (Maybe AL, Temp) -> CSt -> CSt
addAVar :: forall a. Nm a -> (Maybe AL, Temp) -> CSt -> CSt
addAVar Nm a
n (Maybe AL, Temp)
r (CSt Int
t AL
ar Int
as Label
l IntMap Temp
v IntMap BTemp
b IntMap FTemp
d IntMap (Maybe AL, Temp)
a IntMap (Label, [Arg], Either FTemp Temp)
f AsmData
aas IntMap Temp
ts) = Int
-> AL
-> Int
-> Label
-> IntMap Temp
-> IntMap BTemp
-> IntMap FTemp
-> IntMap (Maybe AL, Temp)
-> IntMap (Label, [Arg], Either FTemp Temp)
-> AsmData
-> IntMap Temp
-> CSt
CSt Int
t AL
ar Int
as Label
l IntMap Temp
v IntMap BTemp
b IntMap FTemp
d (Nm a
-> (Maybe AL, Temp)
-> IntMap (Maybe AL, Temp)
-> IntMap (Maybe AL, Temp)
forall a b. Nm a -> b -> IntMap b -> IntMap b
insert Nm a
n (Maybe AL, Temp)
r IntMap (Maybe AL, Temp)
a) IntMap (Label, [Arg], Either FTemp Temp)
f AsmData
aas IntMap Temp
ts

addF :: Nm a -> (Label, [Arg], Either FTemp Temp) -> CSt -> CSt
addF :: forall a. Nm a -> (Label, [Arg], Either FTemp Temp) -> CSt -> CSt
addF Nm a
n (Label, [Arg], Either FTemp Temp)
f (CSt Int
t AL
ar Int
as Label
l IntMap Temp
v IntMap BTemp
b IntMap FTemp
d IntMap (Maybe AL, Temp)
a IntMap (Label, [Arg], Either FTemp Temp)
fs AsmData
aas IntMap Temp
ts) = Int
-> AL
-> Int
-> Label
-> IntMap Temp
-> IntMap BTemp
-> IntMap FTemp
-> IntMap (Maybe AL, Temp)
-> IntMap (Label, [Arg], Either FTemp Temp)
-> AsmData
-> IntMap Temp
-> CSt
CSt Int
t AL
ar Int
as Label
l IntMap Temp
v IntMap BTemp
b IntMap FTemp
d IntMap (Maybe AL, Temp)
a (Nm a
-> (Label, [Arg], Either FTemp Temp)
-> IntMap (Label, [Arg], Either FTemp Temp)
-> IntMap (Label, [Arg], Either FTemp Temp)
forall a b. Nm a -> b -> IntMap b -> IntMap b
insert Nm a
n (Label, [Arg], Either FTemp Temp)
f IntMap (Label, [Arg], Either FTemp Temp)
fs) AsmData
aas IntMap Temp
ts

getT :: IM.IntMap b -> Nm a -> b
getT :: forall b a. IntMap b -> Nm a -> b
getT IntMap b
st Nm a
n = b -> Nm a -> IntMap b -> b
forall {a1} {a2}. a1 -> Nm a2 -> IntMap a1 -> a1
findWithDefault ([Char] -> b
forall a. HasCallStack => [Char] -> a
error ([Char]
"Internal error: variable " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Nm a -> [Char]
forall a. Show a => a -> [Char]
show Nm a
n [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" not assigned to a temp.")) Nm a
n IntMap b
st

type CM = State CSt

infix 9 +=
+= :: Temp -> CE -> CS ()
(+=) Temp
t CE
i = Temp
t Temp -> CE -> CS ()
=: (Temp -> CE
Tmp Temp
tCE -> CE -> CE
forall a. Num a => a -> a -> a
+CE
i)

fop :: Builtin -> E (T a) -> E (T a) -> E (T a)
fop Builtin
op E (T a)
e0 = T a -> E (T a) -> E (T a) -> E (T a)
forall a. a -> E a -> E a -> E a
EApp T a
forall a. T a
F (T a -> E (T a) -> E (T a) -> E (T a)
forall a. a -> E a -> E a -> E a
EApp (T a
forall a. T a
F T a -> T a -> T a
forall {a}. T a -> T a -> T a
~> T a
forall a. T a
F) (T a -> Builtin -> E (T a)
forall a. a -> Builtin -> E a
Builtin (T a
forall a. T a
F T a -> T a -> T a
forall {a}. T a -> T a -> T a
~> T a
forall a. T a
F T a -> T a -> T a
forall {a}. T a -> T a -> T a
~> T a
forall a. T a
F) Builtin
op) E (T a)
e0)
eMinus :: E (T a) -> E (T a) -> E (T a)
eMinus = Builtin -> E (T a) -> E (T a) -> E (T a)
forall {a}. Builtin -> E (T a) -> E (T a) -> E (T a)
fop Builtin
Minus
eDiv :: E (T a) -> E (T a) -> E (T a)
eDiv = Builtin -> E (T a) -> E (T a) -> E (T a)
forall {a}. Builtin -> E (T a) -> E (T a) -> E (T a)
fop Builtin
Div

isF, isI, isB, isIF :: T a -> Bool
isF :: forall a. T a -> Bool
isF T a
F = Bool
True; isF T a
_ = Bool
False
isI :: forall a. T a -> Bool
isI T a
I = Bool
True; isI T a
_ = Bool
False
isB :: forall a. T a -> Bool
isB T a
B = Bool
True; isB T a
_ = Bool
False
isArr :: T a -> Bool
isArr Arr{}=Bool
True; isArr T a
_=Bool
False
isIF :: forall a. T a -> Bool
isIF T a
I=Bool
True; isIF T a
F=Bool
True; isIF T a
_=Bool
False
isR :: T a -> Bool
isR T a
B=Bool
True; isR T a
t=T a -> Bool
forall a. T a -> Bool
isIF T a
t
nind :: T a -> Bool
nind T a
I=Bool
True; nind T a
F=Bool
True; nind P{}=Bool
True; nind B{}=Bool
True; nind T a
_=Bool
False
isΠR :: T a -> Bool
isΠR (P [T a]
ts)=(T a -> Bool) -> [T a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all T a -> Bool
forall a. T a -> Bool
isR [T a]
ts; isΠR T a
_=Bool
False
isΠ :: T a -> Bool
isΠ P{}=Bool
True; isΠ T a
_=Bool
False

rel :: Builtin -> Maybe IRel
rel :: Builtin -> Maybe IRel
rel Builtin
Eq=IRel -> Maybe IRel
forall a. a -> Maybe a
Just IRel
IEq; rel Builtin
Neq=IRel -> Maybe IRel
forall a. a -> Maybe a
Just IRel
INeq; rel Builtin
Lt=IRel -> Maybe IRel
forall a. a -> Maybe a
Just IRel
ILt; rel Builtin
Gt=IRel -> Maybe IRel
forall a. a -> Maybe a
Just IRel
IGt; rel Builtin
Lte=IRel -> Maybe IRel
forall a. a -> Maybe a
Just IRel
ILeq; rel Builtin
Gte=IRel -> Maybe IRel
forall a. a -> Maybe a
Just IRel
IGeq; rel Builtin
_=Maybe IRel
forall a. Maybe a
Nothing

mIF :: T a -> Maybe (T a)
mIF :: forall a. T a -> Maybe (T a)
mIF (Arr Sh a
_ T a
F)=T a -> Maybe (T a)
forall a. a -> Maybe a
Just T a
forall a. T a
F; mIF (Arr Sh a
_ T a
I)=T a -> Maybe (T a)
forall a. a -> Maybe a
Just T a
forall a. T a
I; mIF T a
_=Maybe (T a)
forall a. Maybe a
Nothing

mAA :: T a -> Maybe ((T a, Int64), (T a, Int64))
mAA :: forall a. T a -> Maybe ((T a, Int64), (T a, Int64))
mAA (Arrow T a
t0 T a
t1) = (,) ((T a, Int64) -> (T a, Int64) -> ((T a, Int64), (T a, Int64)))
-> Maybe (T a, Int64)
-> Maybe ((T a, Int64) -> ((T a, Int64), (T a, Int64)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> T a -> Maybe (T a, Int64)
forall a. T a -> Maybe (T a, Int64)
tRnk T a
t0 Maybe ((T a, Int64) -> ((T a, Int64), (T a, Int64)))
-> Maybe (T a, Int64) -> Maybe ((T a, Int64), (T a, Int64))
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> T a -> Maybe (T a, Int64)
forall a. T a -> Maybe (T a, Int64)
tRnk T a
t1
mAA T a
_             = Maybe ((T a, Int64), (T a, Int64))
forall a. Maybe a
Nothing

f1 :: T a -> Bool
f1 :: forall a. T a -> Bool
f1 (Arr (I a
_ `Cons` Sh a
Nil) T a
F) = Bool
True; f1 T a
_ = Bool
False

bT :: Integral b => T a -> b
bT :: forall b a. Integral b => T a -> b
bT (P [T a]
ts)=[b] -> b
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (T a -> b
forall b a. Integral b => T a -> b
bT(T a -> b) -> [T a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>[T a]
ts); bT T a
F=b
8; bT T a
I=b
8; bT T a
B=b
1; bT Arr{}=b
8

bSz, rSz, nSz :: Integral b => T a -> Maybe b
bSz :: forall b a. Integral b => T a -> Maybe b
bSz (P [T a]
ts)=[b] -> b
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum([b] -> b) -> Maybe [b] -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>(T a -> Maybe b) -> [T a] -> Maybe [b]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse T a -> Maybe b
forall b a. Integral b => T a -> Maybe b
bSz [T a]
ts; bSz T a
F=b -> Maybe b
forall a. a -> Maybe a
Just b
8; bSz T a
I=b -> Maybe b
forall a. a -> Maybe a
Just b
8; bSz T a
B=b -> Maybe b
forall a. a -> Maybe a
Just b
1; bSz T a
_=Maybe b
forall a. Maybe a
Nothing
rSz :: forall b a. Integral b => T a -> Maybe b
rSz T a
F=b -> Maybe b
forall a. a -> Maybe a
Just b
8; rSz T a
I=b -> Maybe b
forall a. a -> Maybe a
Just b
8; rSz T a
B=b -> Maybe b
forall a. a -> Maybe a
Just b
1; rSz T a
_=Maybe b
forall a. Maybe a
Nothing
nSz :: forall b a. Integral b => T a -> Maybe b
nSz T a
F=b -> Maybe b
forall a. a -> Maybe a
Just b
8; nSz T a
I=b -> Maybe b
forall a. a -> Maybe a
Just b
8; nSz T a
B=b -> Maybe b
forall a. a -> Maybe a
Just b
1; nSz (P [T a]
ts)=[b] -> b
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum([b] -> b) -> Maybe [b] -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>(T a -> Maybe b) -> [T a] -> Maybe [b]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse T a -> Maybe b
forall b a. Integral b => T a -> Maybe b
nSz [T a]
ts; nSz T a
_=Maybe b
forall a. Maybe a
Nothing

aB :: Integral b => T a -> Maybe b
aB :: forall b a. Integral b => T a -> Maybe b
aB (Arr (I a
_ `Cons` Sh a
Nil) T a
t) = T a -> Maybe b
forall b a. Integral b => T a -> Maybe b
nSz T a
t; aB T a
_ = Maybe b
forall a. Maybe a
Nothing
aRr :: T a -> Maybe (T a, b)
aRr (Arr (I a
_ `Cons` Sh a
Nil) T a
t) = T a -> Maybe (T a, b)
forall b a. Integral b => T a -> Maybe (T a, b)
rr T a
t; aRr T a
_ = Maybe (T a, b)
forall a. Maybe a
Nothing

rr :: Integral b => T a -> Maybe (T a, b)
rr :: forall b a. Integral b => T a -> Maybe (T a, b)
rr T a
I=(T a, b) -> Maybe (T a, b)
forall a. a -> Maybe a
Just (T a
forall a. T a
I,b
8); rr T a
F=(T a, b) -> Maybe (T a, b)
forall a. a -> Maybe a
Just (T a
forall a. T a
F,b
8); rr T a
B=(T a, b) -> Maybe (T a, b)
forall a. a -> Maybe a
Just (T a
forall a. T a
B,b
1); rr T a
_=Maybe (T a, b)
forall a. Maybe a
Nothing

szT :: [T a] -> [Int64]
szT = (Int64 -> T a -> Int64) -> Int64 -> [T a] -> [Int64]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl' (\Int64
off T a
ty -> Int64
offInt64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+T a -> Int64
forall b a. Integral b => T a -> b
bT T a
ty::Int64) Int64
0

staRnk :: Integral b => Sh a -> Maybe b
staRnk :: forall b a. Integral b => Sh a -> Maybe b
staRnk Sh a
Nil           = b -> Maybe b
forall a. a -> Maybe a
Just b
0
staRnk (I a
_ `Cons` Sh a
sh) = (b
1b -> b -> b
forall a. Num a => a -> a -> a
+) (b -> b) -> Maybe b -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sh a -> Maybe b
forall b a. Integral b => Sh a -> Maybe b
staRnk Sh a
sh
staRnk Sh a
_             = Maybe b
forall a. Maybe a
Nothing

eRnk :: Sh a -> (Temp, Maybe AL) -> CE
eRnk :: forall a. Sh a -> (Temp, Maybe AL) -> CE
eRnk Sh a
sh (Temp
xR, Maybe AL
lX) | Just Int64
i <- Sh a -> Maybe Int64
forall b a. Integral b => Sh a -> Maybe b
staRnk Sh a
sh = Int64 -> CE
ConstI Int64
i
                 | Bool
otherwise = ArrAcc -> CE
EAt (Temp -> Maybe AL -> ArrAcc
ARnk Temp
xR Maybe AL
lX)

ev :: T a -> (Temp, Maybe AL) -> CE
ev :: forall a. T a -> (Temp, Maybe AL) -> CE
ev (Arr (Ix a
_ Int
i `Cons` Sh a
_) T a
_) (Temp, Maybe AL)
_ = Int64 -> CE
ConstI(Int64 -> CE) -> Int64 -> CE
forall a b. (a -> b) -> a -> b
$Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i
ev T a
_ (Temp
xR, Maybe AL
lX)                  = ArrAcc -> CE
EAt (Temp -> CE -> Maybe AL -> ArrAcc
ADim Temp
xR CE
0 Maybe AL
lX)

ec :: T a -> (Temp, Maybe AL) -> CE
ec :: forall a. T a -> (Temp, Maybe AL) -> CE
ec (Arr (I a
_ `Cons` Ix a
_ Int
j `Cons` Sh a
_) T a
_) (Temp, Maybe AL)
_ = Int64 -> CE
ConstI(Int64 -> CE) -> Int64 -> CE
forall a b. (a -> b) -> a -> b
$Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
j
ec T a
_ (Temp
xR, Maybe AL
lX)                           = ArrAcc -> CE
EAt (Temp -> CE -> Maybe AL -> ArrAcc
ADim Temp
xR CE
1 Maybe AL
lX)

tRnk :: T a -> Maybe (T a, Int64)
tRnk :: forall a. T a -> Maybe (T a, Int64)
tRnk (Arr Sh a
sh T a
t) = (T a
t,) (Int64 -> (T a, Int64)) -> Maybe Int64 -> Maybe (T a, Int64)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sh a -> Maybe Int64
forall b a. Integral b => Sh a -> Maybe b
staRnk Sh a
sh
tRnk T a
_          = Maybe (T a, Int64)
forall a. Maybe a
Nothing

staIx :: Sh a -> Maybe [Int64]
staIx :: forall a. Sh a -> Maybe [Int64]
staIx Sh a
Nil=[Int64] -> Maybe [Int64]
forall a. a -> Maybe a
Just[]; staIx (Ix a
_ Int
i `Cons` Sh a
s) = (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
iInt64 -> [Int64] -> [Int64]
forall a. a -> [a] -> [a]
:)([Int64] -> [Int64]) -> Maybe [Int64] -> Maybe [Int64]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>Sh a -> Maybe [Int64]
forall a. Sh a -> Maybe [Int64]
staIx Sh a
s; staIx Sh a
_=Maybe [Int64]
forall a. Maybe a
Nothing

tIx :: T a -> Maybe (T a, [Int64])
tIx :: forall a. T a -> Maybe (T a, [Int64])
tIx (Arr Sh a
sh T a
t) = (T a
t,)([Int64] -> (T a, [Int64]))
-> Maybe [Int64] -> Maybe (T a, [Int64])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>Sh a -> Maybe [Int64]
forall a. Sh a -> Maybe [Int64]
staIx Sh a
sh; tIx T a
_=Maybe (T a, [Int64])
forall a. Maybe a
Nothing

nz, ni1 :: I a -> Bool
nz :: forall a. I a -> Bool
nz (Ix a
_ Int
i) | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = Bool
True
nz (StaPlus a
_ I a
i0 I a
i1) = I a -> Bool
forall a. I a -> Bool
nz I a
i0 Bool -> Bool -> Bool
|| I a -> Bool
forall a. I a -> Bool
nz I a
i1 -- no negative dims
nz (StaMul a
_ I a
i0 I a
i1) = I a -> Bool
forall a. I a -> Bool
nz I a
i0 Bool -> Bool -> Bool
&& I a -> Bool
forall a. I a -> Bool
nz I a
i1
nz I a
_ = Bool
False

nzSh :: Sh a -> Bool
nzSh :: forall a. Sh a -> Bool
nzSh (I a
i `Cons` Sh a
Nil) = I a -> Bool
forall a. I a -> Bool
nz I a
i
nzSh (I a
i `Cons` Sh a
sh)  = I a -> Bool
forall a. I a -> Bool
nz I a
i Bool -> Bool -> Bool
&& Sh a -> Bool
forall a. Sh a -> Bool
nzSh Sh a
sh
nzSh Sh a
_              = Bool
False

ni1 :: forall a. I a -> Bool
ni1 (Ix a
_ Int
i) | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 = Bool
True
ni1 (StaPlus a
_ I a
i0 I a
i1) = I a -> Bool
forall a. I a -> Bool
ni1 I a
i0 Bool -> Bool -> Bool
|| I a -> Bool
forall a. I a -> Bool
ni1 I a
i1
ni1 (StaMul a
_ I a
i0 I a
i1) = (I a -> Bool
forall a. I a -> Bool
nz I a
i0Bool -> Bool -> Bool
&&I a -> Bool
forall a. I a -> Bool
ni1 I a
i1) Bool -> Bool -> Bool
|| (I a -> Bool
forall a. I a -> Bool
nz I a
i1Bool -> Bool -> Bool
&&I a -> Bool
forall a. I a -> Bool
ni1 I a
i0)
ni1 I a
_ = Bool
False

ne, n1 :: T a -> Bool
ne :: forall a. T a -> Bool
ne (Arr (I a
i `Cons` Sh a
_) T a
_) = I a -> Bool
forall a. I a -> Bool
nz I a
i; ne T a
_=Bool
False
n1 :: forall a. T a -> Bool
n1 (Arr (I a
i `Cons` Sh a
_) T a
_) = I a -> Bool
forall a. I a -> Bool
ni1 I a
i; n1 T a
_=Bool
False
nec :: T a -> Bool
nec (Arr (I a
_ `Cons` I a
i `Cons` Sh a
_) T a
_) = I a -> Bool
forall a. I a -> Bool
nz I a
i; nec T a
_=Bool
False

nee :: T a -> Bool
nee :: forall a. T a -> Bool
nee (Arr Sh a
sh T a
_) = Sh a -> Bool
forall a. Sh a -> Bool
nzSh Sh a
sh; nee T a
_=Bool
False

for :: T a -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
for T a
t = if T a -> Bool
forall a. T a -> Bool
ne T a
t then () -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
forall a. a -> Temp -> CE -> IRel -> CE -> [CS a] -> CS a
For1 () else () -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
forall a. a -> Temp -> CE -> IRel -> CE -> [CS a] -> CS a
For (); for1 :: T a -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
for1 T a
t = if T a -> Bool
forall a. T a -> Bool
n1 T a
t then () -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
forall a. a -> Temp -> CE -> IRel -> CE -> [CS a] -> CS a
For1 () else () -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
forall a. a -> Temp -> CE -> IRel -> CE -> [CS a] -> CS a
For ()
forc :: T a -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
forc T a
t = if T a -> Bool
forall a. T a -> Bool
nec T a
t then () -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
forall a. a -> Temp -> CE -> IRel -> CE -> [CS a] -> CS a
For1 () else () -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
forall a. a -> Temp -> CE -> IRel -> CE -> [CS a] -> CS a
For ()
fors :: T a -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
fors T a
t = if T a -> Bool
forall a. T a -> Bool
nee T a
t then () -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
forall a. a -> Temp -> CE -> IRel -> CE -> [CS a] -> CS a
For1 () else () -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
forall a. a -> Temp -> CE -> IRel -> CE -> [CS a] -> CS a
For ()

staR :: Sh a -> [Int64]
staR :: forall a. Sh a -> [Int64]
staR Sh a
Nil = []; staR (Ix a
_ Int
i `Cons` Sh a
s) = Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
iInt64 -> [Int64] -> [Int64]
forall a. a -> [a] -> [a]
:Sh a -> [Int64]
forall a. Sh a -> [Int64]
staR Sh a
s

tRnd :: T a -> (T a, [Int64])
tRnd :: forall a. T a -> (T a, [Int64])
tRnd (Arr Sh a
sh T a
t) = (T a
t, Sh a -> [Int64]
forall a. Sh a -> [Int64]
staR Sh a
sh)

mIFs :: [E a] -> Maybe [Word64]
mIFs :: forall a. [E a] -> Maybe [Word64]
mIFs = ([[Word64]] -> [Word64]) -> Maybe [[Word64]] -> Maybe [Word64]
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[Word64]] -> [Word64]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat(Maybe [[Word64]] -> Maybe [Word64])
-> ([E a] -> Maybe [[Word64]]) -> [E a] -> Maybe [Word64]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(E a -> Maybe [Word64]) -> [E a] -> Maybe [[Word64]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse E a -> Maybe [Word64]
forall {a}. E a -> Maybe [Word64]
mIFϵ where mIFϵ :: E a -> Maybe [Word64]
mIFϵ (FLit a
_ Double
d)=[Word64] -> Maybe [Word64]
forall a. a -> Maybe a
Just [Double -> Word64
castDoubleToWord64 Double
d]; mIFϵ (ILit a
_ Integer
n)=[Word64] -> Maybe [Word64]
forall a. a -> Maybe a
Just [Integer -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n]; mIFϵ (Tup a
_ [E a]
xs)=[E a] -> Maybe [Word64]
forall a. [E a] -> Maybe [Word64]
mIFs [E a]
xs; mIFϵ E a
_=Maybe [Word64]
forall a. Maybe a
Nothing

writeC :: E (T ()) -> ([CS ()], LSt, AsmData, IM.IntMap Temp)
writeC :: E (T ()) -> ([CS ()], LSt, AsmData, IntMap Temp)
writeC = ([CS ()], CSt) -> ([CS ()], LSt, AsmData, IntMap Temp)
forall {a}. (a, CSt) -> (a, LSt, AsmData, IntMap Temp)
π(([CS ()], CSt) -> ([CS ()], LSt, AsmData, IntMap Temp))
-> (E (T ()) -> ([CS ()], CSt))
-> E (T ())
-> ([CS ()], LSt, AsmData, IntMap Temp)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(State CSt [CS ()] -> CSt -> ([CS ()], CSt))
-> CSt -> State CSt [CS ()] -> ([CS ()], CSt)
forall a b c. (a -> b -> c) -> b -> a -> c
flip State CSt [CS ()] -> CSt -> ([CS ()], CSt)
forall s a. State s a -> s -> (a, s)
runState (Int
-> AL
-> Int
-> Label
-> IntMap Temp
-> IntMap BTemp
-> IntMap FTemp
-> IntMap (Maybe AL, Temp)
-> IntMap (Label, [Arg], Either FTemp Temp)
-> AsmData
-> IntMap Temp
-> CSt
CSt Int
0 (Int -> AL
AL Int
0) Int
0 Label
0 IntMap Temp
forall a. IntMap a
IM.empty IntMap BTemp
forall a. IntMap a
IM.empty IntMap FTemp
forall a. IntMap a
IM.empty IntMap (Maybe AL, Temp)
forall a. IntMap a
IM.empty IntMap (Label, [Arg], Either FTemp Temp)
forall a. IntMap a
IM.empty AsmData
forall a. IntMap a
IM.empty IntMap Temp
forall a. IntMap a
IM.empty) (State CSt [CS ()] -> ([CS ()], CSt))
-> (E (T ()) -> State CSt [CS ()]) -> E (T ()) -> ([CS ()], CSt)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. E (T ()) -> State CSt [CS ()]
writeCM (E (T ()) -> State CSt [CS ()])
-> (E (T ()) -> E (T ())) -> E (T ()) -> State CSt [CS ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (T () -> T ()) -> E (T ()) -> E (T ())
forall a b. (a -> b) -> E a -> E b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap T () -> T ()
forall a. T a -> T a
rLi where π :: (a, CSt) -> (a, LSt, AsmData, IntMap Temp)
π (a
s, CSt Int
t AL
_ Int
_ Label
l IntMap Temp
_ IntMap BTemp
_ IntMap FTemp
_ IntMap (Maybe AL, Temp)
_ IntMap (Label, [Arg], Either FTemp Temp)
_ AsmData
aa IntMap Temp
a) = (a
s, Label -> Int -> LSt
LSt Label
l Int
t, AsmData
aa, IntMap Temp
a)

writeCM :: E (T ()) -> CM [CS ()]
writeCM :: E (T ()) -> State CSt [CS ()]
writeCM E (T ())
eϵ = do
    cs <- (Int -> CM Temp) -> [Int] -> StateT CSt Identity [Temp]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (\Int
_ -> CM Temp
newITemp) [(Int
0::Int)..Int
5]; fs <- traverse (\Int
_ -> CM FTemp
newFTemp) [(0::Int)..5]
    (zipWith (\FTemp
xr FTemp
xr' -> () -> FTemp -> CFE -> CS ()
forall a. a -> FTemp -> CFE -> CS a
MX () FTemp
xr' (FTemp -> CFE
FTmp FTemp
xr)) [F0,F1,F2,F3,F4,F5] fs ++) . (zipWith (\Temp
r Temp
r' -> Temp
r' Temp -> CE -> CS ()
=: Temp -> CE
Tmp Temp
r) [C0,C1,C2,C3,C4,C5] cs ++) <$> go eϵ fs cs where
    go :: E (T ()) -> [FTemp] -> [Temp] -> State CSt [CS ()]
go (Lam T ()
_ x :: Nm (T ())
x@(Nm Text
_ U
_ T ()
F) E (T ())
e) (FTemp
fr:[FTemp]
frs) [Temp]
rs = do
        (CSt -> CSt) -> StateT CSt Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (Nm (T ()) -> FTemp -> CSt -> CSt
forall a. Nm a -> FTemp -> CSt -> CSt
addD Nm (T ())
x FTemp
fr)
        E (T ()) -> [FTemp] -> [Temp] -> State CSt [CS ()]
go E (T ())
e [FTemp]
frs [Temp]
rs
    go (Lam T ()
_ (Nm Text
_ U
_ T ()
F) E (T ())
_) [] [Temp]
_ = [Char] -> State CSt [CS ()]
forall a. HasCallStack => [Char] -> a
error [Char]
"Not enough floating-point registers!"
    go (Lam T ()
_ x :: Nm (T ())
x@(Nm Text
_ U
_ T ()
I) E (T ())
e) [FTemp]
frs (Temp
r:[Temp]
rs) = do
        (CSt -> CSt) -> StateT CSt Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (Nm (T ()) -> Temp -> CSt -> CSt
forall a. Nm a -> Temp -> CSt -> CSt
addVar Nm (T ())
x Temp
r)
        E (T ()) -> [FTemp] -> [Temp] -> State CSt [CS ()]
go E (T ())
e [FTemp]
frs [Temp]
rs
    go (Lam T ()
_ x :: Nm (T ())
x@(Nm Text
_ U
_ Arr{}) E (T ())
e) [FTemp]
frs (Temp
r:[Temp]
rs) = do
        (CSt -> CSt) -> StateT CSt Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (Nm (T ()) -> (Maybe AL, Temp) -> CSt -> CSt
forall a. Nm a -> (Maybe AL, Temp) -> CSt -> CSt
addAVar Nm (T ())
x (Maybe AL
forall a. Maybe a
Nothing, Temp
r))
        E (T ()) -> [FTemp] -> [Temp] -> State CSt [CS ()]
go E (T ())
e [FTemp]
frs [Temp]
rs
    go Lam{} [FTemp]
_ [] = [Char] -> State CSt [CS ()]
forall a. HasCallStack => [Char] -> a
error [Char]
"Not enough registers!"
    go E (T ())
e [FTemp]
_ [Temp]
_ | T () -> Bool
forall a. T a -> Bool
isF (E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
e) = do {f <- CM FTemp
newFTemp ; (++[MX () FRet0 (FTmp f)]) <$> feval e f} -- avoid clash with xmm0 (arg + ret)
             | T () -> Bool
forall a. T a -> Bool
isI (E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
e) = do {t <- CM Temp
newITemp; (++[CRet =: Tmp t]) <$> eval e t} -- avoid clash when calling functions
             | T () -> Bool
forall a. T a -> Bool
isB (E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
e) = do {t <- CM BTemp
nBT; (++[MB () CBRet (Is t)]) <$> peval e t}
             | T () -> Bool
forall a. T a -> Bool
isArr (E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
e) = do {i <- CM Temp
newITemp; (l,r) <- aeval e i; pure$r++[CRet =: Tmp i]++case l of {Just AL
m -> [() -> AL -> CS ()
forall a. a -> AL -> CS a
RA () AL
m]; Maybe AL
Nothing -> []}}
             | P [T ()
F,T ()
F] <- E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
e = do {t <- CM Temp
newITemp; (_,_,_,p) <- πe e t; pure$Sa () t 16:p++[MX () FRet0 (FAt (Raw t 0 Nothing 8)), MX () FRet1 (FAt (Raw t 1 Nothing 8)), Pop () 16]}
             | ty :: T ()
ty@P{} <- E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
e, Int64
b64 <- T () -> Int64
forall b a. Integral b => T a -> b
bT T ()
ty, (Int64
n,Int64
0) <- Int64
b64 Int64 -> Int64 -> (Int64, Int64)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int64
8 = let b :: CE
b=Int64 -> CE
ConstI Int64
b64 in do {t <- CM Temp
newITemp; a <- nextArr CRet; (_,_,ls,pl) <- πe e t; pure (Sa () t b:pl++MaΠ () a CRet b:CpyE () (TupM CRet (Just a)) (TupM t Nothing) (ConstI n) 8:Pop () b:RA () a:(RA ()<$>ls))}

rtemp :: T a -> CM RT
rtemp :: forall a. T a -> CM RT
rtemp T a
F=FTemp -> RT
FT(FTemp -> RT) -> CM FTemp -> CM RT
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>CM FTemp
newFTemp; rtemp T a
I=Temp -> RT
IT(Temp -> RT) -> CM Temp -> CM RT
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>CM Temp
newITemp; rtemp T a
B=BTemp -> RT
PT(BTemp -> RT) -> CM BTemp -> CM RT
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>CM BTemp
nBT

writeF :: E (T ())
       -> [Arg]
       -> RT
       -> CM (Maybe AL, [CS ()])
writeF :: E (T ()) -> [Arg] -> RT -> CM (Maybe AL, [CS ()])
writeF (Lam T ()
_ Nm (T ())
x E (T ())
e) (AA Temp
r Maybe AL
l:[Arg]
rs) RT
ret = do
    (CSt -> CSt) -> StateT CSt Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (Nm (T ()) -> (Maybe AL, Temp) -> CSt -> CSt
forall a. Nm a -> (Maybe AL, Temp) -> CSt -> CSt
addAVar Nm (T ())
x (Maybe AL
l,Temp
r))
    E (T ()) -> [Arg] -> RT -> CM (Maybe AL, [CS ()])
writeF E (T ())
e [Arg]
rs RT
ret
writeF (Lam T ()
_ Nm (T ())
x E (T ())
e) (IPA Temp
r:[Arg]
rs) RT
ret = do
    (CSt -> CSt) -> StateT CSt Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (Nm (T ()) -> Temp -> CSt -> CSt
forall a. Nm a -> Temp -> CSt -> CSt
addVar Nm (T ())
x Temp
r)
    E (T ()) -> [Arg] -> RT -> CM (Maybe AL, [CS ()])
writeF E (T ())
e [Arg]
rs RT
ret
writeF (Lam T ()
_ Nm (T ())
x E (T ())
e) (FA FTemp
fr:[Arg]
rs) RT
ret = do
    (CSt -> CSt) -> StateT CSt Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (Nm (T ()) -> FTemp -> CSt -> CSt
forall a. Nm a -> FTemp -> CSt -> CSt
addD Nm (T ())
x FTemp
fr)
    E (T ()) -> [Arg] -> RT -> CM (Maybe AL, [CS ()])
writeF E (T ())
e [Arg]
rs RT
ret
writeF (Lam T ()
_ Nm (T ())
x E (T ())
e) (BA BTemp
r:[Arg]
rs) RT
ret = do
    (CSt -> CSt) -> StateT CSt Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (Nm (T ()) -> BTemp -> CSt -> CSt
forall a. Nm a -> BTemp -> CSt -> CSt
addB Nm (T ())
x BTemp
r)
    E (T ()) -> [Arg] -> RT -> CM (Maybe AL, [CS ()])
writeF E (T ())
e [Arg]
rs RT
ret
writeF E (T ())
e [] (IT Temp
r) | T () -> Bool
forall a. T a -> Bool
isArr (E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
e) = E (T ()) -> Temp -> CM (Maybe AL, [CS ()])
aeval E (T ())
e Temp
r
writeF E (T ())
e [] (IT Temp
r) | T () -> Bool
forall a. T a -> Bool
isI (E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
e) = (Maybe AL
forall a. Maybe a
Nothing,)([CS ()] -> (Maybe AL, [CS ()]))
-> State CSt [CS ()] -> CM (Maybe AL, [CS ()])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>E (T ()) -> Temp -> State CSt [CS ()]
eval E (T ())
e Temp
r
writeF E (T ())
e [] (IT Temp
r) | T () -> Bool
forall a. T a -> Bool
isΠR (E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
e) = (\ ~([Int64]
_,Maybe CE
_,[AL]
_,[CS ()]
ss) -> (Maybe AL
forall a. Maybe a
Nothing, [CS ()]
ss))(([Int64], Maybe CE, [AL], [CS ()]) -> (Maybe AL, [CS ()]))
-> CM ([Int64], Maybe CE, [AL], [CS ()]) -> CM (Maybe AL, [CS ()])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>E (T ()) -> Temp -> CM ([Int64], Maybe CE, [AL], [CS ()])
πe E (T ())
e Temp
r
writeF E (T ())
e [] (FT FTemp
r) = (Maybe AL
forall a. Maybe a
Nothing,)([CS ()] -> (Maybe AL, [CS ()]))
-> State CSt [CS ()] -> CM (Maybe AL, [CS ()])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>E (T ()) -> FTemp -> State CSt [CS ()]
feval E (T ())
e FTemp
r
writeF E (T ())
e [] (PT BTemp
r) = (Maybe AL
forall a. Maybe a
Nothing,)([CS ()] -> (Maybe AL, [CS ()]))
-> State CSt [CS ()] -> CM (Maybe AL, [CS ()])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>E (T ()) -> BTemp -> State CSt [CS ()]
peval E (T ())
e BTemp
r

m'p :: Maybe (CS (), CS ()) -> [CS ()] -> [CS ()]
m'p :: Maybe (CS (), CS ()) -> [CS ()] -> [CS ()]
m'p Maybe (CS (), CS ())
Nothing        = [CS ()] -> [CS ()]
forall a. a -> a
id
m'p (Just (CS ()
a,CS ()
pop)) = ([CS ()] -> [CS ()] -> [CS ()]
forall a. [a] -> [a] -> [a]
++[CS ()
pop])([CS ()] -> [CS ()]) -> ([CS ()] -> [CS ()]) -> [CS ()] -> [CS ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(CS ()
aCS () -> [CS ()] -> [CS ()]
forall a. a -> [a] -> [a]
:)

sas :: [Maybe (CS (), CS ())] -> [CS ()] -> [CS ()]
sas :: [Maybe (CS (), CS ())] -> [CS ()] -> [CS ()]
sas = [[CS ()] -> [CS ()]] -> [CS ()] -> [CS ()]
forall (t :: * -> *) a. Foldable t => t (a -> a) -> a -> a
thread([[CS ()] -> [CS ()]] -> [CS ()] -> [CS ()])
-> ([Maybe (CS (), CS ())] -> [[CS ()] -> [CS ()]])
-> [Maybe (CS (), CS ())]
-> [CS ()]
-> [CS ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe (CS (), CS ()) -> [CS ()] -> [CS ()])
-> [Maybe (CS (), CS ())] -> [[CS ()] -> [CS ()]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe (CS (), CS ()) -> [CS ()] -> [CS ()]
m'p

aS :: E (T ()) -> [(T (), Int64 -> ArrAcc)] -> T () -> (Int64 -> ArrAcc) -> CM ([CS ()], [Maybe (CS (), CS ())])
aS :: E (T ())
-> [(T (), Int64 -> ArrAcc)]
-> T ()
-> (Int64 -> ArrAcc)
-> CM ([CS ()], [Maybe (CS (), CS ())])
aS E (T ())
f [(T (), Int64 -> ArrAcc)]
as T ()
rT Int64 -> ArrAcc
rAt = do
    (args, rArgs, pinchArgs) <- [(RT, CS (), Maybe (CS (), CS ()))]
-> ([RT], [CS ()], [Maybe (CS (), CS ())])
forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 ([(RT, CS (), Maybe (CS (), CS ()))]
 -> ([RT], [CS ()], [Maybe (CS (), CS ())]))
-> StateT CSt Identity [(RT, CS (), Maybe (CS (), CS ()))]
-> StateT CSt Identity ([RT], [CS ()], [Maybe (CS (), CS ())])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((T (), Int64 -> ArrAcc)
 -> StateT CSt Identity (RT, CS (), Maybe (CS (), CS ())))
-> [(T (), Int64 -> ArrAcc)]
-> StateT CSt Identity [(RT, CS (), Maybe (CS (), CS ()))]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (\(T ()
t,Int64 -> ArrAcc
r) -> T ()
-> ArrAcc -> StateT CSt Identity (RT, CS (), Maybe (CS (), CS ()))
arg T ()
t (Int64 -> ArrAcc
r(Int64 -> ArrAcc) -> Int64 -> ArrAcc
forall a b. (a -> b) -> a -> b
$T () -> Int64
forall b a. Integral b => T a -> b
bT T ()
t)) [(T (), Int64 -> ArrAcc)]
as
    (r, wR, pinch) <- rW rT (rAt$bT rT)
    ss <- writeRF f args r
    pure (rArgs++ss++[wR], pinch:pinchArgs)

arg :: T () -> ArrAcc -> CM (RT, CS (), Maybe (CS (), CS ()))
arg :: T ()
-> ArrAcc -> StateT CSt Identity (RT, CS (), Maybe (CS (), CS ()))
arg T ()
ty ArrAcc
at | T () -> Bool
forall a. T a -> Bool
isR T ()
ty = do
    t <- T () -> CM RT
forall a. T a -> CM RT
rtemp T ()
ty
    pure (t, mt at t, Nothing)
arg T ()
ty ArrAcc
at | T () -> Bool
forall a. T a -> Bool
isΠ T ()
ty = do
    slop <- CM Temp
newITemp
    let sz=T () -> Int64
forall b a. Integral b => T a -> b
bT T ()
ty; slopE=Int64 -> CE
ConstI Int64
sz
    pure (IT slop, CpyE () (TupM slop Nothing) at 1 sz, Just (Sa () slop slopE, Pop () slopE))

rW :: T () -> ArrAcc -> CM (RT, CS (), Maybe (CS (), CS ()))
rW :: T ()
-> ArrAcc -> StateT CSt Identity (RT, CS (), Maybe (CS (), CS ()))
rW T ()
ty ArrAcc
at | T () -> Bool
forall a. T a -> Bool
isR T ()
ty = do
    t <- T () -> CM RT
forall a. T a -> CM RT
rtemp T ()
ty
    pure (t, wt at t, Nothing)
rW T ()
ty ArrAcc
at | T () -> Bool
forall a. T a -> Bool
isΠ T ()
ty = do
    slopO <- CM Temp
newITemp
    let sz=T () -> Int64
forall b a. Integral b => T a -> b
bT T ()
ty; slopE=Int64 -> CE
ConstI Int64
sz
    pure (IT slopO, CpyE () at (TupM slopO Nothing) 1 sz, Just (Sa () slopO slopE, Pop () slopE))

writeRF :: E (T ()) -> [RT] -> RT -> CM [CS ()]
writeRF :: E (T ()) -> [RT] -> RT -> State CSt [CS ()]
writeRF E (T ())
e [RT]
args = ((Maybe AL, [CS ()]) -> [CS ()])
-> CM (Maybe AL, [CS ()]) -> State CSt [CS ()]
forall a b.
(a -> b) -> StateT CSt Identity a -> StateT CSt Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe AL, [CS ()]) -> [CS ()]
forall a b. (a, b) -> b
snd(CM (Maybe AL, [CS ()]) -> State CSt [CS ()])
-> (RT -> CM (Maybe AL, [CS ()])) -> RT -> State CSt [CS ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.E (T ()) -> [Arg] -> RT -> CM (Maybe AL, [CS ()])
writeF E (T ())
e (RT -> Arg
ra(RT -> Arg) -> [RT] -> [Arg]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>[RT]
args)

data Arg = IPA !Temp | FA !FTemp | AA !Temp (Maybe AL) | BA !BTemp
data RT = IT Temp | FT FTemp | PT BTemp

mt :: ArrAcc -> RT -> CS ()
mt :: ArrAcc -> RT -> CS ()
mt ArrAcc
p (IT Temp
t) = Temp
t Temp -> CE -> CS ()
=: ArrAcc -> CE
EAt ArrAcc
p
mt ArrAcc
p (FT FTemp
t) = () -> FTemp -> CFE -> CS ()
forall a. a -> FTemp -> CFE -> CS a
MX () FTemp
t (ArrAcc -> CFE
FAt ArrAcc
p)
mt ArrAcc
p (PT BTemp
t) = () -> BTemp -> PE -> CS ()
forall a. a -> BTemp -> PE -> CS a
MB () BTemp
t (ArrAcc -> PE
PAt ArrAcc
p)

wt :: ArrAcc -> RT -> CS ()
wt :: ArrAcc -> RT -> CS ()
wt ArrAcc
p (IT Temp
t) = () -> ArrAcc -> CE -> CS ()
forall a. a -> ArrAcc -> CE -> CS a
Wr () ArrAcc
p (Temp -> CE
Tmp Temp
t)
wt ArrAcc
p (FT FTemp
t) = () -> ArrAcc -> CFE -> CS ()
forall a. a -> ArrAcc -> CFE -> CS a
WrF () ArrAcc
p (FTemp -> CFE
FTmp FTemp
t)
wt ArrAcc
p (PT BTemp
t) = () -> ArrAcc -> PE -> CS ()
forall a. a -> ArrAcc -> PE -> CS a
WrP () ArrAcc
p (BTemp -> PE
Is BTemp
t)

ra :: RT -> Arg
ra (FT FTemp
f)=FTemp -> Arg
FA FTemp
f; ra (IT Temp
r)=Temp -> Arg
IPA Temp
r; ra (PT BTemp
r)=BTemp -> Arg
BA BTemp
r

eeval :: E (T ()) -> RT -> CM [CS ()]
eeval :: E (T ()) -> RT -> State CSt [CS ()]
eeval E (T ())
e (IT Temp
t) = E (T ()) -> Temp -> State CSt [CS ()]
eval E (T ())
e Temp
t
eeval E (T ())
e (FT FTemp
t) = E (T ()) -> FTemp -> State CSt [CS ()]
feval E (T ())
e FTemp
t
eeval E (T ())
e (PT BTemp
t) = E (T ()) -> BTemp -> State CSt [CS ()]
peval E (T ())
e BTemp
t

data RI a b = Cell a | Index b deriving Int -> RI a b -> [Char] -> [Char]
[RI a b] -> [Char] -> [Char]
RI a b -> [Char]
(Int -> RI a b -> [Char] -> [Char])
-> (RI a b -> [Char])
-> ([RI a b] -> [Char] -> [Char])
-> Show (RI a b)
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
forall a b. (Show a, Show b) => Int -> RI a b -> [Char] -> [Char]
forall a b. (Show a, Show b) => [RI a b] -> [Char] -> [Char]
forall a b. (Show a, Show b) => RI a b -> [Char]
$cshowsPrec :: forall a b. (Show a, Show b) => Int -> RI a b -> [Char] -> [Char]
showsPrec :: Int -> RI a b -> [Char] -> [Char]
$cshow :: forall a b. (Show a, Show b) => RI a b -> [Char]
show :: RI a b -> [Char]
$cshowList :: forall a b. (Show a, Show b) => [RI a b] -> [Char] -> [Char]
showList :: [RI a b] -> [Char] -> [Char]
Show

part :: [RI a b] -> ([a], [b])
part :: forall a b. [RI a b] -> ([a], [b])
part []           = ([], [])
part (Cell a
i:[RI a b]
is)  = ([a] -> [a]) -> ([a], [b]) -> ([a], [b])
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (a
ia -> [a] -> [a]
forall a. a -> [a] -> [a]
:) (([a], [b]) -> ([a], [b])) -> ([a], [b]) -> ([a], [b])
forall a b. (a -> b) -> a -> b
$ [RI a b] -> ([a], [b])
forall a b. [RI a b] -> ([a], [b])
part [RI a b]
is
part (Index b
i:[RI a b]
is) = ([b] -> [b]) -> ([a], [b]) -> ([a], [b])
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (b
ib -> [b] -> [b]
forall a. a -> [a] -> [a]
:) (([a], [b]) -> ([a], [b])) -> ([a], [b]) -> ([a], [b])
forall a b. (a -> b) -> a -> b
$ [RI a b] -> ([a], [b])
forall a b. [RI a b] -> ([a], [b])
part [RI a b]
is

diml :: (Temp, Maybe AL) -> [CE] -> [CS ()]
diml :: (Temp, Maybe AL) -> [CE] -> [CS ()]
diml (Temp
t,Maybe AL
l) [CE]
ds = (CE -> Int64 -> CS ()) -> [CE] -> [Int64] -> [CS ()]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\CE
d Int64
i -> () -> ArrAcc -> CE -> CS ()
forall a. a -> ArrAcc -> CE -> CS a
Wr () (Temp -> CE -> Maybe AL -> ArrAcc
ADim Temp
t (Int64 -> CE
ConstI Int64
i) Maybe AL
l) CE
d) [CE]
ds [Int64
0..]

vSz :: Temp -> CE -> Int64 -> CM (AL, [CS ()])
vSz :: Temp -> CE -> Int64 -> CM (AL, [CS ()])
vSz Temp
t CE
n Int64
sz = do {a <- Temp -> CM AL
nextArr Temp
t; pure (a, [Ma () a t 1 n sz, Wr () (ADim t 0 (Just a)) n])}

v8 :: Temp -> CE -> CM (AL, [CS ()])
v8 :: Temp -> CE -> CM (AL, [CS ()])
v8 Temp
t CE
n = Temp -> CE -> Int64 -> CM (AL, [CS ()])
vSz Temp
t CE
n Int64
8

plDim :: Int64 -> (Temp, Maybe AL) -> CM ([Temp], [CS ()])
plDim :: Int64 -> (Temp, Maybe AL) -> CM ([Temp], [CS ()])
plDim Int64
rnk (Temp
a,Maybe AL
l) =
    [(Temp, CS ())] -> ([Temp], [CS ()])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(Temp, CS ())] -> ([Temp], [CS ()]))
-> StateT CSt Identity [(Temp, CS ())] -> CM ([Temp], [CS ()])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ArrAcc -> StateT CSt Identity (Temp, CS ()))
-> [ArrAcc] -> StateT CSt Identity [(Temp, CS ())]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (\ArrAcc
at -> do {dt <- CM Temp
newITemp; pure (dt, dt =: EAt at)}) [ Temp -> CE -> Maybe AL -> ArrAcc
ADim Temp
a (Int64 -> CE
ConstI Int64
i) Maybe AL
l | Int64
i <- [Int64
0..Int64
rnkInt64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
-Int64
1] ]

offByDim :: [Temp] -> CM ([Temp], [CS ()])
offByDim :: [Temp] -> CM ([Temp], [CS ()])
offByDim [Temp]
dims = do
    sts <- (Temp -> CM Temp) -> [Temp] -> StateT CSt Identity [Temp]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (\Temp
_ -> CM Temp
newITemp) (Temp
forall a. HasCallStack => a
undefinedTemp -> [Temp] -> [Temp]
forall a. a -> [a] -> [a]
:[Temp]
dims)
    let ss=(Temp -> Temp -> Temp -> CS ())
-> [Temp] -> [Temp] -> [Temp] -> [CS ()]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 (\Temp
s1 Temp
s0 Temp
d -> Temp
s1 Temp -> CE -> CS ()
=: (Temp -> CE
Tmp Temp
s0CE -> CE -> CE
forall a. Num a => a -> a -> a
*Temp -> CE
Tmp Temp
d)) ([Temp] -> [Temp]
forall a. HasCallStack => [a] -> [a]
tail [Temp]
sts) [Temp]
sts [Temp]
dims
    pure (reverse sts, head sts =: 1:ss)
    -- drop 1 for strides

data Cell a b = Fixed -- set by the larger procedure
              | Bound b -- to be iterated over

forAll :: [Temp] -> [CE] -> [CS ()] -> [CS ()]
forAll [Temp]
is [CE]
bs = [[CS ()] -> [CS ()]] -> [CS ()] -> [CS ()]
forall (t :: * -> *) a. Foldable t => t (a -> a) -> a -> a
thread ((Temp -> CE -> [CS ()] -> [CS ()])
-> [Temp] -> [CE] -> [[CS ()] -> [CS ()]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Temp -> CE -> [CS ()] -> [CS ()]
g [Temp]
is [CE]
bs) where
    g :: Temp -> CE -> [CS ()] -> [CS ()]
g Temp
t b :: CE
b@(ConstI Int64
i) | Int64
i Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
0 = (CS () -> [CS ()] -> [CS ()]
forall a. a -> [a] -> [a]
:[]) (CS () -> [CS ()]) -> ([CS ()] -> CS ()) -> [CS ()] -> [CS ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
forall a. a -> Temp -> CE -> IRel -> CE -> [CS a] -> CS a
For1 () Temp
t CE
0 IRel
ILt CE
b
    g Temp
t CE
b            = (CS () -> [CS ()] -> [CS ()]
forall a. a -> [a] -> [a]
:[]) (CS () -> [CS ()]) -> ([CS ()] -> CS ()) -> [CS ()] -> [CS ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
forall a. a -> Temp -> CE -> IRel -> CE -> [CS a] -> CS a
For () Temp
t CE
0 IRel
ILt CE
b

-- the resulting expressions/statement contain free variables that will be iterated over in the main rank-ification loop, these free variables are returned alongside
extrCell :: [Cell () Temp] -> [Temp] -> (Temp, Maybe AL) -> Temp -> CM ([Temp], [CS ()])
extrCell :: [Cell () Temp]
-> [Temp] -> (Temp, Maybe AL) -> Temp -> CM ([Temp], [CS ()])
extrCell [Cell () Temp]
fixBounds [Temp]
sstrides (Temp
srcP, Maybe AL
srcL) Temp
dest = do
    (dims, ts, arrIxes, complts) <- [Cell () Temp]
-> StateT CSt Identity ([Temp], [Temp], [Temp], [Temp])
forall {a} {a}.
[Cell a a] -> StateT CSt Identity ([a], [Temp], [Temp], [Temp])
switch [Cell () Temp]
fixBounds
    t <- newITemp; i <- newITemp
    pure (complts, (i =: 0:) $ forAll ts (Tmp<$>dims)
        [t =: EAt (At srcP (Tmp<$>sstrides) (Tmp<$>arrIxes) srcL 8), Wr () (Raw dest (Tmp i) Nothing 8) (Tmp t), i+=1])
    where switch :: [Cell a a] -> StateT CSt Identity ([a], [Temp], [Temp], [Temp])
switch (Bound a
d:[Cell a a]
ds) = do {t <- CM Temp
newITemp; qmap (d:) (t:) (t:) id <$> switch ds}
          switch (Cell a a
Fixed:[Cell a a]
ds)   = do {f <- CM Temp
newITemp; qmap id id (f:) (f:) <$> switch ds}
          switch []           = ([a], [Temp], [Temp], [Temp])
-> StateT CSt Identity ([a], [Temp], [Temp], [Temp])
forall a. a -> StateT CSt Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], [], [], [])

llet :: (Nm (T ()), E (T ())) -> CM [CS ()]
llet :: (Nm (T ()), E (T ())) -> State CSt [CS ()]
llet (Nm (T ())
n,E (T ())
e') | T () -> Bool
forall a. T a -> Bool
isArr (E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
e') = do
    eR <- CM Temp
newITemp
    (l, ss) <- aeval e' eR
    modify (addAVar n (l,eR)) $> ss
llet (Nm (T ())
n,E (T ())
e') | T () -> Bool
forall a. T a -> Bool
isI (E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
e') = do
    eR <- CM Temp
newITemp
    ss <- eval e' eR
    modify (addVar n eR) $> ss
llet (Nm (T ())
n,E (T ())
e') | T () -> Bool
forall a. T a -> Bool
isF (E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
e') = do
    eR <- CM FTemp
newFTemp
    ss <- feval e' eR
    modify (addD n eR) $> ss
llet (Nm (T ())
n,E (T ())
e') | Arrow T ()
F T ()
F <- E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
e' = do
    l <- CM Label
neL
    x <- newFTemp; y <- newFTemp
    (_, ss) <- writeF e' [FA x] (FT y)
    modify (addF n (l, [FA x], Left y))
    pure [C.Def () l ss]

aeval :: E (T ()) -> Temp -> CM (Maybe AL, [CS ()])
aeval :: E (T ()) -> Temp -> CM (Maybe AL, [CS ()])
aeval (LLet T ()
_ (Nm (T ()), E (T ()))
b E (T ())
e) Temp
t = do
    ss <- (Nm (T ()), E (T ())) -> State CSt [CS ()]
llet (Nm (T ()), E (T ()))
b
    second (ss ++) <$> aeval e t
aeval (Var T ()
_ Nm (T ())
x) Temp
t = do
    st <- (CSt -> IntMap (Maybe AL, Temp))
-> StateT CSt Identity (IntMap (Maybe AL, Temp))
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets CSt -> IntMap (Maybe AL, Temp)
avars
    let (i, r) = {-# SCC "getA" #-} getT st x
    pure (i, [t =: Tmp r])
aeval (EApp T ()
ty (EApp T ()
_ (Builtin T ()
_ Builtin
A.R) E (T ())
e0) E (T ())
e1) Temp
t | (T ()
F, [Int64]
ixs) <- T () -> (T (), [Int64])
forall a. T a -> (T a, [Int64])
tRnd T ()
ty = do
    a <- Temp -> CM AL
nextArr Temp
t
    (plE0,e0e) <- plD e0; (plE1,e1e) <- plD e1
    xR <- newFTemp; scaleR <- newFTemp; k <- newITemp
    let rnk=Int -> CE
forall a b. (Integral a, Num b) => a -> b
fromIntegral([Int64] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int64]
ixs); n=[Int64] -> Int64
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product [Int64]
ixs
        plRnd = [() -> FTemp -> CS ()
forall a. a -> FTemp -> CS a
FRnd () FTemp
xR, () -> FTemp -> CFE -> CS ()
forall a. a -> FTemp -> CFE -> CS a
MX () FTemp
xR (FTemp -> CFE
FTmp FTemp
scaleRCFE -> CFE -> CFE
forall a. Num a => a -> a -> a
*FTemp -> CFE
FTmp FTemp
xRCFE -> CFE -> CFE
forall a. Num a => a -> a -> a
+CFE
e0e), () -> ArrAcc -> CFE -> CS ()
forall a. a -> ArrAcc -> CFE -> CS a
WrF () (Temp -> CE -> CE -> Maybe AL -> Int64 -> ArrAcc
AElem Temp
t CE
rnk (Temp -> CE
Tmp Temp
k) (AL -> Maybe AL
forall a. a -> Maybe a
Just AL
a) Int64
8) (FTemp -> CFE
FTmp FTemp
xR)]
        loop=T () -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
forall {a}. T a -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
fors T ()
ty Temp
k CE
0 IRel
ILt (Int64 -> CE
ConstI Int64
n) [CS ()]
plRnd
    pure (Just a, plE0 $ plE1 (Ma () a t rnk (ConstI n) 8:diml (t, Just a) (ConstI<$>ixs)++MX () scaleR (e1e-e0e):[loop]))
aeval (EApp T ()
ty (EApp T ()
_ (Builtin T ()
_ Builtin
A.R) E (T ())
e0) E (T ())
e1) Temp
t | (T ()
I, [Int64]
ixs) <- T () -> (T (), [Int64])
forall a. T a -> (T a, [Int64])
tRnd T ()
ty = do
    a <- Temp -> CM AL
nextArr Temp
t
    scaleR <- newITemp; iR <- newITemp; k <- newITemp
    (plE0,e0e) <- plC e0; (plE1,e1e) <- plC e1
    let rnk=Int -> CE
forall a b. (Integral a, Num b) => a -> b
fromIntegral(Int -> CE) -> Int -> CE
forall a b. (a -> b) -> a -> b
$[Int64] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int64]
ixs; n=[Int64] -> Int64
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product [Int64]
ixs
        plRnd = [() -> Temp -> CS ()
forall a. a -> Temp -> CS a
Rnd () Temp
iR, Temp
iR Temp -> CE -> CS ()
=: (IBin -> CE -> CE -> CE
Bin IBin
IRem (Temp -> CE
Tmp Temp
iR) (Temp -> CE
Tmp Temp
scaleR) CE -> CE -> CE
forall a. Num a => a -> a -> a
+ CE
e0e), () -> ArrAcc -> CE -> CS ()
forall a. a -> ArrAcc -> CE -> CS a
Wr () (Temp -> CE -> CE -> Maybe AL -> Int64 -> ArrAcc
AElem Temp
t CE
rnk (Temp -> CE
Tmp Temp
k) (AL -> Maybe AL
forall a. a -> Maybe a
Just AL
a) Int64
8) (Temp -> CE
Tmp Temp
iR)]
        loop=T () -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
forall {a}. T a -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
fors T ()
ty Temp
k CE
0 IRel
ILt (Int64 -> CE
ConstI Int64
n) [CS ()]
plRnd
    pure (Just a, plE0$plE1$Ma () a t rnk (ConstI n) 8:diml (t, Just a) (ConstI<$>ixs)++scaleR=:(e1e-e0e+1):[loop])
aeval (Builtin T ()
ty Builtin
Eye) Temp
t | (T ()
I, ixs :: [Int64]
ixs@[Int64
i,Int64
_]) <- T () -> (T (), [Int64])
forall a. T a -> (T a, [Int64])
tRnd T ()
ty = do
    a <- Temp -> CM AL
nextArr Temp
t
    td <- newITemp; k <- newITemp
    let rnk=Int -> CE
forall a b. (Integral a, Num b) => a -> b
fromIntegral(Int -> CE) -> Int -> CE
forall a b. (a -> b) -> a -> b
$[Int64] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int64]
ixs; n=[Int64] -> Int64
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product [Int64]
ixs
        loop = T () -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
forall {a}. T a -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
fors T ()
ty Temp
k CE
0 IRel
ILt (Int64 -> CE
ConstI Int64
i) [() -> ArrAcc -> CE -> CS ()
forall a. a -> ArrAcc -> CE -> CS a
Wr () (Temp -> [CE] -> [CE] -> Maybe AL -> Int64 -> ArrAcc
At Temp
td [Int64 -> CE
ConstI Int64
i, CE
1] [Temp -> CE
Tmp Temp
k, Temp -> CE
Tmp Temp
k] (AL -> Maybe AL
forall a. a -> Maybe a
Just AL
a) Int64
8) (Int64 -> CE
ConstI Int64
1)]
    pure (Just a, Ma () a t rnk (ConstI n) 8:diml (t, Just a) (ConstI<$>ixs)++[td=:DP t rnk, loop])
aeval (Builtin T ()
ty Builtin
Eye) Temp
t | (T ()
F, ixs :: [Int64]
ixs@[Int64
i,Int64
_]) <- T () -> (T (), [Int64])
forall a. T a -> (T a, [Int64])
tRnd T ()
ty = do
    a <- Temp -> CM AL
nextArr Temp
t
    td <- newITemp; k <- newITemp
    let rnk=Int -> CE
forall a b. (Integral a, Num b) => a -> b
fromIntegral(Int -> CE) -> Int -> CE
forall a b. (a -> b) -> a -> b
$[Int64] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int64]
ixs; n=[Int64] -> Int64
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product [Int64]
ixs
        loop = T () -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
forall {a}. T a -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
fors T ()
ty Temp
k CE
0 IRel
ILt (Int64 -> CE
ConstI Int64
i) [() -> ArrAcc -> CFE -> CS ()
forall a. a -> ArrAcc -> CFE -> CS a
WrF () (Temp -> [CE] -> [CE] -> Maybe AL -> Int64 -> ArrAcc
At Temp
td [Int64 -> CE
ConstI Int64
i, CE
1] [Temp -> CE
Tmp Temp
k, Temp -> CE
Tmp Temp
k] (AL -> Maybe AL
forall a. a -> Maybe a
Just AL
a) Int64
8) (Double -> CFE
ConstF Double
1)]
    pure (Just a, Ma () a t rnk (ConstI n) 8:diml (t, Just a) (ConstI<$>ixs)++[td=:DP t rnk, loop])
aeval (EApp T ()
_ (Builtin T ()
_ Builtin
AddDim) E (T ())
x) Temp
t | T ()
F <- E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
x = do
    xR <- CM FTemp
newFTemp
    plX <- feval x xR
    (a,aV) <- v8 t 1
    pure (Just a, plX++aV++[WrF () (AElem t 1 0 (Just a) 8) (FTmp xR)])
aeval (EApp T ()
_ (Builtin T ()
_ Builtin
AddDim) E (T ())
x) Temp
t | T ()
I <- E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
x = do
    xR <- CM Temp
newITemp
    plX <- eval x xR
    (a,aV) <- v8 t 1
    pure (Just a, plX++aV++[Wr () (AElem t 1 0 (Just a) 8) (Tmp xR)])
aeval (EApp T ()
_ (Builtin T ()
_ Builtin
AddDim) E (T ())
x) Temp
t | P{} <- E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
x = do
    xR <- CM Temp
newITemp
    (szs, mS, _, plX) <- πe x xR
    let sz=[Int64] -> Int64
forall a. HasCallStack => [a] -> a
last [Int64]
szs
    (a,aV) <- vSz t 1 sz
    pure (Just a, m'sa xR mS++plX++aV++[CpyE () (AElem t 1 0 (Just a) sz) (TupM xR Nothing) 1 sz]++m'pop mS)
aeval (EApp T ()
_ (Builtin T ()
_ Builtin
AddDim) E (T ())
xs) Temp
t | (Arr Sh ()
sh T ()
ty) <- E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
xs, Just Int64
sz <- T () -> Maybe Int64
forall b a. Integral b => T a -> Maybe b
nSz T ()
ty = do
    (plX, (lX, xR)) <- E (T ()) -> CM ([CS ()] -> [CS ()], (Maybe AL, Temp))
plA E (T ())
xs
    xRnk <- newITemp; szR <- newITemp; rnk <- newITemp
    a <- nextArr t
    pure (Just a,
            plX$xRnk=:eRnk sh (xR,lX):SZ () szR xR (Tmp xRnk) lX:rnk =: (Tmp xRnk+1):Ma () a t (Tmp rnk) (Tmp szR) sz:
           [Wr () (ADim t 0 (Just a)) 1, CpyD () (ADim t 1 (Just a)) (ADim xR 0 lX) (Tmp xRnk), CpyE () (AElem t (Tmp rnk) 0 (Just a) sz) (AElem xR (Tmp xRnk) 0 lX sz) (Tmp szR) sz])
aeval (EApp T ()
_ (Builtin T ()
_ Builtin
Flat) E (T ())
xs) Temp
t | (Arr Sh ()
sh T ()
ty) <- E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
xs, Just Int64
sz <- T () -> Maybe Int64
forall b a. Integral b => T a -> Maybe b
nSz T ()
ty = do
    (plX, (lX, xR)) <- E (T ()) -> CM ([CS ()] -> [CS ()], (Maybe AL, Temp))
plA E (T ())
xs
    xRnk <- newITemp; szR <- newITemp
    (a,aV) <- vSz t (Tmp szR) sz
    pure (Just a, plX$xRnk=:eRnk sh (xR,lX):SZ () szR xR (Tmp xRnk) lX:aV++[CpyE () (AElem t 1 0 (Just a) sz) (AElem xR (Tmp xRnk) 0 lX sz) (Tmp szR) sz])
aeval (EApp T ()
_ (EApp T ()
_ (Builtin T ()
_ Builtin
Map) E (T ())
op) E (T ())
e) Temp
t | (Arrow T ()
tD T ()
tC) <- E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
op, Just Int64
sz <- T () -> Maybe Int64
forall b a. Integral b => T a -> Maybe b
nSz T ()
tC, T () -> Bool
forall a. T a -> Bool
nind T ()
tD = do
    (plE, (l, xR)) <- E (T ()) -> CM ([CS ()] -> [CS ()], (Maybe AL, Temp))
plA E (T ())
e
    iR <- newITemp; szR <- newITemp
    (a,aV) <- vSz t (Tmp szR) sz
    (step, pinches) <- aS op [(tD, AElem xR 1 (Tmp iR) l)] tC (AElem t 1 (Tmp iR) (Just a))
    let loop=T () -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
forall {a}. T a -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
for (E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
e) Temp
iR CE
0 IRel
ILt (Temp -> CE
Tmp Temp
szR) [CS ()]
step
    pure (Just a,
        plE$
        szR=:ev (eAnn e) (xR,l):aV
        ++sas pinches [loop])
aeval (EApp T ()
_ (EApp T ()
_ (Builtin T ()
_ Builtin
Filt) E (T ())
p) E (T ())
xs) Temp
t | tXs :: T ()
tXs@(Arr (I ()
_ `Cons` Sh ()
Nil) T ()
tX) <- E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
xs, Just Int64
sz <- T () -> Maybe Int64
forall b a. Integral b => T a -> Maybe b
nSz T ()
tX = do
    a <- Temp -> CM AL
nextArr Temp
t
    szR <- newITemp; nR <- newITemp; b <- nBT
    (plX, (lX, xsR)) <- plA xs
    k <- newITemp
    (xR, rX, pinch) <- arg tX (AElem xsR 1 (Tmp k) lX sz)
    ss <- writeRF p [xR] (PT b)
    let step = CS ()
rXCS () -> [CS ()] -> [CS ()]
forall a. a -> [a] -> [a]
:[CS ()]
ss[CS ()] -> [CS ()] -> [CS ()]
forall a. [a] -> [a] -> [a]
++[() -> PE -> [CS ()] -> [CS ()] -> CS ()
forall a. a -> PE -> [CS a] -> [CS a] -> CS a
If () (BTemp -> PE
Is BTemp
b) [T () -> ArrAcc -> RT -> CS ()
forall {a}. T a -> ArrAcc -> RT -> CS ()
w T ()
tX (Temp -> CE -> CE -> Maybe AL -> Int64 -> ArrAcc
AElem Temp
t CE
1 (Temp -> CE
Tmp Temp
nR) (AL -> Maybe AL
forall a. a -> Maybe a
Just AL
a) Int64
sz) RT
xR, Temp
nRTemp -> CE -> CS ()
+=CE
1] []]
        loop = T () -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
forall {a}. T a -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
for (E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
xs) Temp
k CE
0 IRel
ILt (Temp -> CE
Tmp Temp
szR) [CS ()]
step
    pure (Just a,
        plX$
        szR =: ev tXs (xsR,lX)
        :Ma () a t 1 (Tmp szR) sz
        :m'p pinch [nR=:0, loop, Wr () (ADim t 0 (Just a)) (Tmp nR)])
  where
    w :: T a -> ArrAcc -> RT -> CS ()
w T a
ty ArrAcc
at RT
tt      | T a -> Bool
forall a. T a -> Bool
isR T a
ty = ArrAcc -> RT -> CS ()
wt ArrAcc
at RT
tt
    w T a
ty ArrAcc
at (IT Temp
tt) | T a -> Bool
forall a. T a -> Bool
isΠ T a
ty = () -> ArrAcc -> ArrAcc -> CE -> Int64 -> CS ()
forall a. a -> ArrAcc -> ArrAcc -> CE -> Int64 -> CS a
CpyE () ArrAcc
at (Temp -> Maybe AL -> ArrAcc
TupM Temp
tt Maybe AL
forall a. Maybe a
Nothing) CE
1 (T a -> Int64
forall b a. Integral b => T a -> b
bT T a
ty)
aeval (EApp T ()
_ (EApp T ()
_ (Builtin T ()
_ Builtin
Ices) E (T ())
p) E (T ())
xs) Temp
t | tXs :: T ()
tXs@(Arr (I ()
_ `Cons` Sh ()
Nil) T ()
tX) <- E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
xs, Just Int64
sz <- T () -> Maybe Int64
forall b a. Integral b => T a -> Maybe b
nSz T ()
tX = do
    a <- Temp -> CM AL
nextArr Temp
t
    szR <- newITemp; nR <- newITemp; b <- nBT
    (plX, (lX, xsR)) <- plA xs
    k <- newITemp
    (xR, rX, pinch) <- arg tX (AElem xsR 1 (Tmp k) lX sz)
    ss <- writeRF p [xR] (PT b)
    let step = CS ()
rXCS () -> [CS ()] -> [CS ()]
forall a. a -> [a] -> [a]
:[CS ()]
ss[CS ()] -> [CS ()] -> [CS ()]
forall a. [a] -> [a] -> [a]
++[() -> PE -> [CS ()] -> [CS ()] -> CS ()
forall a. a -> PE -> [CS a] -> [CS a] -> CS a
If () (BTemp -> PE
Is BTemp
b) [() -> ArrAcc -> CE -> CS ()
forall a. a -> ArrAcc -> CE -> CS a
Wr () (Temp -> CE -> CE -> Maybe AL -> Int64 -> ArrAcc
AElem Temp
t CE
1 (Temp -> CE
Tmp Temp
nR) (AL -> Maybe AL
forall a. a -> Maybe a
Just AL
a) Int64
8) (Temp -> CE
Tmp Temp
k), Temp
nRTemp -> CE -> CS ()
+=CE
1] []]
        loop = T () -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
forall {a}. T a -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
for (E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
xs) Temp
k CE
0 IRel
ILt (Temp -> CE
Tmp Temp
szR) [CS ()]
step
    pure (Just a,
        plX$
        szR=:ev tXs (xsR,lX)
        :Ma () a t 1 (Tmp szR) 8
        :m'p pinch [nR=:0, loop, Wr () (ADim t 0 (Just a)) (Tmp nR)])
aeval (EApp T ()
_ (EApp T ()
_ (Builtin T ()
_ Builtin
Map) E (T ())
f) E (T ())
xs) Temp
t | (Arrow T ()
tD T ()
tC) <- E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
f, Just (T ()
_, Int64
xRnk) <- T () -> Maybe (T (), Int64)
forall a. T a -> Maybe (T a, Int64)
tRnk (E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
xs), Just (T ()
ta, Int64
rnk) <- T () -> Maybe (T (), Int64)
forall a. T a -> Maybe (T a, Int64)
tRnk T ()
tD, Just Int64
szD <- T () -> Maybe Int64
forall b a. Integral b => T a -> Maybe b
bSz T ()
ta, Just Int64
sz <- T () -> Maybe Int64
forall b a. Integral b => T a -> Maybe b
bSz T ()
tC = do
    a <- Temp -> CM AL
nextArr Temp
t
    slopP <- newITemp; szR <- newITemp; slopSz <- newITemp
    xd <- newITemp; i <- newITemp; k <- newITemp
    (plX, (lX, xR)) <- plA xs
    (y, wRet, pinch) <- rW tC (AElem t 1 (Tmp k) (Just a) sz)
    (_, ss) <- writeF f [AA slopP Nothing] y
    let slopDims=[ArrAcc -> CE
EAt (Temp -> CE -> Maybe AL -> ArrAcc
ADim Temp
xR (Int64 -> CE
ConstI Int64
l) Maybe AL
lX) | Int64
l <- [Int64
rnk..(Int64
xRnkInt64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
-Int64
1)]]
        xDims=[ArrAcc -> CE
EAt (Temp -> CE -> Maybe AL -> ArrAcc
ADim Temp
xR (Int64 -> CE
ConstI Int64
l) Maybe AL
lX) | Int64
l <- [Int64
0..(Int64
rnkInt64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
-Int64
1)]]
        slopE=Temp -> CE
Tmp Temp
slopSzCE -> CE -> CE
forall a. Num a => a -> a -> a
*Int64 -> CE
ConstI Int64
szDCE -> CE -> CE
forall a. Num a => a -> a -> a
+Int64 -> CE
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64
8Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+Int64
8Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
*Int64
rnk)
        dimsFromIn=Int64 -> CE
ConstI(Int64 -> CE) -> Int64 -> CE
forall a b. (a -> b) -> a -> b
$Int64
xRnkInt64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
-Int64
rnk
        oRnk=Int64
xRnkInt64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
-Int64
rnk
        step=() -> ArrAcc -> ArrAcc -> CE -> Int64 -> CS ()
forall a. a -> ArrAcc -> ArrAcc -> CE -> Int64 -> CS a
CpyE () (Temp -> CE -> CE -> Maybe AL -> Int64 -> ArrAcc
AElem Temp
slopP (Int64 -> CE
ConstI Int64
rnk) CE
0 Maybe AL
forall a. Maybe a
Nothing Int64
szD) (Temp -> CE -> Maybe AL -> Int64 -> ArrAcc
Raw Temp
xd (Temp -> CE
Tmp Temp
i) Maybe AL
lX Int64
szD) (Temp -> CE
Tmp Temp
slopSz) Int64
szDCS () -> [CS ()] -> [CS ()]
forall a. a -> [a] -> [a]
:[CS ()]
ss[CS ()] -> [CS ()] -> [CS ()]
forall a. [a] -> [a] -> [a]
++[CS ()
wRet, Temp
iTemp -> CE -> CS ()
+=Temp -> CE
Tmp Temp
slopSz]
    pure (Just a,
        plX$
        PlProd () slopSz slopDims:Sa () slopP slopE:diml (slopP, Nothing) slopDims
        ++PlProd () szR xDims
        :Ma () a t (ConstI oRnk) (Tmp szR) sz
            :CpyD () (ADim t 0 (Just a)) (ADim xR 0 lX) dimsFromIn
        :xd=:DP xR (ConstI xRnk):i=:0
        :m'p pinch
            (fors (eAnn xs) k 0 ILt (Tmp szR) step:[Pop () slopE]))
aeval (EApp T ()
_ (EApp T ()
_ (Builtin T ()
_ Builtin
Map) E (T ())
f) E (T ())
xs) Temp
t | (Arrow T ()
tD T ()
tC) <- E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
f, Just (T ()
_, Int64
xRnk) <- T () -> Maybe (T (), Int64)
forall a. T a -> Maybe (T a, Int64)
tRnk (E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
xs), Just (T ()
ta, Int64
rnk) <- T () -> Maybe (T (), Int64)
forall a. T a -> Maybe (T a, Int64)
tRnk T ()
tC, Just Int64
szO <- T () -> Maybe Int64
forall b a. Integral b => T a -> Maybe b
bSz T ()
ta, T () -> Bool
forall a. T a -> Bool
isIF T ()
tD = do
    a <- Temp -> CM AL
nextArr Temp
t
    x <- rtemp tD; y <- newITemp; y0 <- newITemp; szX <- newITemp; szY <- newITemp
    j <- newITemp; k <- newITemp; td <- newITemp; yd <- newITemp
    (plX, (lX, xR)) <- plA xs
    (lY0, ss0) <- writeF f [ra x] (IT y0)
    (lY, ss) <- writeF f [ra x] (IT y)
    let xDims=[ArrAcc -> CE
EAt (Temp -> CE -> Maybe AL -> ArrAcc
ADim Temp
xR (Int64 -> CE
ConstI Int64
l) Maybe AL
lX) | Int64
l <- [Int64
0..(Int64
xRnkInt64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
-Int64
1)]]
        yDims=[ArrAcc -> CE
EAt (Temp -> CE -> Maybe AL -> ArrAcc
ADim Temp
y0 (Int64 -> CE
ConstI Int64
l) Maybe AL
lY0) | Int64
l <- [Int64
0..(Int64
rnkInt64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
-Int64
1)]]
        oRnk=Int64
xRnkInt64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+Int64
rnk
        step=ArrAcc -> RT -> CS ()
mt (Temp -> CE -> CE -> Maybe AL -> Int64 -> ArrAcc
AElem Temp
xR (Int64 -> CE
ConstI Int64
xRnk) (Temp -> CE
Tmp Temp
k) (AL -> Maybe AL
forall a. a -> Maybe a
Just AL
a) Int64
8) RT
xCS () -> [CS ()] -> [CS ()]
forall a. a -> [a] -> [a]
:[CS ()]
ss[CS ()] -> [CS ()] -> [CS ()]
forall a. [a] -> [a] -> [a]
++[Temp
ydTemp -> CE -> CS ()
=:Temp -> CE -> CE
DP Temp
y (Int64 -> CE
ConstI Int64
rnk), () -> ArrAcc -> ArrAcc -> CE -> Int64 -> CS ()
forall a. a -> ArrAcc -> ArrAcc -> CE -> Int64 -> CS a
CpyE () (Temp -> CE -> Maybe AL -> Int64 -> ArrAcc
Raw Temp
td (Temp -> CE
Tmp Temp
j) (AL -> Maybe AL
forall a. a -> Maybe a
Just AL
a) Int64
szO) (Temp -> CE -> Maybe AL -> Int64 -> ArrAcc
Raw Temp
yd CE
0 Maybe AL
lY Int64
forall a. HasCallStack => a
undefined) (Temp -> CE
Tmp Temp
szY) Int64
szO, Temp
jTemp -> CE -> CS ()
+=Temp -> CE
Tmp Temp
szY]
    pure (Just a,
        plX$
        mt (AElem xR (ConstI xRnk) 0 lX 8) x
        :ss0
        ++PlProd () szY yDims
        :PlProd () szX xDims
        :Ma () a t (ConstI oRnk) (Tmp szX*Tmp szY) szO
            :CpyD () (ADim t 0 (Just a)) (ADim xR 0 lX) (ConstI xRnk)
            :CpyD () (ADim t (ConstI xRnk) (Just a)) (ADim y0 0 lY0) (ConstI rnk)
        :td=:DP t (ConstI$xRnk+rnk)
        :j=:0
          :[fors (eAnn xs) k 0 ILt (Tmp szX) step])
aeval (EApp T ()
_ (EApp T ()
_ (Builtin T ()
_ Builtin
Map) E (T ())
f) E (T ())
xs) Temp
t | T ()
tX <- E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
xs, Just (T ()
_, Int64
xRnk) <- T () -> Maybe (T (), Int64)
forall a. T a -> Maybe (T a, Int64)
tRnk T ()
tX, Just ((T ()
ta0, Int64
rnk0), (T ()
ta1, Int64
rnk1)) <- T () -> Maybe ((T (), Int64), (T (), Int64))
forall a. T a -> Maybe ((T a, Int64), (T a, Int64))
mAA (E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
f), Just Int64
sz0 <- T () -> Maybe Int64
forall b a. Integral b => T a -> Maybe b
bSz T ()
ta0, Just Int64
sz1 <- T () -> Maybe Int64
forall b a. Integral b => T a -> Maybe b
bSz T ()
ta1 = do
    a <- Temp -> CM AL
nextArr Temp
t
    slopP <- newITemp; y <- newITemp; y0 <- newITemp
    szR <- newITemp; slopSz <- newITemp; szY <- newITemp
    i <- newITemp; j <- newITemp; k <- newITemp; kL <- newITemp; xd <- newITemp; td <- newITemp
    (plX, (lX, xR)) <- plA xs
    (lY0, ss0) <- writeF f [AA slopP Nothing] (IT y0)
    (lY, ss) <- writeF f [AA slopP Nothing] (IT y)
    let slopDims=[ArrAcc -> CE
EAt (Temp -> CE -> Maybe AL -> ArrAcc
ADim Temp
xR (Int64 -> CE
ConstI Int64
l) Maybe AL
lX) | Int64
l <- [Int64
rnk0..(Int64
xRnkInt64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
-Int64
1)]]
        xDims=[ArrAcc -> CE
EAt (Temp -> CE -> Maybe AL -> ArrAcc
ADim Temp
xR (Int64 -> CE
ConstI Int64
l) Maybe AL
lX) | Int64
l <- [Int64
0..(Int64
rnk0Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
-Int64
1)]]
        yDims=[ArrAcc -> CE
EAt (Temp -> CE -> Maybe AL -> ArrAcc
ADim Temp
y0 (Int64 -> CE
ConstI Int64
l) Maybe AL
lY0) | Int64
l <- [Int64
0..(Int64
rnk1Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
-Int64
1)]]
        slopE=Temp -> CE
Tmp Temp
slopSzCE -> CE -> CE
forall a. Num a => a -> a -> a
*Int64 -> CE
ConstI Int64
sz1CE -> CE -> CE
forall a. Num a => a -> a -> a
+Int64 -> CE
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64
8Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+Int64
8Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
*Int64
rnk0)
        dimsFromIn=Int64 -> CE
ConstI(Int64 -> CE) -> Int64 -> CE
forall a b. (a -> b) -> a -> b
$Int64
xRnkInt64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
-Int64
rnk0
        oRnk=Int64
xRnkInt64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
-Int64
rnk0Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+Int64
rnk1
        step=() -> ArrAcc -> ArrAcc -> CE -> Int64 -> CS ()
forall a. a -> ArrAcc -> ArrAcc -> CE -> Int64 -> CS a
CpyE () (Temp -> CE -> CE -> Maybe AL -> Int64 -> ArrAcc
AElem Temp
slopP (Int64 -> CE
ConstI Int64
rnk0) CE
0 Maybe AL
forall a. Maybe a
Nothing Int64
sz0) (Temp -> CE -> Maybe AL -> Int64 -> ArrAcc
Raw Temp
xd (Temp -> CE
Tmp Temp
i) Maybe AL
lX Int64
sz0) (Temp -> CE
Tmp Temp
slopSz) Int64
sz0CS () -> [CS ()] -> [CS ()]
forall a. a -> [a] -> [a]
:[CS ()]
ss[CS ()] -> [CS ()] -> [CS ()]
forall a. [a] -> [a] -> [a]
++[() -> ArrAcc -> ArrAcc -> CE -> Int64 -> CS ()
forall a. a -> ArrAcc -> ArrAcc -> CE -> Int64 -> CS a
CpyE () (Temp -> CE -> Maybe AL -> Int64 -> ArrAcc
Raw Temp
td (Temp -> CE
Tmp Temp
j) (AL -> Maybe AL
forall a. a -> Maybe a
Just AL
a) Int64
sz1) (Temp -> CE -> CE -> Maybe AL -> Int64 -> ArrAcc
AElem Temp
y (Int64 -> CE
ConstI Int64
rnk1) CE
0 Maybe AL
lY Int64
sz1) (Temp -> CE
Tmp Temp
szY) Int64
sz1, Temp
iTemp -> CE -> CS ()
+=Temp -> CE
Tmp Temp
slopSz, Temp
jTemp -> CE -> CS ()
+=Temp -> CE
Tmp Temp
szY]
    pure (Just a,
        plX$
        PlProd () slopSz slopDims:Sa () slopP slopE:diml (slopP, Nothing) slopDims
        ++xd=:DP xR (ConstI xRnk)
        :CpyE () (AElem slopP (ConstI rnk0) 0 Nothing sz0) (Raw xd 0 lX sz0) (Tmp slopSz) sz0
        :ss0
        ++PlProd () szR (xDims++yDims)
        :Ma () a t (ConstI oRnk) (Tmp szR) sz1
            :CpyD () (ADim t 0 (Just a)) (ADim xR 0 lX) dimsFromIn
            :CpyD () (ADim t dimsFromIn (Just a)) (ADim y0 0 lY0) (ConstI rnk1)
        :td=:DP t (ConstI oRnk)
        :PlProd () szY yDims
        :PlProd () kL xDims:i =: 0:j =: 0
            :fors tX k 0 ILt (Tmp kL) step
        :[Pop () slopE])
aeval (EApp T ()
_ (EApp T ()
_ (Builtin T ()
_ (Rank [(Int
0, Maybe [Int]
_)])) E (T ())
f) E (T ())
xs) Temp
t | Arr Sh ()
sh T ()
_ <- E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
xs, (Arrow T ()
tX T ()
tY) <- E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
f, Just Int64
szY <- T () -> Maybe Int64
forall b a. Integral b => T a -> Maybe b
nSz T ()
tY, T () -> Bool
forall a. T a -> Bool
nind T ()
tX = do
    a <- Temp -> CM AL
nextArr Temp
t
    rnkR <- newITemp; szR <- newITemp
    i <- newITemp; xRd <- newITemp; tD <- newITemp
    (plX, (lX, xR)) <- plA xs
    (step, pinches) <- aS f [(tX, Raw xRd (Tmp i) lX)] tY (Raw tD (Tmp i) (Just a))
    let loop=T () -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
forall {a}. T a -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
for (E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
xs) Temp
i CE
0 IRel
ILt (Temp -> CE
Tmp Temp
szR) [CS ()]
step
    pure (Just a, plX$rnkR =: eRnk sh (xR,lX):SZ () szR xR (Tmp rnkR) lX:Ma () a t (Tmp rnkR) (Tmp szR) szY:CpyD () (ADim t 0 (Just a)) (ADim xR 0 lX) (Tmp rnkR):xRd =: DP xR (Tmp rnkR):tD =: DP t (Tmp rnkR):sas pinches [loop])
aeval (EApp T ()
_ (EApp T ()
_ (EApp T ()
_ (Builtin T ()
_ (Rank [(Int
0, Maybe [Int]
_), (Int
0, Maybe [Int]
_)])) E (T ())
op) E (T ())
xs) E (T ())
ys) Temp
t | Arr Sh ()
sh T ()
_ <- E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
xs, Arrow T ()
tX (Arrow T ()
tY T ()
tC) <- E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
op, Just Int64
szC <- T () -> Maybe Int64
forall b a. Integral b => T a -> Maybe b
nSz T ()
tC, T () -> Bool
forall a. T a -> Bool
nind T ()
tX Bool -> Bool -> Bool
&& T () -> Bool
forall a. T a -> Bool
nind T ()
tY = do
    a <- Temp -> CM AL
nextArr Temp
t
    rnkR <- newITemp; szR <- newITemp
    xRd <- newITemp; yRd <- newITemp; tD <- newITemp
    (plX, (lX, xR)) <- plA xs; (plY, (lY, yR)) <- plA ys
    i <- newITemp
    (step, pinches) <- aS op [(tX, Raw xRd (Tmp i) lX), (tY, Raw yRd (Tmp i) lY)] tC (Raw tD (Tmp i) (Just a))
    let loop=T () -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
forall {a}. T a -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
for (E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
xs) Temp
i CE
0 IRel
ILt (Temp -> CE
Tmp Temp
szR) [CS ()]
step
    pure (Just a, plX $ plY $ rnkR =: eRnk sh (xR,lX):SZ () szR xR (Tmp rnkR) lX:Ma () a t (Tmp rnkR) (Tmp szR) szC:CpyD () (ADim t 0 (Just a)) (ADim xR 0 lX) (Tmp rnkR):xRd =: DP xR (Tmp rnkR):yRd =: DP yR (Tmp rnkR):tD =: DP t (Tmp rnkR):sas pinches [loop])
aeval (EApp T ()
_ (EApp T ()
_ (EApp T ()
_ (Builtin T ()
_ (Rank [(Int
0, Maybe [Int]
_), (Int
cr, Just [Int]
ixs)])) E (T ())
op) E (T ())
xs) E (T ())
ys) Temp
t | Just (T ()
yT, Int64
yRnk) <- T () -> Maybe (T (), Int64)
forall a. T a -> Maybe (T a, Int64)
tRnk (E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
ys)
                                                                                        , Just (T ()
_, Int64
xRnk) <- T () -> Maybe (T (), Int64)
forall a. T a -> Maybe (T a, Int64)
tRnk (E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
xs)
                                                                                        , (Arrow T ()
tX (Arrow T ()
_ T ()
tCod)) <- E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
op
                                                                                        , Just (T ()
tC, Int64
opRnk) <- T () -> Maybe (T (), Int64)
forall a. T a -> Maybe (T a, Int64)
tRnk T ()
tCod
                                                                                        , Just Int64
xSz <- T () -> Maybe Int64
forall b a. Integral b => T a -> Maybe b
nSz T ()
tX
                                                                                        , T () -> Bool
forall a. T a -> Bool
isIF T ()
yT Bool -> Bool -> Bool
&& T () -> Bool
forall a. T a -> Bool
isIF T ()
tC = do
    a <- Temp -> CM AL
nextArr Temp
t
    zR <- newITemp
    (plX, (lX, xR)) <- plA xs; (plY, (lY, yR)) <- plA ys
    slopP <- newITemp
    let ixsIs = [Int] -> IntSet
IS.fromList [Int]
ixs; allIx = [ if Int
ix Int -> IntSet -> Bool
`IS.member` IntSet
ixsIs then () -> RI () ()
forall a b. b -> RI a b
Index() else () -> RI () ()
forall a b. a -> RI a b
Cell() | Int
ix <- [Int
1..Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
yRnk] ]
    oSz <- newITemp; slopSz <- newITemp; zSz <- newITemp
    ix <- newITemp; it <- newITemp
    slopE <- newITemp
    (dts, dss) <- plDim yRnk (yR, lY)
    (sts, sssϵ) <- offByDim (reverse dts)
    let _:sstrides = sts; sss=[CS ()] -> [CS ()]
forall a. HasCallStack => [a] -> [a]
init [CS ()]
sssϵ
        allDims = (RI () () -> Temp -> RI Temp Temp)
-> [RI () ()] -> [Temp] -> [RI Temp Temp]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\RI () ()
ixϵ Temp
dt -> case RI () ()
ixϵ of {Cell{} -> Temp -> RI Temp Temp
forall a b. a -> RI a b
Cell Temp
dt; Index{} -> Temp -> RI Temp Temp
forall a b. b -> RI a b
Index Temp
dt}) [RI () ()]
allIx [Temp]
dts
        ~(oDims, complDims) = part allDims
        slopRnk=Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
cr::Int64; oRnk=Int64
yRnkInt64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+Int64
opRnkInt64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
-Int64
slopRnk
    (x, pAX, pinch) <- arg tX (AElem xR (ConstI xRnk) (Tmp ix) lX xSz)
    (lZ, ss) <- writeF op [ra x, AA slopP Nothing] (IT zR)
    let ecArg = (Temp -> RI () () -> Cell a Temp)
-> [Temp] -> [RI () ()] -> [Cell a Temp]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Temp
d RI () ()
tt -> case (Temp
d,RI () ()
tt) of (Temp
dϵ,Index{}) -> Temp -> Cell a Temp
forall a b. b -> Cell a b
Bound Temp
dϵ; (Temp
_,Cell{}) -> Cell a Temp
forall a b. Cell a b
Fixed) [Temp]
dts [RI () ()]
allIx
    yRd <- newITemp; slopPd <- newITemp
    (complts, place) <- extrCell ecArg sstrides (yRd, lY) slopPd
    let loop=[Temp] -> [CE] -> [CS ()] -> [CS ()]
forAll [Temp]
complts (Temp -> CE
Tmp(Temp -> CE) -> [Temp] -> [CE]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>[Temp]
oDims) ([CS ()] -> [CS ()]) -> [CS ()] -> [CS ()]
forall a b. (a -> b) -> a -> b
$ CS ()
pAXCS () -> [CS ()] -> [CS ()]
forall a. a -> [a] -> [a]
:[CS ()]
place [CS ()] -> [CS ()] -> [CS ()]
forall a. [a] -> [a] -> [a]
++ [CS ()]
ss [CS ()] -> [CS ()] -> [CS ()]
forall a. [a] -> [a] -> [a]
++ [() -> ArrAcc -> ArrAcc -> CE -> Int64 -> CS ()
forall a. a -> ArrAcc -> ArrAcc -> CE -> Int64 -> CS a
CpyE () (Temp -> CE -> CE -> Maybe AL -> Int64 -> ArrAcc
AElem Temp
t (Int64 -> CE
ConstI Int64
oRnk) (Temp -> CE
Tmp Temp
it) (AL -> Maybe AL
forall a. a -> Maybe a
Just AL
a) Int64
8) (Temp -> CE -> CE -> Maybe AL -> Int64 -> ArrAcc
AElem Temp
zR (Int64 -> CE
ConstI Int64
opRnk) CE
0 Maybe AL
lZ Int64
forall a. HasCallStack => a
undefined) (Temp -> CE
Tmp Temp
zSz) Int64
8, Temp
ixTemp -> CE -> CS ()
+=CE
1, Temp
itTemp -> CE -> CS ()
+=Temp -> CE
Tmp Temp
zSz]
    (dots, doss) <- plDim opRnk (zR, lZ)
    pure (Just a,
        plX$
        plY$
        dss
        ++PlProd () slopSz (Tmp<$>complDims)
            :slopE =: Bin IAsl (Tmp slopSz+ConstI (slopRnk+1)) 3
            :Sa () slopP (Tmp slopE):Wr () (ARnk slopP Nothing) (ConstI slopRnk)
            :diml (slopP, Nothing) (Tmp<$>complDims)
        ++[tϵ=:0 | tϵ <- complts]
        ++mt (AElem xR (ConstI xRnk) 0 lX undefined) x
        :sss
        ++yRd =: DP yR (ConstI yRnk):slopPd =: DP slopP (ConstI slopRnk)
        :place
        ++ss
        ++doss
        ++PlProd () zSz (Tmp<$>dots)
        :PlProd () oSz (Tmp<$>(zSz:oDims))
            :Ma () a t (ConstI oRnk) (Tmp oSz) 8
            :diml (t, Just a) (Tmp<$>(oDims++dots))
        ++ix=:0:it=:0:m'p pinch loop
        ++[Pop () (Tmp slopE)])
aeval (EApp T ()
_ (EApp T ()
_ (Builtin T ()
_ (Rank [(Int
cr, Just [Int]
ixs)])) E (T ())
f) E (T ())
xs) Temp
t | Just (T ()
tA, Int64
rnk) <- T () -> Maybe (T (), Int64)
forall a. T a -> Maybe (T a, Int64)
tRnk (E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
xs)
                                                                    , (Arrow T ()
_ T ()
tC) <- E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
f
                                                                    , Just Int64
ySz <- T () -> Maybe Int64
forall b a. Integral b => T a -> Maybe b
nSz T ()
tC, T () -> Bool
forall a. T a -> Bool
isIF T ()
tA = do
    a <- Temp -> CM AL
nextArr Temp
t
    (plX, (lX, xR)) <- plA xs
    slopP <- newITemp
    let ixsIs = [Int] -> IntSet
IS.fromList [Int]
ixs; allIx = [ if Int
ix Int -> IntSet -> Bool
`IS.member` IntSet
ixsIs then () -> RI () ()
forall a b. b -> RI a b
Index() else () -> RI () ()
forall a b. a -> RI a b
Cell() | Int
ix <- [Int
1..Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
rnk] ]
    oSz <- newITemp; slopSz <- newITemp; slopE <- newITemp
    di <- newITemp
    (dts, dss) <- plDim rnk (xR, lX)
    (sts, sssϵ) <- offByDim (reverse dts)
    let _:sstrides = sts; sss=[CS ()] -> [CS ()]
forall a. HasCallStack => [a] -> [a]
init [CS ()]
sssϵ
        allDims = (RI () () -> Temp -> RI Temp Temp)
-> [RI () ()] -> [Temp] -> [RI Temp Temp]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\RI () ()
ix Temp
dt -> case RI () ()
ix of {Cell{} -> Temp -> RI Temp Temp
forall a b. a -> RI a b
Cell Temp
dt; Index{} -> Temp -> RI Temp Temp
forall a b. b -> RI a b
Index Temp
dt}) [RI () ()]
allIx [Temp]
dts
        ~(oDims, complDims) = part allDims
        oRnk=Int64
rnkInt64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
-Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
cr; slopRnk=Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
cr::Int64
    (y, wY, pinch) <- rW tC (AElem t (ConstI oRnk) (Tmp di) Nothing ySz)
    (_, ss) <- writeF f [AA slopP Nothing] y
    let ecArg = (Temp -> RI () () -> Cell a Temp)
-> [Temp] -> [RI () ()] -> [Cell a Temp]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Temp
d RI () ()
tt -> case (Temp
d,RI () ()
tt) of (Temp
dϵ,Index{}) -> Temp -> Cell a Temp
forall a b. b -> Cell a b
Bound Temp
dϵ; (Temp
_,Cell{}) -> Cell a Temp
forall a b. Cell a b
Fixed) [Temp]
dts [RI () ()]
allIx
    xRd <- newITemp; slopPd <- newITemp
    (complts, place) <- extrCell ecArg sstrides (xRd, lX) slopPd
    let loop=[Temp] -> [CE] -> [CS ()] -> [CS ()]
forAll [Temp]
complts (Temp -> CE
Tmp(Temp -> CE) -> [Temp] -> [CE]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>[Temp]
oDims) ([CS ()] -> [CS ()]) -> [CS ()] -> [CS ()]
forall a b. (a -> b) -> a -> b
$ [CS ()]
place [CS ()] -> [CS ()] -> [CS ()]
forall a. [a] -> [a] -> [a]
++ [CS ()]
ss [CS ()] -> [CS ()] -> [CS ()]
forall a. [a] -> [a] -> [a]
++ [CS ()
wY, Temp
diTemp -> CE -> CS ()
+=CE
1]
    pure (Just a,
        plX $ dss
        ++PlProd () slopSz (Tmp<$>complDims)
            :slopE =: Bin IAsl (Tmp slopSz+ConstI (slopRnk+1)) 3
            :Sa () slopP (Tmp slopE):Wr () (ARnk slopP Nothing) (ConstI slopRnk)
            :diml (slopP, Nothing) (Tmp<$>complDims)
        ++PlProd () oSz (Tmp<$>oDims)
            :Ma () a t (ConstI oRnk) (Tmp oSz) ySz
            :diml (t, Just a) (Tmp<$>oDims)
        ++sss
        ++xRd =: DP xR (ConstI rnk):slopPd =: DP slopP (ConstI slopRnk):di =: 0:m'p pinch loop
        ++[Pop () (Tmp slopE)])
aeval (EApp T ()
tO (EApp T ()
_ (Builtin T ()
_ (Rank [(Int
cr, Just [Int]
ixs)])) E (T ())
f) E (T ())
xs) Temp
t | Just (T ()
tA, Int64
xRnk) <- T () -> Maybe (T (), Int64)
forall a. T a -> Maybe (T a, Int64)
tRnk (E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
xs)
                                                                    , Just {} <- T () -> Maybe (T ())
forall a. T a -> Maybe (T a)
mIF T ()
tO
                                                                    , (Arrow T ()
_ T ()
tCod) <- E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
f
                                                                    , Just (T ()
_, Int64
opRnk) <- T () -> Maybe (T (), Int64)
forall a. T a -> Maybe (T a, Int64)
tRnk T ()
tCod
                                                                    , T () -> Bool
forall a. T a -> Bool
isIF T ()
tA = do
    a <- Temp -> CM AL
nextArr Temp
t
    (plX, (lX, xR)) <- plA xs
    slopP <- newITemp
    let ixIs = [Int] -> IntSet
IS.fromList [Int]
ixs; allIx = [ if Int
ix Int -> IntSet -> Bool
`IS.member` IntSet
ixIs then () -> RI () ()
forall a b. b -> RI a b
Index() else () -> RI () ()
forall a b. a -> RI a b
Cell() | Int
ix <- [Int
1..Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
xRnk] ]
    yR <- newITemp; ySz <- newITemp
    (dts,dss) <- plDim xRnk (xR,lX)
    (sts, sssϵ) <- offByDim (reverse dts)
    let _:sstrides = sts; sss=[CS ()] -> [CS ()]
forall a. HasCallStack => [a] -> [a]
init [CS ()]
sssϵ
        allDims = (RI () () -> Temp -> RI Temp Temp)
-> [RI () ()] -> [Temp] -> [RI Temp Temp]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\RI () ()
ix Temp
dt -> case RI () ()
ix of {Cell{} -> Temp -> RI Temp Temp
forall a b. a -> RI a b
Cell Temp
dt; Index{} -> Temp -> RI Temp Temp
forall a b. b -> RI a b
Index Temp
dt}) [RI () ()]
allIx [Temp]
dts
        ~(oDims, complDims) = part allDims
        slopRnk=Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
cr::Int64; oRnk=Int64
xRnkInt64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+Int64
opRnkInt64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
-Int64
slopRnk
    (lY, ss) <- writeF f [AA slopP Nothing] (IT yR)
    let ecArg = (Temp -> RI () () -> Cell a Temp)
-> [Temp] -> [RI () ()] -> [Cell a Temp]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Temp
d RI () ()
tt -> case (Temp
d,RI () ()
tt) of (Temp
dϵ,Index{}) -> Temp -> Cell a Temp
forall a b. b -> Cell a b
Bound Temp
dϵ; (Temp
_,Cell{}) -> Cell a Temp
forall a b. Cell a b
Fixed) [Temp]
dts [RI () ()]
allIx
    xRd <- newITemp; slopPd <- newITemp; slopSz <- newITemp
    slopE <- newITemp; oSz <- newITemp
    (complts, place) <- extrCell ecArg sstrides (xRd, lX) slopPd
    it <- newITemp
    let loop=[Temp] -> [CE] -> [CS ()] -> [CS ()]
forAll [Temp]
complts (Temp -> CE
Tmp(Temp -> CE) -> [Temp] -> [CE]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>[Temp]
oDims)
                ([CS ()] -> [CS ()]) -> [CS ()] -> [CS ()]
forall a b. (a -> b) -> a -> b
$ [CS ()]
place [CS ()] -> [CS ()] -> [CS ()]
forall a. [a] -> [a] -> [a]
++ [CS ()]
ss [CS ()] -> [CS ()] -> [CS ()]
forall a. [a] -> [a] -> [a]
++ [() -> ArrAcc -> ArrAcc -> CE -> Int64 -> CS ()
forall a. a -> ArrAcc -> ArrAcc -> CE -> Int64 -> CS a
CpyE () (Temp -> CE -> CE -> Maybe AL -> Int64 -> ArrAcc
AElem Temp
t (Int64 -> CE
ConstI Int64
oRnk) (Temp -> CE
Tmp Temp
it) (AL -> Maybe AL
forall a. a -> Maybe a
Just AL
a) Int64
8) (Temp -> CE -> CE -> Maybe AL -> Int64 -> ArrAcc
AElem Temp
yR (Int64 -> CE
ConstI Int64
opRnk) CE
0 Maybe AL
lY Int64
forall a. HasCallStack => a
undefined) (Temp -> CE
Tmp Temp
ySz) Int64
8, Temp
itTemp -> CE -> CS ()
+=Temp -> CE
Tmp Temp
ySz]
    (dots, doss) <- plDim opRnk (yR, lY)
    pure (Just a,
        plX $
        dss
        ++PlProd () slopSz (Tmp<$>complDims)
            :slopE =: Bin IAsl (Tmp slopSz+ConstI (slopRnk+1)) 3
            :Sa () slopP (Tmp slopE):Wr () (ARnk slopP Nothing) (ConstI slopRnk)
            :diml (slopP, Nothing) (Tmp<$>complDims)
        ++[tϵ=:0 | tϵ <- complts]
        ++sss
        ++xRd=:DP xR (ConstI xRnk):slopPd=:DP slopP (ConstI slopRnk)
        :place
        ++ss
        ++doss
        ++PlProd () ySz (Tmp<$>dots)
        :PlProd () oSz (Tmp<$>(ySz:oDims))
            :Ma () a t (ConstI oRnk) (Tmp oSz) 8
            :diml (t, Just a) (Tmp<$>(oDims++dots))
        ++it=:0:loop
        ++[Pop () (Tmp slopE)]
        )
aeval (EApp T ()
_ (EApp T ()
_ (Builtin T ()
_ Builtin
CatE) E (T ())
x) E (T ())
y) Temp
t | T ()
tX <- E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
x, Just (T ()
ty, Int64
1) <- T () -> Maybe (T (), Int64)
forall a. T a -> Maybe (T a, Int64)
tRnk T ()
tX = do
    xnR <- CM Temp
newITemp; ynR <- newITemp; tn <- newITemp
    let tyN=T () -> Int64
forall b a. Integral b => T a -> b
bT T ()
ty
    (a,aV) <- vSz t (Tmp tn) tyN
    (plX, (lX, xR)) <- plA x; (plY, (lY, yR)) <- plA y
    pure (Just a, plX $ plY $ xnR =: ev tX (xR,lX):ynR =: ev (eAnn y) (yR,lY):tn =: (Tmp xnR+Tmp ynR):aV++CpyE () (AElem t 1 0 (Just a) tyN) (AElem xR 1 0 lX tyN) (Tmp xnR) tyN:[CpyE () (AElem t 1 (Tmp xnR) (Just a) tyN) (AElem yR 1 0 lY tyN) (Tmp ynR) tyN])
aeval (EApp T ()
ty (EApp T ()
_ (EApp T ()
_ (Builtin T ()
_ Builtin
IRange) E (T ())
start) E (T ())
end) (ILit T ()
_ Integer
1)) Temp
t = do
    n <- CM Temp
newITemp; startR <- newITemp; endR <- newITemp
    (a,aV) <- v8 t (Tmp n)
    i <- newITemp
    pStart <- eval start startR; pEnd <- eval end endR
    let pN=Temp
n Temp -> CE -> CS ()
=: ((Temp -> CE
Tmp Temp
endR CE -> CE -> CE
forall a. Num a => a -> a -> a
- Temp -> CE
Tmp Temp
startR)CE -> CE -> CE
forall a. Num a => a -> a -> a
+CE
1)
        loop=T () -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
forall {a}. T a -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
for T ()
ty Temp
i CE
0 IRel
ILt (Temp -> CE
Tmp Temp
n) [() -> ArrAcc -> CE -> CS ()
forall a. a -> ArrAcc -> CE -> CS a
Wr () (Temp -> CE -> CE -> Maybe AL -> Int64 -> ArrAcc
AElem Temp
t CE
1 (Temp -> CE
Tmp Temp
i) (AL -> Maybe AL
forall a. a -> Maybe a
Just AL
a) Int64
8) (Temp -> CE
Tmp Temp
startR), Temp
startRTemp -> CE -> CS ()
+=CE
1]
    pure (Just a, pStart++pEnd++pN:aV++[loop])
aeval (EApp T ()
ty (EApp T ()
_ (EApp T ()
_ (Builtin T ()
_ Builtin
IRange) E (T ())
start) E (T ())
end) E (T ())
incr) Temp
t = do
    n <- CM Temp
newITemp; startR <- newITemp; endR <- newITemp; incrR <- newITemp
    (a,aV) <- v8 t (Tmp n)
    i <- newITemp
    pStart <- eval start startR; pEnd <- eval end endR; pIncr <- eval incr incrR
    let pN=Temp
n Temp -> CE -> CS ()
=: (IBin -> CE -> CE -> CE
Bin IBin
Op.IDiv (Temp -> CE
Tmp Temp
endR CE -> CE -> CE
forall a. Num a => a -> a -> a
- Temp -> CE
Tmp Temp
startR) (Temp -> CE
Tmp Temp
incrR)CE -> CE -> CE
forall a. Num a => a -> a -> a
+CE
1)
        loop=T () -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
forall {a}. T a -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
for T ()
ty Temp
i CE
0 IRel
ILt (Temp -> CE
Tmp Temp
n) [() -> ArrAcc -> CE -> CS ()
forall a. a -> ArrAcc -> CE -> CS a
Wr () (Temp -> CE -> CE -> Maybe AL -> Int64 -> ArrAcc
AElem Temp
t CE
1 (Temp -> CE
Tmp Temp
i) (AL -> Maybe AL
forall a. a -> Maybe a
Just AL
a) Int64
8) (Temp -> CE
Tmp Temp
startR), Temp
startRTemp -> CE -> CS ()
+=Temp -> CE
Tmp Temp
incrR]
    pure (Just a, pStart++pEnd++pIncr++pN:aV++[loop])
aeval (EApp T ()
ty (EApp T ()
_ (EApp T ()
_ (Builtin T ()
_ Builtin
FRange) E (T ())
start) E (T ())
end) E (T ())
steps) Temp
t = do
    i <- CM Temp
newITemp
    startR <- newFTemp; incrR <- newFTemp; n <- newITemp
    (a,aV) <- v8 t (Tmp n)
    putStart <- feval start startR; putN <- eval steps n
    putIncr <- feval ((end `eMinus` start) `eDiv` (EApp F (Builtin (Arrow I F) ItoF) steps `eMinus` FLit F 1)) incrR
    let loop=T () -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
forall {a}. T a -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
for T ()
ty Temp
i CE
0 IRel
ILt (Temp -> CE
Tmp Temp
n) [() -> ArrAcc -> CFE -> CS ()
forall a. a -> ArrAcc -> CFE -> CS a
WrF () (Temp -> CE -> CE -> Maybe AL -> Int64 -> ArrAcc
AElem Temp
t CE
1 (Temp -> CE
Tmp Temp
i) (AL -> Maybe AL
forall a. a -> Maybe a
Just AL
a) Int64
8) (FTemp -> CFE
FTmp FTemp
startR), () -> FTemp -> CFE -> CS ()
forall a. a -> FTemp -> CFE -> CS a
MX () FTemp
startR (FTemp -> CFE
FTmp FTemp
startRCFE -> CFE -> CFE
forall a. Num a => a -> a -> a
+FTemp -> CFE
FTmp FTemp
incrR)]
    pure (Just a, putStart++putIncr++putN++aV++[loop])
aeval (EApp T ()
res (EApp T ()
_ (Builtin T ()
_ Builtin
Cyc) E (T ())
xs) E (T ())
n) Temp
t | Just Int64
sz <- T () -> Maybe Int64
forall b a. Integral b => T a -> Maybe b
aB T ()
res = do
    i <- CM Temp
newITemp; nR <- newITemp; nO <- newITemp; szR <- newITemp
    (a,aV) <- vSz t (Tmp nO) sz
    (plX, (lX, xR)) <- plA xs
    plN <- eval n nR
    ix <- newITemp
    let loop=T () -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
forall {a}. T a -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
for T ()
res Temp
i CE
0 IRel
ILt (Temp -> CE
Tmp Temp
nR) [() -> ArrAcc -> ArrAcc -> CE -> Int64 -> CS ()
forall a. a -> ArrAcc -> ArrAcc -> CE -> Int64 -> CS a
CpyE () (Temp -> CE -> CE -> Maybe AL -> Int64 -> ArrAcc
AElem Temp
t CE
1 (Temp -> CE
Tmp Temp
ix) (AL -> Maybe AL
forall a. a -> Maybe a
Just AL
a) Int64
sz) (Temp -> CE -> CE -> Maybe AL -> Int64 -> ArrAcc
AElem Temp
xR CE
1 CE
0 Maybe AL
lX Int64
sz) (Temp -> CE
Tmp Temp
szR) Int64
sz, Temp
ixTemp -> CE -> CS ()
+=Temp -> CE
Tmp Temp
szR]
    pure (Just a, plX $ plN ++ szR =: ev (eAnn xs) (xR,lX):nO =: (Tmp szR*Tmp nR):aV++ix =: 0:[loop])
aeval (EApp T ()
_ (EApp T ()
_ (Builtin T ()
_ Builtin
VMul) E (T ())
a) E (T ())
x) Temp
t | Just (T ()
F, [Int64
m,Int64
n]) <- T () -> Maybe (T (), [Int64])
forall a. T a -> Maybe (T a, [Int64])
tIx(T () -> Maybe (T (), [Int64])) -> T () -> Maybe (T (), [Int64])
forall a b. (a -> b) -> a -> b
$E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
a, Just Int64
s <- Int64 -> Maybe Int64
forall a. FiniteBits a => a -> Maybe Int64
cLog Int64
n = do
    i <- CM Temp
newITemp; j <- newITemp; mR <- newITemp; nR <- newITemp; z <- newFTemp
    (aL,aV) <- v8 t (Tmp mR)
    (plAA, (lA, aR)) <- plA a; (plX, (lX, xR)) <- plA x
    let loop = () -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
forall a. a -> Temp -> CE -> IRel -> CE -> [CS a] -> CS a
For () Temp
i CE
0 IRel
ILt (Temp -> CE
Tmp Temp
mR)
                  [ () -> FTemp -> CFE -> CS ()
forall a. a -> FTemp -> CFE -> CS a
MX () FTemp
z CFE
0,
                    T () -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
forall {a}. T a -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
for (E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
x) Temp
j CE
0 IRel
ILt (Temp -> CE
Tmp Temp
nR)
                        [ () -> FTemp -> CFE -> CS ()
forall a. a -> FTemp -> CFE -> CS a
MX () FTemp
z (FTemp -> CFE
FTmp FTemp
zCFE -> CFE -> CFE
forall a. Num a => a -> a -> a
+ArrAcc -> CFE
FAt (Temp -> CE -> CE -> Maybe AL -> Int64 -> ArrAcc
AElem Temp
aR CE
2 (IBin -> CE -> CE -> CE
Bin IBin
IAsl (Temp -> CE
Tmp Temp
i) (Int64 -> CE
ConstI Int64
s)CE -> CE -> CE
forall a. Num a => a -> a -> a
+Temp -> CE
Tmp Temp
j) Maybe AL
lA Int64
8)CFE -> CFE -> CFE
forall a. Num a => a -> a -> a
*ArrAcc -> CFE
FAt (Temp -> CE -> CE -> Maybe AL -> Int64 -> ArrAcc
AElem Temp
xR CE
1 (Temp -> CE
Tmp Temp
j) Maybe AL
lX Int64
8)) ]
                  , () -> ArrAcc -> CFE -> CS ()
forall a. a -> ArrAcc -> CFE -> CS a
WrF () (Temp -> CE -> CE -> Maybe AL -> Int64 -> ArrAcc
AElem Temp
t CE
1 (Temp -> CE
Tmp Temp
i) (AL -> Maybe AL
forall a. a -> Maybe a
Just AL
aL) Int64
8) (FTemp -> CFE
FTmp FTemp
z)
                  ]
    pure (Just aL,
        plAA$
        plX$
        mR=:ConstI m
        :aV
        ++nR=:ConstI n
        :[loop])
aeval (EApp T ()
_ (EApp T ()
_ (Builtin T ()
_ Builtin
VMul) (EApp T ()
_ (Builtin T ()
_ Builtin
T) E (T ())
a)) E (T ())
x) Temp
t | T () -> Bool
forall a. T a -> Bool
f1 T ()
tX = do
    i <- CM Temp
newITemp; j <- newITemp; m <- newITemp; n <- newITemp; z <- newFTemp
    (aL,aV) <- v8 t (Tmp m)
    (plAA, (lA, aR)) <- plA a; (plX, (lX, xR)) <- plA x
    let loop = T () -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
forall {a}. T a -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
forc (E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
a) Temp
i CE
0 IRel
ILt (Temp -> CE
Tmp Temp
m)
                [ () -> FTemp -> CFE -> CS ()
forall a. a -> FTemp -> CFE -> CS a
MX () FTemp
z CFE
0,
                  T () -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
forall {a}. T a -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
for T ()
tX Temp
j CE
0 IRel
ILt (Temp -> CE
Tmp Temp
n)
                      [ () -> FTemp -> CFE -> CS ()
forall a. a -> FTemp -> CFE -> CS a
MX () FTemp
z (FTemp -> CFE
FTmp FTemp
zCFE -> CFE -> CFE
forall a. Num a => a -> a -> a
+ArrAcc -> CFE
FAt (Temp -> CE -> CE -> Maybe AL -> Int64 -> ArrAcc
AElem Temp
aR CE
2 (Temp -> CE
Tmp Temp
mCE -> CE -> CE
forall a. Num a => a -> a -> a
*Temp -> CE
Tmp Temp
jCE -> CE -> CE
forall a. Num a => a -> a -> a
+Temp -> CE
Tmp Temp
i) Maybe AL
lA Int64
8)CFE -> CFE -> CFE
forall a. Num a => a -> a -> a
*ArrAcc -> CFE
FAt (Temp -> CE -> CE -> Maybe AL -> Int64 -> ArrAcc
AElem Temp
xR CE
1 (Temp -> CE
Tmp Temp
j) Maybe AL
lX Int64
8)) ]
                , () -> ArrAcc -> CFE -> CS ()
forall a. a -> ArrAcc -> CFE -> CS a
WrF () (Temp -> CE -> CE -> Maybe AL -> Int64 -> ArrAcc
AElem Temp
t CE
1 (Temp -> CE
Tmp Temp
i) (AL -> Maybe AL
forall a. a -> Maybe a
Just AL
aL) Int64
8) (FTemp -> CFE
FTmp FTemp
z)
                ]
    pure (Just aL,
        plAA$
        plX$
        m=:ec tA (aR,lA)
        :aV
        ++n=:ev tX (xR,lX)
        :[loop])
  where
    tA :: T ()
tA=E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
a; tX :: T ()
tX=E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
x
aeval (EApp T ()
_ (EApp T ()
_ (Builtin T ()
_ Builtin
VMul) E (T ())
a) E (T ())
x) Temp
t | T () -> Bool
forall a. T a -> Bool
f1 T ()
tX = do
    i <- CM Temp
newITemp; j <- newITemp; m <- newITemp; n <- newITemp; z <- newFTemp
    (aL,aV) <- v8 t (Tmp m)
    (plAA, (lA, aR)) <- plA a; (plX, (lX, xR)) <- plA x
    let loop = T () -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
forall {a}. T a -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
for T ()
tA Temp
i CE
0 IRel
ILt (Temp -> CE
Tmp Temp
m)
                  [ () -> FTemp -> CFE -> CS ()
forall a. a -> FTemp -> CFE -> CS a
MX () FTemp
z CFE
0,
                    T () -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
forall {a}. T a -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
for T ()
tX Temp
j CE
0 IRel
ILt (Temp -> CE
Tmp Temp
n)
                        [ () -> FTemp -> CFE -> CS ()
forall a. a -> FTemp -> CFE -> CS a
MX () FTemp
z (FTemp -> CFE
FTmp FTemp
zCFE -> CFE -> CFE
forall a. Num a => a -> a -> a
+ArrAcc -> CFE
FAt (Temp -> CE -> CE -> Maybe AL -> Int64 -> ArrAcc
AElem Temp
aR CE
2 (Temp -> CE
Tmp Temp
nCE -> CE -> CE
forall a. Num a => a -> a -> a
*Temp -> CE
Tmp Temp
iCE -> CE -> CE
forall a. Num a => a -> a -> a
+Temp -> CE
Tmp Temp
j) Maybe AL
lA Int64
8)CFE -> CFE -> CFE
forall a. Num a => a -> a -> a
*ArrAcc -> CFE
FAt (Temp -> CE -> CE -> Maybe AL -> Int64 -> ArrAcc
AElem Temp
xR CE
1 (Temp -> CE
Tmp Temp
j) Maybe AL
lX Int64
8)) ]
                  , () -> ArrAcc -> CFE -> CS ()
forall a. a -> ArrAcc -> CFE -> CS a
WrF () (Temp -> CE -> CE -> Maybe AL -> Int64 -> ArrAcc
AElem Temp
t CE
1 (Temp -> CE
Tmp Temp
i) (AL -> Maybe AL
forall a. a -> Maybe a
Just AL
aL) Int64
8) (FTemp -> CFE
FTmp FTemp
z)
                  ]
    pure (Just aL,
        plAA$
        plX$
        m=:ev tA (aR,lA)
        :aV
        ++n=:ev tX (xR,lX)
        :[loop])
  where
    tA :: T ()
tA=E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
a; tX :: T ()
tX=E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
x
aeval (EApp T ()
_ (EApp T ()
_ (Builtin T ()
_ Builtin
Mul) (EApp T ()
_ (Builtin T ()
_ Builtin
T) E (T ())
a)) E (T ())
b) Temp
t | Just (T ()
F, Int64
_) <- T () -> Maybe (T (), Int64)
forall a. T a -> Maybe (T a, Int64)
tRnk T ()
tA = do
    aL <- Temp -> CM AL
nextArr Temp
t
    i <- newITemp; j <- newITemp; k <- newITemp; m <- newITemp; n <- newITemp; o <- newITemp; z <- newFTemp
    (plAA, (lA, aR)) <- plA a
    (plB, (lB, bR)) <- plA b
    let loop=T () -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
forall {a}. T a -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
forc T ()
tA Temp
i CE
0 IRel
ILt (Temp -> CE
Tmp Temp
m)
                [T () -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
forall {a}. T a -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
forc (E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
b) Temp
j CE
0 IRel
ILt (Temp -> CE
Tmp Temp
o)
                    [ () -> FTemp -> CFE -> CS ()
forall a. a -> FTemp -> CFE -> CS a
MX () FTemp
z CFE
0, T () -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
forall {a}. T a -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
for T ()
tA Temp
k CE
0 IRel
ILt (Temp -> CE
Tmp Temp
n)
                        [() -> FTemp -> CFE -> CS ()
forall a. a -> FTemp -> CFE -> CS a
MX () FTemp
z (FTemp -> CFE
FTmp FTemp
zCFE -> CFE -> CFE
forall a. Num a => a -> a -> a
+ArrAcc -> CFE
FAt (Temp -> CE -> CE -> Maybe AL -> Int64 -> ArrAcc
AElem Temp
aR CE
2 (Temp -> CE
Tmp Temp
kCE -> CE -> CE
forall a. Num a => a -> a -> a
*Temp -> CE
Tmp Temp
mCE -> CE -> CE
forall a. Num a => a -> a -> a
+Temp -> CE
Tmp Temp
i) Maybe AL
lA Int64
8)CFE -> CFE -> CFE
forall a. Num a => a -> a -> a
*ArrAcc -> CFE
FAt (Temp -> CE -> CE -> Maybe AL -> Int64 -> ArrAcc
AElem Temp
bR CE
2 (Temp -> CE
Tmp Temp
kCE -> CE -> CE
forall a. Num a => a -> a -> a
*Temp -> CE
Tmp Temp
oCE -> CE -> CE
forall a. Num a => a -> a -> a
+Temp -> CE
Tmp Temp
j) Maybe AL
lB Int64
8))]
                    , () -> ArrAcc -> CFE -> CS ()
forall a. a -> ArrAcc -> CFE -> CS a
WrF () (Temp -> CE -> CE -> Maybe AL -> Int64 -> ArrAcc
AElem Temp
t CE
2 (Temp -> CE
Tmp Temp
iCE -> CE -> CE
forall a. Num a => a -> a -> a
*Temp -> CE
Tmp Temp
oCE -> CE -> CE
forall a. Num a => a -> a -> a
+Temp -> CE
Tmp Temp
j) (AL -> Maybe AL
forall a. a -> Maybe a
Just AL
aL) Int64
8) (FTemp -> CFE
FTmp FTemp
z)]
                ]
    pure (Just aL,
        plAA$
        plB$
        m=:ec tA (aR,lA):o=:ec tB (bR,lB)
        :Ma () aL t 2 (Tmp m*Tmp o) 8:diml (t, Just aL) [Tmp m, Tmp o]
        ++n=:ev tA (aR,lA)
        :[loop])
  where
    tA :: T ()
tA=E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
a; tB :: T ()
tB=E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
b
aeval (EApp T ()
_ (EApp T ()
_ (Builtin T ()
_ Builtin
Mul) E (T ())
a) E (T ())
b) Temp
t | Just (T ()
F, Int64
_) <- T () -> Maybe (T (), Int64)
forall a. T a -> Maybe (T a, Int64)
tRnk T ()
tA = do
    aL <- Temp -> CM AL
nextArr Temp
t
    i <- newITemp; j <- newITemp; k <- newITemp; m <- newITemp; n <- newITemp; o <- newITemp; z <- newFTemp
    (plAA, (lA, aR)) <- plA a
    (plB, (lB, bR)) <- plA b
    let loop=T () -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
forall {a}. T a -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
for T ()
tA Temp
i CE
0 IRel
ILt (Temp -> CE
Tmp Temp
m)
                [T () -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
forall {a}. T a -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
forc T ()
tB Temp
j CE
0 IRel
ILt (Temp -> CE
Tmp Temp
o)
                    [ () -> FTemp -> CFE -> CS ()
forall a. a -> FTemp -> CFE -> CS a
MX () FTemp
z CFE
0, T () -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
forall {a}. T a -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
for T ()
tB Temp
k CE
0 IRel
ILt (Temp -> CE
Tmp Temp
n)
                              [() -> FTemp -> CFE -> CS ()
forall a. a -> FTemp -> CFE -> CS a
MX () FTemp
z (FTemp -> CFE
FTmp FTemp
zCFE -> CFE -> CFE
forall a. Num a => a -> a -> a
+ArrAcc -> CFE
FAt (Temp -> CE -> CE -> Maybe AL -> Int64 -> ArrAcc
AElem Temp
aR CE
2 (Temp -> CE
Tmp Temp
nCE -> CE -> CE
forall a. Num a => a -> a -> a
*Temp -> CE
Tmp Temp
iCE -> CE -> CE
forall a. Num a => a -> a -> a
+Temp -> CE
Tmp Temp
k) Maybe AL
lA Int64
8)CFE -> CFE -> CFE
forall a. Num a => a -> a -> a
*ArrAcc -> CFE
FAt (Temp -> CE -> CE -> Maybe AL -> Int64 -> ArrAcc
AElem Temp
bR CE
2 (Temp -> CE
Tmp Temp
kCE -> CE -> CE
forall a. Num a => a -> a -> a
*Temp -> CE
Tmp Temp
oCE -> CE -> CE
forall a. Num a => a -> a -> a
+Temp -> CE
Tmp Temp
j) Maybe AL
lB Int64
8))]
                    , () -> ArrAcc -> CFE -> CS ()
forall a. a -> ArrAcc -> CFE -> CS a
WrF () (Temp -> CE -> CE -> Maybe AL -> Int64 -> ArrAcc
AElem Temp
t CE
2 (Temp -> CE
Tmp Temp
iCE -> CE -> CE
forall a. Num a => a -> a -> a
*Temp -> CE
Tmp Temp
oCE -> CE -> CE
forall a. Num a => a -> a -> a
+Temp -> CE
Tmp Temp
j) (AL -> Maybe AL
forall a. a -> Maybe a
Just AL
aL) Int64
8) (FTemp -> CFE
FTmp FTemp
z)]
                    ]
    pure (Just aL,
        plAA$
        plB$
        m=:ev tA (aR,lA):o=:ec tB (bR,lB)
        :Ma () aL t 2 (Tmp m*Tmp o) 8:diml (t, Just aL) [Tmp m, Tmp o]
        ++n=:ev tB (bR,lB)
        :[loop])
  where
    tA :: T ()
tA=E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
a; tB :: T ()
tB=E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
b
aeval (EApp T ()
_ (EApp T ()
_ (Builtin T ()
_ Builtin
ConsE) E (T ())
x) E (T ())
xs) Temp
t | T ()
tX <- E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
x, Just Int64
sz <- T () -> Maybe Int64
forall b a. Integral b => T a -> Maybe b
rSz T ()
tX = do
    xR <- T () -> CM RT
forall a. T a -> CM RT
rtemp T ()
tX
    nR <- newITemp; nϵR <- newITemp
    (a,aV) <- vSz t (Tmp nR) sz
    plX <- eeval x xR
    (plXs, (l, xsR)) <- plA xs
    pure (Just a, plXs$plX++nϵR =: ev (eAnn xs) (xsR,l):nR =: (Tmp nϵR+1):aV++wt (AElem t 1 0 (Just a) sz) xR:[CpyE () (AElem t 1 1 (Just a) sz) (AElem xsR 1 0 l sz) (Tmp nϵR) sz])
aeval (EApp T ()
_ (EApp T ()
_ (Builtin T ()
_ Builtin
ConsE) E (T ())
x) E (T ())
xs) Temp
t | T ()
tX <- E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
x, T () -> Bool
forall a. T a -> Bool
isΠ T ()
tX, Int64
sz <- T () -> Int64
forall b a. Integral b => T a -> b
bT T ()
tX = do
    xR <- CM Temp
newITemp
    nR <- newITemp; nϵR <- newITemp
    (_, mSz, _, plX) <- πe x xR
    (plXs, (lX, xsR)) <- plA xs
    (a,aV) <- vSz t (Tmp nR) sz
    pure (Just a, plXs$m'sa xR mSz++plX++nϵR =: ev (eAnn xs) (xsR,lX):nR =: (Tmp nϵR+1):aV++[CpyE () (AElem t 1 0 (Just a) sz) (TupM xR Nothing) 1 sz, CpyE () (AElem t 1 1 (Just a) sz) (AElem xsR 1 0 lX sz) (Tmp nϵR) sz]++m'pop mSz)
aeval (EApp T ()
_ (EApp T ()
_ (Builtin T ()
_ Builtin
Snoc) E (T ())
x) E (T ())
xs) Temp
t | T ()
tX <- E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
x, Just Int64
sz <- T () -> Maybe Int64
forall b a. Integral b => T a -> Maybe b
rSz T ()
tX = do
    xR <- T () -> CM RT
forall a. T a -> CM RT
rtemp T ()
tX
    nR <- newITemp; nϵR <- newITemp
    (a,aV) <- vSz t (Tmp nR) sz
    plX <- eeval x xR
    (plXs, (l, xsR)) <- plA xs
    pure (Just a, plXs$plX++nϵR =: ev (eAnn xs) (xsR,l):nR =: (Tmp nϵR+1):aV++wt (AElem t 1 (Tmp nϵR) (Just a) sz) xR:[CpyE () (AElem t 1 0 (Just a) sz) (AElem xsR 1 0 l sz) (Tmp nϵR) sz])
aeval (EApp T ()
_ (EApp T ()
_ (Builtin T ()
_ Builtin
Snoc) E (T ())
x) E (T ())
xs) Temp
t | T ()
tX <- E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
x, T () -> Bool
forall a. T a -> Bool
isΠ T ()
tX, Int64
sz <- T () -> Int64
forall b a. Integral b => T a -> b
bT T ()
tX = do
    xR <- CM Temp
newITemp
    nR <- newITemp; nϵR <- newITemp
    (_, mSz, _, plX) <- πe x xR
    (plXs, (lX, xsR)) <- plA xs
    (a,aV) <- vSz t (Tmp nR) sz
    pure (Just a, plXs$m'sa xR mSz++plX++nϵR =: ev (eAnn xs) (xsR,lX):nR =: (Tmp nϵR+1):aV++[CpyE () (AElem t 1 (Tmp nϵR) (Just a) sz) (TupM xR Nothing) 1 sz, CpyE () (AElem t 1 0 (Just a) sz) (AElem xsR 1 0 lX sz) (Tmp nϵR) sz]++m'pop mSz)
aeval (EApp T ()
ty (EApp T ()
_ (Builtin T ()
_ Builtin
Re) E (T ())
n) E (T ())
x) Temp
t | T ()
tX <- E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
x, Just Int64
xSz <- T () -> Maybe Int64
forall b a. Integral b => T a -> Maybe b
rSz T ()
tX = do
    xR <- T () -> CM RT
forall a. T a -> CM RT
rtemp T ()
tX; nR <- newITemp
    (a,aV) <- vSz t (Tmp nR) xSz
    i <- newITemp
    putN <- eval n nR; putX <- eeval x xR
    let loop=T () -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
forall {a}. T a -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
for T ()
ty Temp
i CE
0 IRel
ILt (Temp -> CE
Tmp Temp
nR) [ArrAcc -> RT -> CS ()
wt (Temp -> CE -> CE -> Maybe AL -> Int64 -> ArrAcc
AElem Temp
t CE
1 (Temp -> CE
Tmp Temp
i) (AL -> Maybe AL
forall a. a -> Maybe a
Just AL
a) Int64
xSz) RT
xR]
    pure (Just a, putN++aV++putX++[loop])
aeval (EApp T ()
ty (EApp T ()
_ (Builtin T ()
_ Builtin
Re) E (T ())
n) E (T ())
x) Temp
t | T ()
tX <- E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
x, T () -> Bool
forall a. T a -> Bool
isΠ T ()
tX, Int64
sz <- T () -> Int64
forall b a. Integral b => T a -> b
bT T ()
tX = do
    xR <- CM Temp
newITemp; nR <- newITemp; k <- newITemp
    plN <- eval n nR
    (a,aV) <- vSz t (Tmp nR) sz
    (_, mSz, _, plX) <- πe x xR
    let loop = T () -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
forall {a}. T a -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
for T ()
ty Temp
k CE
0 IRel
ILt (Temp -> CE
Tmp Temp
nR) [() -> ArrAcc -> ArrAcc -> CE -> Int64 -> CS ()
forall a. a -> ArrAcc -> ArrAcc -> CE -> Int64 -> CS a
CpyE () (Temp -> CE -> CE -> Maybe AL -> Int64 -> ArrAcc
AElem Temp
t CE
1 (Temp -> CE
Tmp Temp
k) (AL -> Maybe AL
forall a. a -> Maybe a
Just AL
a) Int64
sz) (Temp -> Maybe AL -> ArrAcc
TupM Temp
xR Maybe AL
forall a. Maybe a
Nothing) CE
1 Int64
sz]
    pure (Just a, m'sa xR mSz++plX++plN++aV++loop:m'pop mSz)
aeval (EApp T ()
ty (EApp T ()
_ (Builtin T ()
_ Builtin
Re) E (T ())
n) E (T ())
x) Temp
t | (Arr Sh ()
sh T ()
tO) <- E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
x, Int64
sz <- T () -> Int64
forall b a. Integral b => T a -> b
bT T ()
tO = do
    a <- Temp -> CM AL
nextArr Temp
t
    nR <- newITemp; k <- newITemp
    (plX, (lX, xR)) <- plA x
    plN <- eval n nR
    xRnk <- newITemp; oRnk <- newITemp
    szX <- newITemp
    let loop = T () -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
forall {a}. T a -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
for T ()
ty Temp
k CE
0 IRel
ILt (Temp -> CE
Tmp Temp
nR) [() -> ArrAcc -> ArrAcc -> CE -> Int64 -> CS ()
forall a. a -> ArrAcc -> ArrAcc -> CE -> Int64 -> CS a
CpyE () (Temp -> CE -> CE -> Maybe AL -> Int64 -> ArrAcc
AElem Temp
t (Temp -> CE
Tmp Temp
oRnk) (Temp -> CE
Tmp Temp
kCE -> CE -> CE
forall a. Num a => a -> a -> a
*Temp -> CE
Tmp Temp
szX) (AL -> Maybe AL
forall a. a -> Maybe a
Just AL
a) Int64
sz) (Temp -> CE -> CE -> Maybe AL -> Int64 -> ArrAcc
AElem Temp
xR (Temp -> CE
Tmp Temp
xRnk) CE
0 Maybe AL
lX Int64
sz) (Temp -> CE
Tmp Temp
szX) Int64
sz]
    pure (Just a,
        plX$
        xRnk=:eRnk sh (xR,lX):oRnk=:(Tmp xRnk+1):SZ () szX xR (Tmp xRnk) lX
        :plN
        ++Ma () a t (Tmp oRnk) (Tmp szX*Tmp nR) sz:Wr () (ADim t 0 (Just a)) (Tmp nR):CpyD () (ADim t 1 (Just a)) (ADim xR 0 lX) (Tmp xRnk)
        :[loop])
aeval (EApp T ()
oTy (Builtin T ()
_ Builtin
Init) E (T ())
x) Temp
t | Just Int64
sz <- T () -> Maybe Int64
forall b a. Integral b => T a -> Maybe b
aB T ()
oTy = do
    nR <- CM Temp
newITemp
    (a,aV) <- vSz t (Tmp nR) sz
    (plX, (lX, xR)) <- plA x
    pure (Just a, plX$nR =: (ev (eAnn x) (xR,lX)-1):aV++[CpyE () (AElem t 1 0 (Just a) sz) (AElem xR 1 0 lX sz) (Tmp nR) sz])
aeval (EApp T ()
oTy (Builtin T ()
_ Builtin
InitM) E (T ())
x) Temp
t | Just Int64
sz <- T () -> Maybe Int64
forall b a. Integral b => T a -> Maybe b
aB T ()
oTy = do
    nR <- CM Temp
newITemp
    (a,aV) <- vSz t (Bin IMax (Tmp nR) 0) sz
    (plX, (lX, xR)) <- plA x
    pure (Just a,
        plX$
        nR =: (ev (eAnn x) (xR,lX)-1)
        :aV++[CpyE () (AElem t 1 0 (Just a) sz) (AElem xR 1 0 lX sz) (Tmp nR) sz])
aeval (EApp T ()
oTy (Builtin T ()
_ Builtin
Tail) E (T ())
x) Temp
t | Just Int64
sz <- T () -> Maybe Int64
forall b a. Integral b => T a -> Maybe b
aB T ()
oTy = do
    nR <- CM Temp
newITemp
    (a,aV) <- vSz t (Tmp nR) sz
    (plX, (lX, xR)) <- plA x
    pure (Just a, plX$nR =: (ev (eAnn x) (xR,lX)-1):aV++[CpyE () (AElem t 1 0 (Just a) sz) (AElem xR 1 1 lX sz) (Tmp nR) sz])
aeval (EApp T ()
ty (EApp T ()
_ (EApp T ()
_ (Builtin T ()
_ Builtin
Zip) E (T ())
op) E (T ())
xs) E (T ())
ys) Temp
t | (Arrow T ()
tX (Arrow T ()
tY T ()
tC)) <- E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
op, Just Int64
zSz <- T () -> Maybe Int64
forall b a. Integral b => T a -> Maybe b
nSz T ()
tC, T () -> Bool
forall a. T a -> Bool
nind T ()
tX Bool -> Bool -> Bool
&& T () -> Bool
forall a. T a -> Bool
nind T ()
tY = do
    nR <- CM Temp
newITemp; i <- newITemp
    (a,aV) <- vSz t (Tmp nR) zSz
    (plEX, (lX, aPX)) <- plA xs; (plEY, (lY, aPY)) <- plA ys
    (step, pinches) <- aS op [(tX, AElem aPX 1 (Tmp i) lX), (tY, AElem aPY 1 (Tmp i) lY)] tC (AElem t 1 (Tmp i) (Just a))
    let loop=T () -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
forall {a}. T a -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
for T ()
ty Temp
i CE
0 IRel
ILt (Temp -> CE
Tmp Temp
nR) [CS ()]
step
    pure (Just a, plEX$plEY$nR =: ev (eAnn xs) (aPX,lX):aV++sas pinches [loop])
aeval (EApp T ()
_ (EApp T ()
_ (EApp T ()
_ (Builtin T ()
_ Builtin
ScanS) E (T ())
op) E (T ())
seed) E (T ())
e) Temp
t | (Arrow T ()
tX (Arrow T ()
tY T ()
_)) <- E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
op, T () -> Bool
forall a. T a -> Bool
isIF T ()
tX Bool -> Bool -> Bool
&& T () -> Bool
forall a. T a -> Bool
isIF T ()
tY = do
    acc <- T () -> CM RT
forall a. T a -> CM RT
rtemp T ()
tX; x <- rtemp tY
    i <- newITemp; n <- newITemp
    plS <- eeval seed acc
    (a,aV) <- v8 t (Tmp n)
    (plE, (l, aP)) <- plA e
    ss <- writeRF op [acc, x] acc
    let loopBody=ArrAcc -> RT -> CS ()
wt (Temp -> CE -> CE -> Maybe AL -> Int64 -> ArrAcc
AElem Temp
t CE
1 (Temp -> CE
Tmp Temp
i) (AL -> Maybe AL
forall a. a -> Maybe a
Just AL
a) Int64
8) RT
accCS () -> [CS ()] -> [CS ()]
forall a. a -> [a] -> [a]
:ArrAcc -> RT -> CS ()
mt (Temp -> CE -> CE -> Maybe AL -> Int64 -> ArrAcc
AElem Temp
aP CE
1 (Temp -> CE
Tmp Temp
i) Maybe AL
l Int64
8) RT
xCS () -> [CS ()] -> [CS ()]
forall a. a -> [a] -> [a]
:[CS ()]
ss
        loop=T () -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
forall {a}. T a -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
for (E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
e) Temp
i CE
0 IRel
ILt (Temp -> CE
Tmp Temp
n) [CS ()]
loopBody
    pure (Just a, plE$plS++n =: (ev (eAnn e) (aP,l)+1):aV++[loop])
aeval (EApp T ()
_ (EApp T ()
_ (Builtin T ()
_ Builtin
Scan) E (T ())
op) E (T ())
xs) Temp
t | (Arrow T ()
tAcc (Arrow T ()
tX T ()
_)) <- E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
op, T () -> Bool
forall a. T a -> Bool
isIF T ()
tAcc Bool -> Bool -> Bool
&& T () -> Bool
forall a. T a -> Bool
isIF T ()
tX = do
    acc <- T () -> CM RT
forall a. T a -> CM RT
rtemp T ()
tAcc; x <- rtemp tX
    i <- newITemp; n <- newITemp
    (a,aV) <- v8 t (Tmp n)
    (plE, (l, aP)) <- plA xs
    ss <- writeRF op [acc, x] acc
    let loopBody=ArrAcc -> RT -> CS ()
wt (Temp -> CE -> CE -> Maybe AL -> Int64 -> ArrAcc
AElem Temp
t CE
1 (Temp -> CE
Tmp Temp
iCE -> CE -> CE
forall a. Num a => a -> a -> a
-CE
1) (AL -> Maybe AL
forall a. a -> Maybe a
Just AL
a) Int64
8) RT
accCS () -> [CS ()] -> [CS ()]
forall a. a -> [a] -> [a]
:ArrAcc -> RT -> CS ()
mt (Temp -> CE -> CE -> Maybe AL -> Int64 -> ArrAcc
AElem Temp
aP CE
1 (Temp -> CE
Tmp Temp
i) Maybe AL
l Int64
8) RT
xCS () -> [CS ()] -> [CS ()]
forall a. a -> [a] -> [a]
:[CS ()]
ss
        loop=T () -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
forall {a}. T a -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
for1 (E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
xs) Temp
i CE
1 IRel
ILeq (Temp -> CE
Tmp Temp
n) [CS ()]
loopBody
    pure (Just a, plE$n =: ev (eAnn xs) (aP,l):aV++mt (AElem aP 1 0 l 8) acc:[loop])
aeval (EApp T ()
oTy (EApp T ()
_ (Builtin T ()
_ (DI Int
n)) E (T ())
op) E (T ())
xs) Temp
t | Just (T ()
ot, Int64
oSz) <- T () -> Maybe (T (), Int64)
forall b a. Integral b => T a -> Maybe (T a, b)
aRr T ()
oTy, Just Int64
xSz <- T () -> Maybe Int64
forall b a. Integral b => T a -> Maybe b
aB (E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
xs) = do
    slopP <- CM Temp
newITemp
    szR <- newITemp; sz'R <- newITemp; i <- newITemp
    fR <- rtemp ot
    (a,aV) <- vSz t (Tmp sz'R) xSz
    (_, ss) <- writeF op [AA slopP Nothing] fR
    let szSlop=Int -> CE
forall a b. (Integral a, Num b) => a -> b
fromIntegral(Int -> CE) -> Int -> CE
forall a b. (a -> b) -> a -> b
$Int
16Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
oSzInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
n
    (plX, (lX, aP)) <- plA xs
    let sz'=Temp -> CE
Tmp Temp
szRCE -> CE -> CE
forall a. Num a => a -> a -> a
-Int -> CE
forall a b. (Integral a, Num b) => a -> b
fromIntegral(Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
    let loopBody=() -> ArrAcc -> ArrAcc -> CE -> Int64 -> CS ()
forall a. a -> ArrAcc -> ArrAcc -> CE -> Int64 -> CS a
CpyE () (Temp -> CE -> CE -> Maybe AL -> Int64 -> ArrAcc
AElem Temp
slopP CE
1 CE
0 Maybe AL
forall a. Maybe a
Nothing Int64
xSz) (Temp -> CE -> CE -> Maybe AL -> Int64 -> ArrAcc
AElem Temp
aP CE
1 (Temp -> CE
Tmp Temp
i) Maybe AL
lX Int64
xSz) (Int -> CE
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) Int64
xSzCS () -> [CS ()] -> [CS ()]
forall a. a -> [a] -> [a]
:[CS ()]
ss[CS ()] -> [CS ()] -> [CS ()]
forall a. [a] -> [a] -> [a]
++[ArrAcc -> RT -> CS ()
wt (Temp -> CE -> CE -> Maybe AL -> Int64 -> ArrAcc
AElem Temp
t CE
1 (Temp -> CE
Tmp Temp
i) (AL -> Maybe AL
forall a. a -> Maybe a
Just AL
a) Int64
oSz) RT
fR]
        loop=T () -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
forall {a}. T a -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
for T ()
oTy Temp
i CE
0 IRel
ILt (Temp -> CE
Tmp Temp
sz'R) [CS ()]
loopBody
    pure (Just a, plX$szR =: ev (eAnn xs) (aP,lX):sz'R =: sz':aV++Sa () slopP szSlop:Wr () (ARnk slopP Nothing) 1:Wr () (ADim slopP 0 Nothing) (fromIntegral n):loop:[Pop () szSlop])
    -- TODO: not just I,F
aeval (EApp T ()
_ (EApp T ()
_ (Builtin T ()
_ Builtin
Rot) E (T ())
n) E (T ())
xs) Temp
t | T ()
tXs <- E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
xs, Just Int64
sz <- T () -> Maybe Int64
forall b a. Integral b => T a -> Maybe b
aB T ()
tXs = do
    nR <- CM Temp
newITemp; c <- newITemp; szR <- newITemp
    plN <- eval n nR
    (plX, (lX, xsR)) <- plA xs
    (a, aV) <- vSz t (Tmp szR) sz
    pure (Just a, plX$plN++szR =: ev tXs (xsR,lX):aV++Ifn't () (IRel IGeq (Tmp nR) 0) [nR+=Tmp szR]:c =: (Tmp szR-Tmp nR):[CpyE () (AElem t 1 0 (Just a) sz) (AElem xsR 1 (Tmp nR) lX sz) (Tmp c) sz, CpyE () (AElem t 1 (Tmp c) (Just a) sz) (AElem xsR 1 0 lX sz) (Tmp nR) sz])
aeval (Id T ()
_ (AShLit [Int]
ns [E (T ())]
es)) Temp
t | Just [Word64]
ws <- [E (T ())] -> Maybe [Word64]
forall a. [E a] -> Maybe [Word64]
mIFs [E (T ())]
es = do
    let rnk :: Word64
rnk=Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral(Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$[Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
ns
    n <- CM Int
nextAA
    modify (addAA n (rnk:fmap fromIntegral ns++ws))
    pure (Nothing, [t =: LA n])
    -- TODO: boolean lits
aeval (EApp T ()
_ (Builtin T ()
_ Builtin
T) E (T ())
x) Temp
t | Just (T ()
ty, [Int64]
ixes) <- T () -> Maybe (T (), [Int64])
forall a. T a -> Maybe (T a, [Int64])
tIx (E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
x), Int64
rnk <- Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral(Int -> Int64) -> Int -> Int64
forall a b. (a -> b) -> a -> b
$[Int64] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int64]
ixes, (Int64 -> Bool) -> [Int64] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Maybe Int64 -> Bool
forall a. Maybe a -> Bool
isJust(Maybe Int64 -> Bool) -> (Int64 -> Maybe Int64) -> Int64 -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Int64 -> Maybe Int64
forall a. FiniteBits a => a -> Maybe Int64
cLog) [Int64]
ixes = do
    a <- Temp -> CM AL
nextArr Temp
t
    let sze=T () -> Int64
forall b a. Integral b => T a -> b
bT T ()
ty; rnkE=Int64 -> CE
ConstI Int64
rnk
    xd <- newITemp; td <- newITemp
    (plX, (lX, xR)) <- plA x
    (dts, plDs) <- plDim rnk (xR, lX)
    let n:sstrides = reverse $ scanl' (*) 1 (reverse ixes); _:dstrides=reverse $ scanl' (*) 1 ixes
    is <- traverse (\Int64
_ -> CM Temp
newITemp) [1..rnk]
    let loop=[[CS ()] -> [CS ()]] -> [CS ()] -> [CS ()]
forall (t :: * -> *) a. Foldable t => t (a -> a) -> a -> a
thread ((Temp -> Temp -> [CS ()] -> [CS ()])
-> [Temp] -> [Temp] -> [[CS ()] -> [CS ()]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Temp
i Temp
tt -> (CS () -> [CS ()] -> [CS ()]
forall a. a -> [a] -> [a]
:[]) (CS () -> [CS ()]) -> ([CS ()] -> CS ()) -> [CS ()] -> [CS ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
forall a. a -> Temp -> CE -> IRel -> CE -> [CS a] -> CS a
For () Temp
i CE
0 IRel
ILt (Temp -> CE
Tmp Temp
tt)) [Temp]
is [Temp]
dts) [() -> ArrAcc -> ArrAcc -> CE -> Int64 -> CS ()
forall a. a -> ArrAcc -> ArrAcc -> CE -> Int64 -> CS a
CpyE () (Temp -> [CE] -> [CE] -> Maybe AL -> Int64 -> ArrAcc
At Temp
td (Int64 -> CE
ConstI(Int64 -> CE) -> [Int64] -> [CE]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>[Int64]
dstrides) (Temp -> CE
Tmp(Temp -> CE) -> [Temp] -> [CE]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>[Temp] -> [Temp]
forall a. [a] -> [a]
reverse [Temp]
is) (AL -> Maybe AL
forall a. a -> Maybe a
Just AL
a) Int64
sze) (Temp -> [CE] -> [CE] -> Maybe AL -> Int64 -> ArrAcc
At Temp
xd (Int64 -> CE
ConstI(Int64 -> CE) -> [Int64] -> [CE]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>[Int64]
sstrides) (Temp -> CE
Tmp(Temp -> CE) -> [Temp] -> [CE]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>[Temp]
is) Maybe AL
lX Int64
sze) CE
1 Int64
sze]
    pure (Just a, plX$plDs++Ma () a t (ConstI rnk) (ConstI n) sze:diml (t, Just a) (Tmp<$>reverse dts)++xd=:DP xR rnkE:td=:DP t rnkE:loop)
aeval (EApp T ()
_ (Builtin T ()
_ Builtin
T) E (T ())
x) Temp
t | Just (T ()
ty, Int64
rnk) <- T () -> Maybe (T (), Int64)
forall a. T a -> Maybe (T a, Int64)
tRnk (E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
x) = do
    a <- Temp -> CM AL
nextArr Temp
t
    let sze=T () -> Int64
forall b a. Integral b => T a -> b
bT T ()
ty; dO=Int64 -> CE
ConstI(Int64 -> CE) -> Int64 -> CE
forall a b. (a -> b) -> a -> b
$Int64
8Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+Int64
8Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
*Int64
rnk
    xd <- newITemp; td <- newITemp
    (plX, (l, xR)) <- plA x
    (dts, plDs) <- plDim rnk (xR, l)
    (sts, plSs) <- offByDim (reverse dts)
    (std, plSd) <- offByDim dts
    let n:sstrides = sts; (_:dstrides) = std
    is <- traverse (\Int64
_ -> CM Temp
newITemp) [1..rnk]
    let loop=[[CS ()] -> [CS ()]] -> [CS ()] -> [CS ()]
forall (t :: * -> *) a. Foldable t => t (a -> a) -> a -> a
thread ((Temp -> Temp -> [CS ()] -> [CS ()])
-> [Temp] -> [Temp] -> [[CS ()] -> [CS ()]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Temp
i Temp
tt -> (CS () -> [CS ()] -> [CS ()]
forall a. a -> [a] -> [a]
:[]) (CS () -> [CS ()]) -> ([CS ()] -> CS ()) -> [CS ()] -> [CS ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
forall a. a -> Temp -> CE -> IRel -> CE -> [CS a] -> CS a
For () Temp
i CE
0 IRel
ILt (Temp -> CE
Tmp Temp
tt)) [Temp]
is [Temp]
dts) [() -> ArrAcc -> ArrAcc -> CE -> Int64 -> CS ()
forall a. a -> ArrAcc -> ArrAcc -> CE -> Int64 -> CS a
CpyE () (Temp -> [CE] -> [CE] -> Maybe AL -> Int64 -> ArrAcc
At Temp
td (Temp -> CE
Tmp(Temp -> CE) -> [Temp] -> [CE]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>[Temp]
dstrides) (Temp -> CE
Tmp(Temp -> CE) -> [Temp] -> [CE]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>[Temp] -> [Temp]
forall a. [a] -> [a]
reverse [Temp]
is) (AL -> Maybe AL
forall a. a -> Maybe a
Just AL
a) Int64
sze) (Temp -> [CE] -> [CE] -> Maybe AL -> Int64 -> ArrAcc
At Temp
xd (Temp -> CE
Tmp(Temp -> CE) -> [Temp] -> [CE]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>[Temp]
sstrides) (Temp -> CE
Tmp(Temp -> CE) -> [Temp] -> [CE]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>[Temp]
is) Maybe AL
l Int64
sze) CE
1 Int64
sze]
    pure (Just a, plX$plDs++plSs++Ma () a t (ConstI rnk) (Tmp n) sze:diml (t, Just a) (Tmp<$>reverse dts)++init plSd++xd =: (Tmp xR+dO):td =: (Tmp t+dO):loop)
aeval (EApp T ()
_ (EApp T ()
_ (EApp T ()
_ (Builtin T ()
_ Builtin
Outer) E (T ())
op) E (T ())
xs) E (T ())
ys) Temp
t | (Arrow T ()
tX (Arrow T ()
tY T ()
tC)) <- E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
op, Just Int64
zSz <- T () -> Maybe Int64
forall b a. Integral b => T a -> Maybe b
nSz T ()
tC, T () -> Bool
forall a. T a -> Bool
nind T ()
tX Bool -> Bool -> Bool
&& T () -> Bool
forall a. T a -> Bool
nind T ()
tY = do
    a <- Temp -> CM AL
nextArr Temp
t
    szX <- newITemp; szY <- newITemp; i <- newITemp; j <- newITemp; k <- newITemp
    (plX, (lX, xR)) <- plA xs; (plY, (lY, yR)) <- plA ys
    (step, pinches) <- aS op [(tX ,AElem xR 1 (Tmp i) lX), (tY, AElem yR 1 (Tmp j) lY)] tC (AElem t 2 (Tmp k) (Just a))
    let loop=T () -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
forall {a}. T a -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
for (E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
xs) Temp
i CE
0 IRel
ILt (Temp -> CE
Tmp Temp
szX) [T () -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
forall {a}. T a -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
for (E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
ys) Temp
j CE
0 IRel
ILt (Temp -> CE
Tmp Temp
szY) ([CS ()]
step[CS ()] -> [CS ()] -> [CS ()]
forall a. [a] -> [a] -> [a]
++[Temp
kTemp -> CE -> CS ()
+=CE
1])]
    pure (Just a, plX$plY$szX =: ev (eAnn xs) (xR,lX):szY =: ev (eAnn ys) (yR,lY):Ma () a t 2 (Tmp szX*Tmp szY) zSz:diml (t, Just a) [Tmp szX, Tmp szY]++k=:0:sas pinches [loop])
aeval (EApp T ()
_ (EApp T ()
_ (EApp T ()
_ (Builtin T ()
_ Builtin
Outer) E (T ())
op) E (T ())
xs) E (T ())
ys) Temp
t | (Arrow T ()
tX (Arrow T ()
tY T ()
tC)) <- E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
op, Arr Sh ()
sh T ()
tEC <- T ()
tC, Just Int64
szXT <- T () -> Maybe Int64
forall b a. Integral b => T a -> Maybe b
nSz T ()
tX, Just Int64
szYT <- T () -> Maybe Int64
forall b a. Integral b => T a -> Maybe b
nSz T ()
tY, Just Int64
szZT <- T () -> Maybe Int64
forall b a. Integral b => T a -> Maybe b
nSz T ()
tEC = do
    a <- Temp -> CM AL
nextArr Temp
t
    szX <- newITemp; szY <- newITemp; szZ <- newITemp; i <- newITemp; j <- newITemp; k <- newITemp
    rnkZ <- newITemp; rnkO <- newITemp
    z <- newITemp; z0 <- newITemp
    (plX, (lX, xR)) <- plA xs; (plY, (lY, yR)) <- plA ys
    (x, wX, pinchX) <- arg tX (AElem xR 1 (Tmp i) lX szXT)
    (y, wY, pinchY) <- arg tY (AElem yR 1 (Tmp j) lY szYT)
    (lZ0, ss0) <- writeF op [ra x, ra y] (IT z0)
    (lZ, ss) <- writeF op [ra x, ra y] (IT z)
    let step=[CS ()
wX, CS ()
wY][CS ()] -> [CS ()] -> [CS ()]
forall a. [a] -> [a] -> [a]
++[CS ()]
ss[CS ()] -> [CS ()] -> [CS ()]
forall a. [a] -> [a] -> [a]
++[() -> ArrAcc -> ArrAcc -> CE -> Int64 -> CS ()
forall a. a -> ArrAcc -> ArrAcc -> CE -> Int64 -> CS a
CpyE () (Temp -> CE -> CE -> Maybe AL -> Int64 -> ArrAcc
AElem Temp
t (Temp -> CE
Tmp Temp
rnkO) (Temp -> CE
Tmp Temp
kCE -> CE -> CE
forall a. Num a => a -> a -> a
*Temp -> CE
Tmp Temp
szZ) (AL -> Maybe AL
forall a. a -> Maybe a
Just AL
a) Int64
szZT) (Temp -> CE -> CE -> Maybe AL -> Int64 -> ArrAcc
AElem Temp
z (Temp -> CE
Tmp Temp
rnkZ) CE
0 Maybe AL
lZ Int64
szZT) (Temp -> CE
Tmp Temp
szZ) Int64
szZT, Temp
kTemp -> CE -> CS ()
+=CE
1]
        loop=T () -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
forall {a}. T a -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
for (E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
xs) Temp
i CE
0 IRel
ILt (Temp -> CE
Tmp Temp
szX) [T () -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
forall {a}. T a -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
for (E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
ys) Temp
j CE
0 IRel
ILt (Temp -> CE
Tmp Temp
szY) [CS ()]
step]
    pure (Just a,
        plX$
        plY$
        i=:0:j=:0:
        sas [pinchX, pinchY] (
        wX:wY:ss0
        ++rnkZ=:eRnk sh (z0,lZ0)
        :rnkO=:(Tmp rnkZ+2)
        :SZ () szZ z0 (Tmp rnkZ) lZ0
        :szX=:ev (eAnn xs) (xR,lX)
        :szY=:ev (eAnn ys) (yR,lY)
        :Ma () a t (Tmp rnkO) (Tmp szX*Tmp szY*Tmp szZ) szZT
        :diml (t, Just a) [Tmp szX, Tmp szY]
        ++[CpyD () (ADim t 2 (Just a)) (ADim z0 0 lZ0) (Tmp rnkZ), k=:0, loop]
        ))
aeval (EApp T ()
ty (EApp T ()
_ (Builtin T ()
_ Builtin
Succ) E (T ())
op) E (T ())
xs) Temp
t | Arrow T ()
tX (Arrow T ()
_ T ()
tZ) <- E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
op, Just Int64
zSz <- T () -> Maybe Int64
forall b a. Integral b => T a -> Maybe b
nSz T ()
tZ, T () -> Bool
forall a. T a -> Bool
nind T ()
tX = do
    szR <- CM Temp
newITemp; sz'R <- newITemp
    (a,aV) <- vSz t (Tmp sz'R) zSz
    (plX, (lX, xR)) <- plA xs
    i <- newITemp
    (step, pinches) <- aS op [(tX, AElem xR 1 (Tmp i+1) lX), (tX, AElem xR 1 (Tmp i) lX)] tZ (AElem t 1 (Tmp i) (Just a))
    let loop=T () -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
forall {a}. T a -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
for T ()
ty Temp
i CE
0 IRel
ILt (Temp -> CE
Tmp Temp
sz'R) [CS ()]
step
    pure (Just a, plX$szR =: ev (eAnn xs) (xR,lX):sz'R =: (Tmp szR-1):aV++sas pinches [loop])
aeval (EApp T ()
oTy (Builtin T ()
_ Builtin
RevE) E (T ())
e) Temp
t | Just Int64
sz <- T () -> Maybe Int64
forall b a. Integral b => T a -> Maybe b
aB T ()
oTy = do
    n <- CM Temp
newITemp; i <- newITemp
    (a,aV) <- vSz t (Tmp n) sz
    (plE, (lE, eR)) <- plA e
    let loop=T () -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
forall {a}. T a -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
for T ()
oTy Temp
i CE
0 IRel
ILt (Temp -> CE
Tmp Temp
n) [() -> ArrAcc -> ArrAcc -> CE -> Int64 -> CS ()
forall a. a -> ArrAcc -> ArrAcc -> CE -> Int64 -> CS a
CpyE () (Temp -> CE -> CE -> Maybe AL -> Int64 -> ArrAcc
AElem Temp
t CE
1 (Temp -> CE
Tmp Temp
i) (AL -> Maybe AL
forall a. a -> Maybe a
Just AL
a) Int64
sz) (Temp -> CE -> CE -> Maybe AL -> Int64 -> ArrAcc
AElem Temp
eR CE
1 (Temp -> CE
Tmp Temp
nCE -> CE -> CE
forall a. Num a => a -> a -> a
-Temp -> CE
Tmp Temp
iCE -> CE -> CE
forall a. Num a => a -> a -> a
-CE
1) Maybe AL
lE Int64
sz) CE
1 Int64
sz]
    pure (Just a, plE$n =: ev oTy (eR,lE):aV++[loop])
aeval (EApp T ()
_ (Builtin T ()
_ Builtin
RevE) E (T ())
e) Temp
t | T ()
tys <- E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
e, Just (T ()
ty, Int64
rnk) <- T () -> Maybe (T (), Int64)
forall a. T a -> Maybe (T a, Int64)
tRnk T ()
tys = do
    a <- Temp -> CM AL
nextArr Temp
t
    n <- newITemp; i <- newITemp; szA <- newITemp
    (plE, (lE, eR)) <- plA e
    let sz=T () -> Int64
forall b a. Integral b => T a -> b
bT T ()
ty; rnkE=Int64 -> CE
ConstI Int64
rnk
    (dts, plDs) <- plDim rnk (eR, lE)
    let loop = T () -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
forall {a}. T a -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
for T ()
ty Temp
i CE
0 IRel
ILt (Temp -> CE
Tmp Temp
n) [() -> ArrAcc -> ArrAcc -> CE -> Int64 -> CS ()
forall a. a -> ArrAcc -> ArrAcc -> CE -> Int64 -> CS a
CpyE () (Temp -> CE -> CE -> Maybe AL -> Int64 -> ArrAcc
AElem Temp
t CE
rnkE (Temp -> CE
Tmp Temp
iCE -> CE -> CE
forall a. Num a => a -> a -> a
*Temp -> CE
Tmp Temp
szA) (AL -> Maybe AL
forall a. a -> Maybe a
Just AL
a) Int64
sz) (Temp -> CE -> CE -> Maybe AL -> Int64 -> ArrAcc
AElem Temp
eR CE
rnkE ((Temp -> CE
Tmp Temp
nCE -> CE -> CE
forall a. Num a => a -> a -> a
-Temp -> CE
Tmp Temp
iCE -> CE -> CE
forall a. Num a => a -> a -> a
-CE
1)CE -> CE -> CE
forall a. Num a => a -> a -> a
*Temp -> CE
Tmp Temp
szA) Maybe AL
lE Int64
sz) (Temp -> CE
Tmp Temp
szA) Int64
sz]
    pure (Just a, plE$n=:ev ty (eR,lE):tail plDs++PlProd () szA (Tmp<$>tail dts):Ma () a t rnkE (Tmp n*Tmp szA) sz:CpyD () (ADim t 0 (Just a)) (ADim eR 0 lE) rnkE:[loop])
aeval (EApp T ()
oTy (EApp T ()
_ (EApp T ()
_ (Builtin T ()
_ Builtin
Gen) E (T ())
seed) E (T ())
op) E (T ())
n) Temp
t | T ()
tyS <- E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
seed, Just Int64
sz <- T () -> Maybe Int64
forall b a. Integral b => T a -> Maybe b
rSz T ()
tyS = do
    nR <- CM Temp
newITemp; plN <- eval n nR; i <- newITemp
    acc <- rtemp tyS
    plS <- eeval seed acc
    (a,aV) <- vSz t (Tmp nR) sz
    ss <- writeRF op [acc] acc
    let loop=T () -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
forall {a}. T a -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
for T ()
oTy Temp
i CE
0 IRel
ILt (Temp -> CE
Tmp Temp
nR) (ArrAcc -> RT -> CS ()
wt (Temp -> CE -> CE -> Maybe AL -> Int64 -> ArrAcc
AElem Temp
t CE
1 (Temp -> CE
Tmp Temp
i) (AL -> Maybe AL
forall a. a -> Maybe a
Just AL
a) Int64
sz) RT
accCS () -> [CS ()] -> [CS ()]
forall a. a -> [a] -> [a]
:[CS ()]
ss)
    pure (Just a, plS++plN++aV++[loop])
aeval (EApp T ()
ty (EApp T ()
_ (EApp T ()
_ (Builtin T ()
_ Builtin
Gen) E (T ())
seed) E (T ())
op) E (T ())
n) Temp
t | T () -> Bool
forall a. T a -> Bool
isΠR (E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
seed) = do
    nR <- CM Temp
newITemp; plN <- eval n nR; i <- newITemp
    acc <- newITemp
    (szs,mP,_,plS) <- πe seed acc
    let πsz=[Int64] -> Int64
forall a. HasCallStack => [a] -> a
last [Int64]
szs
    (a,aV) <- vSz t (Tmp nR) πsz
    (_, ss) <- writeF op [IPA acc] (IT acc)
    let loop=T () -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
forall {a}. T a -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
for T ()
ty Temp
i CE
0 IRel
ILt (Temp -> CE
Tmp Temp
nR) (() -> ArrAcc -> ArrAcc -> CE -> Int64 -> CS ()
forall a. a -> ArrAcc -> ArrAcc -> CE -> Int64 -> CS a
CpyE () (Temp -> CE -> CE -> Maybe AL -> Int64 -> ArrAcc
AElem Temp
t CE
1 (Temp -> CE
Tmp Temp
i) (AL -> Maybe AL
forall a. a -> Maybe a
Just AL
a) Int64
πsz) (Temp -> Maybe AL -> ArrAcc
TupM Temp
acc Maybe AL
forall a. Maybe a
Nothing) CE
1 Int64
πszCS () -> [CS ()] -> [CS ()]
forall a. a -> [a] -> [a]
:[CS ()]
ss)
    pure (Just a, m'sa acc mP++plS++plN++aV++loop:m'pop mP)
aeval (EApp T ()
oTy (EApp T ()
_ (Builtin T ()
_ (Conv [Int]
is)) E (T ())
f) E (T ())
x) Temp
t
    | (Arrow T ()
_ T ()
tC) <- E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
f
    , Just (T ()
tX, Int64
xRnk) <- T () -> Maybe (T (), Int64)
forall a. T a -> Maybe (T a, Int64)
tRnk (E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
x)
    , Just (T ()
_, Int64
oRnk) <- T () -> Maybe (T (), Int64)
forall a. T a -> Maybe (T a, Int64)
tRnk T ()
oTy
    , Just Int64
oSz <- T () -> Maybe Int64
forall b a. Integral b => T a -> Maybe b
bSz T ()
tC, Just Int64
xSz <- T () -> Maybe Int64
forall b a. Integral b => T a -> Maybe b
bSz T ()
tX, Int64
oRnkInt64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
==Int64
xRnk = do
    a <- Temp -> CM AL
nextArr Temp
t
    xRd <- newITemp; szR <- newITemp; slopP <- newITemp
    (plX, (lX, xR)) <- plA x
    (dts, plDs) <- plDim xRnk (xR, lX)
    (tdims, dims) <- unzip <$> zipWithM (\Temp
dt Int
i -> do {odim <- CM Temp
newITemp; pure (odim, odim =: (Tmp dt-fromIntegral (i-1)))}) dts is
    io <- traverse (\Temp
_ -> CM Temp
newITemp) tdims
    iw <- traverse (\Int
_ -> CM Temp
newITemp) is; j <- newITemp
    let slopSz=[Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product [Int]
is; slopRnk=[Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
is; slopE=Int -> CE
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Int
slopSzInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
slopRnkInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
oSz); slopDims=Int -> CE
forall a b. (Integral a, Num b) => a -> b
fromIntegral(Int -> CE) -> [Int] -> [CE]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>[Int]
is
        rnk=Int64 -> CE
ConstI Int64
oRnk
    z <- rtemp tC; k <- newITemp; o <- rtemp tX
    (_, ss) <- writeF f [AA slopP Nothing] z
    (sts, plS) <- offByDim (reverse dts)
    let _:strides = sts; sss=[CS ()] -> [CS ()]
forall a. HasCallStack => [a] -> [a]
init [CS ()]
plS
        extrWindow = Temp
jTemp -> CE -> CS ()
=:CE
0CS () -> [CS ()] -> [CS ()]
forall a. a -> [a] -> [a]
:[Temp] -> [CE] -> [CS ()] -> [CS ()]
forAll [Temp]
iw (Int64 -> CE
ConstI (Int64 -> CE) -> (Int -> Int64) -> Int -> CE
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral(Int -> CE) -> [Int] -> [CE]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>[Int]
is)
                            [ArrAcc -> RT -> CS ()
mt (Temp -> [CE] -> [CE] -> Maybe AL -> Int64 -> ArrAcc
At Temp
xRd (Temp -> CE
Tmp(Temp -> CE) -> [Temp] -> [CE]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>[Temp]
strides) ((Temp -> Temp -> CE) -> [Temp] -> [Temp] -> [CE]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Temp
jϵ Temp
iϵ -> Temp -> CE
Tmp Temp
jϵCE -> CE -> CE
forall a. Num a => a -> a -> a
+Temp -> CE
Tmp Temp
iϵ) [Temp]
iw [Temp]
io) Maybe AL
lX Int64
xSz) RT
o, ArrAcc -> RT -> CS ()
wt (Temp -> CE -> CE -> Maybe AL -> Int64 -> ArrAcc
AElem Temp
slopP (Int64 -> CE
ConstI(Int64 -> CE) -> Int64 -> CE
forall a b. (a -> b) -> a -> b
$Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
slopRnk) (Temp -> CE
Tmp Temp
j) Maybe AL
forall a. Maybe a
Nothing Int64
oSz) RT
o, Temp
jTemp -> CE -> CS ()
+=CE
1]
        step = [CS ()]
extrWindow[CS ()] -> [CS ()] -> [CS ()]
forall a. [a] -> [a] -> [a]
++[CS ()]
ss[CS ()] -> [CS ()] -> [CS ()]
forall a. [a] -> [a] -> [a]
++[ArrAcc -> RT -> CS ()
wt (Temp -> CE -> CE -> Maybe AL -> Int64 -> ArrAcc
AElem Temp
t CE
rnk (Temp -> CE
Tmp Temp
k) (AL -> Maybe AL
forall a. a -> Maybe a
Just AL
a) Int64
oSz) RT
z, Temp
kTemp -> CE -> CS ()
+=CE
1]
        loop=[Temp] -> [CE] -> [CS ()] -> [CS ()]
forAll [Temp]
io (Temp -> CE
Tmp(Temp -> CE) -> [Temp] -> [CE]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>[Temp]
tdims) [CS ()]
step
    pure (Just a,
        plX$
        plDs
        ++dims
        ++sss
        ++PlProd () szR (Tmp<$>tdims):Ma () a t rnk (Tmp szR) oSz:diml (t, Just a) (Tmp<$>tdims)
        ++Sa () slopP slopE:Wr () (ARnk slopP Nothing) (ConstI$fromIntegral slopRnk):diml (slopP, Nothing) slopDims
        ++xRd=:DP xR (ConstI xRnk):k=:0:loop
        ++[Pop () slopE])
aeval E (T ())
e Temp
_ = [Char] -> CM (Maybe AL, [CS ()])
forall a. HasCallStack => [Char] -> a
error (E (T ()) -> [Char]
forall a. Show a => a -> [Char]
show E (T ())
e)

plC :: E (T ()) -> CM ([CS ()] -> [CS ()], CE)
plC :: E (T ()) -> CM ([CS ()] -> [CS ()], CE)
plC (ILit T ()
_ Integer
i) = ([CS ()] -> [CS ()], CE) -> CM ([CS ()] -> [CS ()], CE)
forall a. a -> StateT CSt Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([CS ()] -> [CS ()]
forall a. a -> a
id, Int64 -> CE
ConstI(Int64 -> CE) -> Int64 -> CE
forall a b. (a -> b) -> a -> b
$Integer -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i)
plC (Var T ()
I Nm (T ())
x)  = do {st <- (CSt -> IntMap Temp) -> StateT CSt Identity (IntMap Temp)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets CSt -> IntMap Temp
vars; pure (id, Tmp$getT st x)}
plC E (T ())
e          = do {t <- CM Temp
newITemp; pl <- eval e t; pure ((pl++), Tmp t)}

plD :: E (T ()) -> CM ([CS ()] -> [CS ()], CFE)
plD :: E (T ()) -> CM ([CS ()] -> [CS ()], CFE)
plD (FLit T ()
_ Double
x) = ([CS ()] -> [CS ()], CFE) -> CM ([CS ()] -> [CS ()], CFE)
forall a. a -> StateT CSt Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([CS ()] -> [CS ()]
forall a. a -> a
id, Double -> CFE
ConstF Double
x)
plD (Var T ()
F Nm (T ())
x)  = do {st <- (CSt -> IntMap FTemp) -> StateT CSt Identity (IntMap FTemp)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets CSt -> IntMap FTemp
dvars; pure (id, FTmp$getT st x)}
plD E (T ())
e          = do {t <- CM FTemp
newFTemp; pl <- feval e t; pure ((pl++), FTmp t)}

plP :: E (T ()) -> CM ([CS ()] -> [CS ()], PE)
plP :: E (T ()) -> CM ([CS ()] -> [CS ()], PE)
plP (BLit T ()
_ Bool
b) = ([CS ()] -> [CS ()], PE) -> CM ([CS ()] -> [CS ()], PE)
forall a. a -> StateT CSt Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([CS ()] -> [CS ()]
forall a. a -> a
id, Bool -> PE
BConst Bool
b)
plP (Var T ()
B Nm (T ())
x)  = do {st <- (CSt -> IntMap BTemp) -> StateT CSt Identity (IntMap BTemp)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets CSt -> IntMap BTemp
pvars; pure (id, Is$getT st x)}
plP E (T ())
e          = do {t <- CM BTemp
nBT; pl <- peval e t; pure ((pl++), Is t)}

plEV :: E (T ()) -> CM ([CS ()] -> [CS ()], Temp)
plEV :: E (T ()) -> CM ([CS ()] -> [CS ()], Temp)
plEV (Var T ()
I Nm (T ())
x) = do
    st <- (CSt -> IntMap Temp) -> StateT CSt Identity (IntMap Temp)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets CSt -> IntMap Temp
vars
    pure (id, getT st x)
plEV E (T ())
e = do
    t <- CM Temp
newITemp
    pl <- eval e t
    pure ((pl++), t)

plF :: E (T ()) -> CM ([CS ()] -> [CS ()], FTemp)
plF :: E (T ()) -> CM ([CS ()] -> [CS ()], FTemp)
plF (Var T ()
F Nm (T ())
x) = do
    st <- (CSt -> IntMap FTemp) -> StateT CSt Identity (IntMap FTemp)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets CSt -> IntMap FTemp
dvars
    pure (id, getT st x)
plF E (T ())
e = do
    t <- CM FTemp
newFTemp
    pl <- feval e t
    pure ((pl++), t)

plA :: E (T ()) -> CM ([CS ()] -> [CS ()], (Maybe AL, Temp))
plA :: E (T ()) -> CM ([CS ()] -> [CS ()], (Maybe AL, Temp))
plA (Var T ()
_ Nm (T ())
x) = do {st <- (CSt -> IntMap (Maybe AL, Temp))
-> StateT CSt Identity (IntMap (Maybe AL, Temp))
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets CSt -> IntMap (Maybe AL, Temp)
avars; pure (id, getT st x)}
plA E (T ())
e         = do {t <- CM Temp
newITemp; (lX,plX) <- aeval e t; pure ((plX++), (lX, t))}

peval :: E (T ()) -> BTemp -> CM [CS ()]
peval :: E (T ()) -> BTemp -> State CSt [CS ()]
peval (LLet T ()
_ (Nm (T ()), E (T ()))
b E (T ())
e) BTemp
t = do
    ss <- (Nm (T ()), E (T ())) -> State CSt [CS ()]
llet (Nm (T ()), E (T ()))
b
    (ss++) <$> peval e t
peval (BLit T ()
_ Bool
b) BTemp
t = [CS ()] -> State CSt [CS ()]
forall a. a -> StateT CSt Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [() -> BTemp -> PE -> CS ()
forall a. a -> BTemp -> PE -> CS a
MB () BTemp
t (Bool -> PE
BConst Bool
b)]
peval (EApp T ()
_ (Builtin T ()
_ Builtin
Odd) E (T ())
e0) BTemp
t = do
    (pl,eR) <- E (T ()) -> CM ([CS ()] -> [CS ()], Temp)
plEV E (T ())
e0
    pure $ pl [Cset () (IUn IOdd (Tmp eR)) t]
peval (EApp T ()
_ (Builtin T ()
_ Builtin
Even) E (T ())
e0) BTemp
t = do
    (pl,eR) <- E (T ()) -> CM ([CS ()] -> [CS ()], Temp)
plEV E (T ())
e0
    pure $ pl [Cset () (IUn IEven (Tmp eR)) t]
peval (EApp T ()
_ (EApp T ()
_ (Builtin (Arrow T ()
I T ()
_) Builtin
op) E (T ())
e0) E (T ())
e1) BTemp
t | Just IRel
iop <- Builtin -> Maybe IRel
rel Builtin
op = do
    (plE0,e0e) <- E (T ()) -> CM ([CS ()] -> [CS ()], CE)
plC E (T ())
e0; (plE1, e1e) <- plC e1
    pure $ plE0 $ plE1 [Cset () (IRel iop e0e e1e) t]
peval (EApp T ()
_ (EApp T ()
_ (Builtin (Arrow T ()
F T ()
_) Builtin
op) E (T ())
e0) E (T ())
e1) BTemp
t | Just FRel
fop' <- Builtin -> Maybe FRel
frel Builtin
op = do
    (plE0,e0e) <- E (T ()) -> CM ([CS ()] -> [CS ()], CFE)
plD E (T ())
e0; (plE1, e1e) <- plD e1
    pure $ plE0 $ plE1 [Cset () (FRel fop' e0e e1e) t]
peval (EApp T ()
_ (EApp T ()
_ (Builtin T ()
_ Builtin
op) E (T ())
e0) E (T ())
e1) BTemp
t | Just BBin
boo <- Builtin -> Maybe BBin
mB Builtin
op = do
    (pl0,e0R) <- E (T ()) -> CM ([CS ()] -> [CS ()], PE)
plP E (T ())
e0; (pl1,e1R) <- plP e1
    pure $ pl0 $ pl1 [MB () t (Boo boo e0R e1R)]
peval (EApp T ()
_ (Builtin T ()
_ Builtin
N) E (T ())
e0) BTemp
t = do
    (pl,e0R) <- E (T ()) -> CM ([CS ()] -> [CS ()], PE)
plP E (T ())
e0
    pure $ pl [MB () t (BU BNeg e0R)]
peval (EApp T ()
_ (EApp T ()
_ (Builtin T ()
_ Builtin
Fold) E (T ())
op) E (T ())
e) BTemp
acc | (Arrow T ()
tX T ()
_) <- E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
op, T () -> Bool
forall a. T a -> Bool
isB T ()
tX = do
    x <- CM BTemp
nBT
    szR <- newITemp
    i <- newITemp
    (plE, (l, aP)) <- plA e
    ss <- writeRF op [PT acc, PT x] (PT acc)
    let loopBody=() -> BTemp -> PE -> CS ()
forall a. a -> BTemp -> PE -> CS a
MB () BTemp
x (ArrAcc -> PE
PAt (Temp -> CE -> CE -> Maybe AL -> Int64 -> ArrAcc
AElem Temp
aP CE
1 (Temp -> CE
Tmp Temp
i) Maybe AL
l Int64
1))CS () -> [CS ()] -> [CS ()]
forall a. a -> [a] -> [a]
:[CS ()]
ss
        loop=T () -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
forall {a}. T a -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
for1 (E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
e) Temp
i CE
1 IRel
ILt (Temp -> CE
Tmp Temp
szR) [CS ()]
loopBody
    pure $ plE$szR =: ev (eAnn e) (aP,l):MB () acc (PAt (AElem aP 1 0 l 1)):[loop]
peval (EApp T ()
_ (EApp T ()
_ (EApp T ()
_ (Builtin T ()
_ Builtin
FoldS) E (T ())
op) E (T ())
seed) E (T ())
e) BTemp
acc | (Arrow T ()
_ (Arrow T ()
tY T ()
_)) <- E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
op, Just Int64
szY <- T () -> Maybe Int64
forall b a. Integral b => T a -> Maybe b
rSz T ()
tY = do
    x <- T () -> CM RT
forall a. T a -> CM RT
rtemp T ()
tY
    szR <- newITemp
    i <- newITemp
    (plE, (l, aP)) <- plA e
    plAcc <- peval seed acc
    ss <- writeRF op [PT acc, x] (PT acc)
    let loopBody=ArrAcc -> RT -> CS ()
mt (Temp -> CE -> CE -> Maybe AL -> Int64 -> ArrAcc
AElem Temp
aP CE
1 (Temp -> CE
Tmp Temp
i) Maybe AL
l Int64
szY) RT
xCS () -> [CS ()] -> [CS ()]
forall a. a -> [a] -> [a]
:[CS ()]
ss
        loop=T () -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
forall {a}. T a -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
for (E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
e) Temp
i CE
0 IRel
ILt (Temp -> CE
Tmp Temp
szR) [CS ()]
loopBody
    pure $ plE $ plAcc++szR=:ev (eAnn e) (aP,l):[loop]
peval (EApp T ()
_ (Builtin T ()
_ Builtin
Head) E (T ())
xs) BTemp
t = do
    (plX, (l, a)) <- E (T ()) -> CM ([CS ()] -> [CS ()], (Maybe AL, Temp))
plA E (T ())
xs
    pure $ plX [MB () t (PAt (AElem a 1 0 l 1))]
peval (EApp T ()
_ (Builtin T ()
_ Builtin
Last) E (T ())
xs) BTemp
t = do
    (plX, (l, a)) <- E (T ()) -> CM ([CS ()] -> [CS ()], (Maybe AL, Temp))
plA E (T ())
xs
    pure $ plX [MB () t (PAt (AElem a 1 (ev (eAnn xs) (a,l)-1) l 1))]
peval E (T ())
e BTemp
_ = [Char] -> State CSt [CS ()]
forall a. HasCallStack => [Char] -> a
error (E (T ()) -> [Char]
forall a. Show a => a -> [Char]
show E (T ())
e)

eval :: E (T ()) -> Temp -> CM [CS ()]
eval :: E (T ()) -> Temp -> State CSt [CS ()]
eval (LLet T ()
_ (Nm (T ()), E (T ()))
b E (T ())
e) Temp
t = do
    ss <- (Nm (T ()), E (T ())) -> State CSt [CS ()]
llet (Nm (T ()), E (T ()))
b
    (ss++) <$> eval e t
eval (ILit T ()
_ Integer
n) Temp
t = [CS ()] -> State CSt [CS ()]
forall a. a -> StateT CSt Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Temp
t Temp -> CE -> CS ()
=: Integer -> CE
forall a. Num a => Integer -> a
fromInteger Integer
n]
eval (Var T ()
_ Nm (T ())
x) Temp
t = do
    st <- (CSt -> IntMap Temp) -> StateT CSt Identity (IntMap Temp)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets CSt -> IntMap Temp
vars
    pure [t =: Tmp (getT st x)]
eval (EApp T ()
_ (EApp T ()
_ (Builtin T ()
_ Builtin
A.R) E (T ())
e0) E (T ())
e1) Temp
t = do
    (plE0,e0e) <- E (T ()) -> CM ([CS ()] -> [CS ()], CE)
plC E (T ())
e0; (plE1,e1e) <- plC e1
    pure $ plE0 $ plE1 [Rnd () t, t =: (Bin IRem (Tmp t) (e1e-e0e+1) + e0e)]
eval (EApp T ()
_ (EApp T ()
_ (Builtin T ()
_ Builtin
Fold) E (T ())
op) E (T ())
e) Temp
acc | (Arrow T ()
tX T ()
_) <- E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
op, T () -> Bool
forall a. T a -> Bool
isI T ()
tX = do
    x <- CM Temp
newITemp
    szR <- newITemp
    i <- newITemp
    (plE, (l, aP)) <- plA e
    ss <- writeRF op [IT acc, IT x] (IT acc)
    let loopBody=Temp
xTemp -> CE -> CS ()
=:ArrAcc -> CE
EAt (Temp -> CE -> CE -> Maybe AL -> Int64 -> ArrAcc
AElem Temp
aP CE
1 (Temp -> CE
Tmp Temp
i) Maybe AL
l Int64
8)CS () -> [CS ()] -> [CS ()]
forall a. a -> [a] -> [a]
:[CS ()]
ss
        loop=T () -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
forall {a}. T a -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
for1 (E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
e) Temp
i CE
1 IRel
ILt (Temp -> CE
Tmp Temp
szR) [CS ()]
loopBody
    pure $ plE$szR =: ev (eAnn e) (aP,l):acc =: EAt (AElem aP 1 0 l 8):[loop]
eval (EApp T ()
_ (EApp T ()
_ (EApp T ()
_ (Builtin T ()
_ Builtin
FoldS) E (T ())
op) E (T ())
seed) E (T ())
e) Temp
acc | (Arrow T ()
_ (Arrow T ()
tX T ()
_)) <- E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
op, Just Int64
xSz <- T () -> Maybe Int64
forall b a. Integral b => T a -> Maybe b
rSz T ()
tX = do
    x <- T () -> CM RT
forall a. T a -> CM RT
rtemp T ()
tX
    szR <- newITemp
    i <- newITemp
    (plE, (l, eR)) <- plA e
    plAcc <- eval seed acc
    ss <- writeRF op [IT acc, x] (IT acc)
    let loopBody=ArrAcc -> RT -> CS ()
mt (Temp -> CE -> CE -> Maybe AL -> Int64 -> ArrAcc
AElem Temp
eR CE
1 (Temp -> CE
Tmp Temp
i) Maybe AL
l Int64
xSz) RT
xCS () -> [CS ()] -> [CS ()]
forall a. a -> [a] -> [a]
:[CS ()]
ss
        loop=T () -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
forall {a}. T a -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
for (E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
e) Temp
i CE
0 IRel
ILt (Temp -> CE
Tmp Temp
szR) [CS ()]
loopBody
    pure $ plE$plAcc++szR =: ev (eAnn e) (eR,l):[loop]
eval (EApp T ()
I (EApp T ()
_ (Builtin T ()
_ Builtin
op) E (T ())
e0) E (T ())
e1) Temp
t | Just IBin
cop <- Builtin -> Maybe IBin
mOp Builtin
op = do
    (pl0,e0e) <- E (T ()) -> CM ([CS ()] -> [CS ()], CE)
plC E (T ())
e0; (pl1,e1e) <- plC e1
    pure $ pl0 $ pl1 [t =: Bin cop e0e e1e]
eval (EApp T ()
_ (EApp T ()
_ (Builtin T ()
_ Builtin
Max) E (T ())
e0) E (T ())
e1) Temp
t = do
    (pl0,t0) <- E (T ()) -> CM ([CS ()] -> [CS ()], Temp)
plEV E (T ())
e0
    -- in case t==t1
    t1 <- newITemp
    pl1 <- eval e1 t1
    pure $ pl0 $ pl1 ++ [t =: Tmp t0, Cmov () (IRel IGt (Tmp t1) (Tmp t0)) t (Tmp t1)]
eval (EApp T ()
_ (EApp T ()
_ (Builtin T ()
_ Builtin
Min) E (T ())
e0) E (T ())
e1) Temp
t = do
    (pl0,t0) <- E (T ()) -> CM ([CS ()] -> [CS ()], Temp)
plEV E (T ())
e0
    -- in case t==t1
    t1 <- newITemp
    pl1 <- eval e1 t1
    pure $ pl0 $ pl1 ++ [t =: Tmp t0, Cmov () (IRel ILt (Tmp t1) (Tmp t0)) t (Tmp t1)]
eval (EApp T ()
_ (EApp T ()
_ (Builtin T ()
_ Builtin
A1) E (T ())
e) E (T ())
i) Temp
t = do
    (plE, (lE, eR)) <- E (T ()) -> CM ([CS ()] -> [CS ()], (Maybe AL, Temp))
plA E (T ())
e
    (plI,iE) <- plC i
    pure $ plE $ plI [t =: EAt (AElem eR 1 iE lE 8)]
eval (EApp T ()
_ (Builtin T ()
_ Builtin
Head) E (T ())
xs) Temp
t = do
    (plX, (l, a)) <- E (T ()) -> CM ([CS ()] -> [CS ()], (Maybe AL, Temp))
plA E (T ())
xs
    pure $ plX [t =: EAt (AElem a 1 0 l 8)]
eval (EApp T ()
_ (Builtin T ()
_ Builtin
Last) E (T ())
xs) Temp
t = do
    (plX, (l, a)) <- E (T ()) -> CM ([CS ()] -> [CS ()], (Maybe AL, Temp))
plA E (T ())
xs
    pure $ plX [t =: EAt (AElem a 1 (ev (eAnn xs) (a,l)-1) l 8)]
eval (EApp T ()
_ (Builtin T ()
_ Builtin
Size) E (T ())
xs) Temp
t | Just (T ()
_, Int64
1) <- T () -> Maybe (T (), Int64)
forall a. T a -> Maybe (T a, Int64)
tRnk (E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
xs) = do
    (plE, (l, xsR)) <- E (T ()) -> CM ([CS ()] -> [CS ()], (Maybe AL, Temp))
plA E (T ())
xs
    pure $ plE [t =: EAt (ADim xsR 0 l)]
eval (EApp T ()
_ (Builtin T ()
_ Builtin
Dim) E (T ())
xs) Temp
t | Arr (Ix ()
_ Int
i `Cons` Sh ()
_) T ()
_ <- E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
xs = do
    [CS ()] -> State CSt [CS ()]
forall a. a -> StateT CSt Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Temp
tTemp -> CE -> CS ()
=:Int64 -> CE
ConstI (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i)]
eval (EApp T ()
_ (Builtin T ()
_ Builtin
Dim) E (T ())
xs) Temp
t = do
    (plE, (l, xsR)) <- E (T ()) -> CM ([CS ()] -> [CS ()], (Maybe AL, Temp))
plA E (T ())
xs
    pure $ plE [t =: EAt (ADim xsR 0 l)]
eval (EApp T ()
_ (Builtin T ()
_ Builtin
Size) E (T ())
xs) Temp
t | Arr Sh ()
sh T ()
_ <- E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
xs = do
    (plE, (l, xsR)) <- E (T ()) -> CM ([CS ()] -> [CS ()], (Maybe AL, Temp))
plA E (T ())
xs
    rnkR <- newITemp
    pure $ plE [rnkR =: eRnk sh (xsR,l), SZ () t xsR (Tmp rnkR) l]
eval (EApp T ()
_ (Builtin T ()
_ Builtin
Floor) E (T ())
x) Temp
t = do
    xR <- CM FTemp
newFTemp
    plX <- feval x xR
    pure $ plX ++ [t =: CFloor (FTmp xR)]
eval (EApp T ()
_ (Builtin T ()
_ (TAt Int
i)) E (T ())
e) Temp
t = do
    k <- CM Temp
newITemp
    (offs, a, _, plT) <- πe e k
    pure $ m'sa t a++plT ++ t =: EAt (Raw k (ConstI$offs!!(i-1)) Nothing 1):m'pop a
eval (EApp T ()
_ (EApp T ()
_ (Builtin T ()
_ Builtin
IOf) E (T ())
p) E (T ())
xs) Temp
t | (Arrow T ()
tD T ()
_) <- E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
p, Just Int64
szX <- T () -> Maybe Int64
forall b a. Integral b => T a -> Maybe b
nSz T ()
tD = do
    pR <- CM BTemp
nBT
    szR <- newITemp; i <- newITemp; done <- newITemp
    (plX, (lX, xsR)) <- plA xs
    (x, wX, pinch) <- arg tD (AElem xsR 1 (Tmp i) lX szX)
    ss <- writeRF p [x] (PT pR)
    let loop=() -> Temp -> IRel -> CE -> [CS ()] -> CS ()
forall a. a -> Temp -> IRel -> CE -> [CS a] -> CS a
While () Temp
done IRel
INeq CE
1 (CS ()
wXCS () -> [CS ()] -> [CS ()]
forall a. a -> [a] -> [a]
:[CS ()]
ss[CS ()] -> [CS ()] -> [CS ()]
forall a. [a] -> [a] -> [a]
++[() -> PE -> [CS ()] -> [CS ()] -> CS ()
forall a. a -> PE -> [CS a] -> [CS a] -> CS a
If () (BTemp -> PE
Is BTemp
pR) [Temp
tTemp -> CE -> CS ()
=:Temp -> CE
Tmp Temp
i, Temp
doneTemp -> CE -> CS ()
=:CE
1] [], Temp
iTemp -> CE -> CS ()
+=CE
1, () -> PE -> Temp -> CE -> CS ()
forall a. a -> PE -> Temp -> CE -> CS a
Cmov () (IRel -> CE -> CE -> PE
IRel IRel
IGeq (Temp -> CE
Tmp Temp
i) (Temp -> CE
Tmp Temp
szR)) Temp
done CE
1])
    pure $ plX $ szR=:ev (eAnn xs) (xsR,lX):t=:(-1):done=:0:i=:0:m'p pinch [loop]
eval (EApp T ()
_ (EApp T ()
_ (EApp T ()
_ (Builtin T ()
_ Builtin
Iter) E (T ())
f) E (T ())
n) E (T ())
x) Temp
t = do
    (plN,nR) <- E (T ()) -> CM ([CS ()] -> [CS ()], CE)
plC E (T ())
n
    plX <- eval x t
    ss <- writeRF f [IT t] (IT t)
    i <- newITemp
    let loop=() -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
forall a. a -> Temp -> CE -> IRel -> CE -> [CS a] -> CS a
For () Temp
i CE
0 IRel
ILt CE
nR [CS ()]
ss
    pure $ plX++plN [loop]
eval (Cond T ()
_ E (T ())
p E (T ())
e0 E (T ())
e1) Temp
t = (Maybe AL, [CS ()]) -> [CS ()]
forall a b. (a, b) -> b
snd ((Maybe AL, [CS ()]) -> [CS ()])
-> CM (Maybe AL, [CS ()]) -> State CSt [CS ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> E (T ()) -> E (T ()) -> E (T ()) -> RT -> CM (Maybe AL, [CS ()])
cond E (T ())
p E (T ())
e0 E (T ())
e1 (Temp -> RT
IT Temp
t)
eval (Id T ()
_ (FoldOfZip E (T ())
zop E (T ())
op [E (T ())
p])) Temp
acc | Just (T ()
tP, Int64
pSz) <- T () -> Maybe (T (), Int64)
forall b a. Integral b => T a -> Maybe (T a, b)
aRr (E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
p) = do
    x <- T () -> CM RT
forall a. T a -> CM RT
rtemp T ()
tP
    szR <- newITemp
    i <- newITemp
    (plPP, (lP, pR)) <- plA p
    ss <- writeRF op [IT acc, x] (IT acc)
    let step = ArrAcc -> RT -> CS ()
mt (Temp -> CE -> CE -> Maybe AL -> Int64 -> ArrAcc
AElem  Temp
pR CE
1 (Temp -> CE
Tmp Temp
i) Maybe AL
lP Int64
pSz) RT
xCS () -> [CS ()] -> [CS ()]
forall a. a -> [a] -> [a]
:[CS ()]
ss
        loop = T () -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
forall {a}. T a -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
for1 (E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
p) Temp
i CE
1 IRel
ILt (Temp -> CE
Tmp Temp
szR) [CS ()]
step
    sseed <- writeRF zop [x] (IT acc)
    pure $ plPP$szR =:ev (eAnn p) (pR,lP):mt (AElem pR 1 0 lP pSz) x:sseed++[loop]
eval (Id T ()
_ (FoldOfZip E (T ())
zop E (T ())
op [E (T ())
p, E (T ())
q])) Temp
acc | T ()
tPs <- E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
p, Just (T ()
tP, Int64
pSz) <- T () -> Maybe (T (), Int64)
forall b a. Integral b => T a -> Maybe (T a, b)
aRr T ()
tPs, Just (T ()
tQ, Int64
qSz) <- T () -> Maybe (T (), Int64)
forall b a. Integral b => T a -> Maybe (T a, b)
aRr (E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
q) = do
    x <- T () -> CM RT
forall a. T a -> CM RT
rtemp T ()
tP; y <- rtemp tQ
    szR <- newITemp
    i <- newITemp
    (plPP, (lP, pR)) <- plA p; (plQ, (lQ, qR)) <- plA q
    ss <- writeRF op [IT acc, x, y] (IT acc)
    let step = ArrAcc -> RT -> CS ()
mt (Temp -> CE -> CE -> Maybe AL -> Int64 -> ArrAcc
AElem Temp
pR CE
1 (Temp -> CE
Tmp Temp
i) Maybe AL
lP Int64
pSz) RT
xCS () -> [CS ()] -> [CS ()]
forall a. a -> [a] -> [a]
:ArrAcc -> RT -> CS ()
mt (Temp -> CE -> CE -> Maybe AL -> Int64 -> ArrAcc
AElem Temp
qR CE
1 (Temp -> CE
Tmp Temp
i) Maybe AL
lQ Int64
qSz) RT
yCS () -> [CS ()] -> [CS ()]
forall a. a -> [a] -> [a]
:[CS ()]
ss
        loop = T () -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
forall {a}. T a -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
for1 (E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
p) Temp
i CE
1 IRel
ILt (Temp -> CE
Tmp Temp
szR) [CS ()]
step
    seed <- writeRF zop [x,y] (IT acc)
    pure $ plPP$plQ$szR =: ev tPs (pR,lP):mt (AElem pR 1 0 lP pSz) x:mt (AElem qR 1 0 lQ qSz) y:seed++[loop]
eval E (T ())
e Temp
_          = [Char] -> State CSt [CS ()]
forall a. HasCallStack => [Char] -> a
error (E (T ()) -> [Char]
forall a. Show a => a -> [Char]
show E (T ())
e)

frel :: Builtin -> Maybe FRel
frel :: Builtin -> Maybe FRel
frel Builtin
Gte=FRel -> Maybe FRel
forall a. a -> Maybe a
Just FRel
FGeq; frel Builtin
Lte=FRel -> Maybe FRel
forall a. a -> Maybe a
Just FRel
FLeq; frel Builtin
Eq=FRel -> Maybe FRel
forall a. a -> Maybe a
Just FRel
FEq; frel Builtin
Neq=FRel -> Maybe FRel
forall a. a -> Maybe a
Just FRel
FNeq; frel Builtin
Lt=FRel -> Maybe FRel
forall a. a -> Maybe a
Just FRel
FLt; frel Builtin
Gt=FRel -> Maybe FRel
forall a. a -> Maybe a
Just FRel
FGt; frel Builtin
_=Maybe FRel
forall a. Maybe a
Nothing

mFop :: Builtin -> Maybe FBin
mFop :: Builtin -> Maybe FBin
mFop Builtin
Plus=FBin -> Maybe FBin
forall a. a -> Maybe a
Just FBin
FPlus; mFop Builtin
Times=FBin -> Maybe FBin
forall a. a -> Maybe a
Just FBin
FTimes; mFop Builtin
Minus=FBin -> Maybe FBin
forall a. a -> Maybe a
Just FBin
FMinus; mFop Builtin
Div=FBin -> Maybe FBin
forall a. a -> Maybe a
Just FBin
FDiv; mFop Builtin
Exp=FBin -> Maybe FBin
forall a. a -> Maybe a
Just FBin
FExp; mFop Builtin
Max=FBin -> Maybe FBin
forall a. a -> Maybe a
Just FBin
FMax; mFop Builtin
Min=FBin -> Maybe FBin
forall a. a -> Maybe a
Just FBin
FMin; mFop Builtin
_=Maybe FBin
forall a. Maybe a
Nothing

mB :: Builtin -> Maybe BBin
mB :: Builtin -> Maybe BBin
mB Builtin
And=BBin -> Maybe BBin
forall a. a -> Maybe a
Just BBin
AndB;mB Builtin
Or=BBin -> Maybe BBin
forall a. a -> Maybe a
Just BBin
OrB;mB Builtin
Xor=BBin -> Maybe BBin
forall a. a -> Maybe a
Just BBin
XorB; mB Builtin
_=Maybe BBin
forall a. Maybe a
Nothing

mOp :: Builtin -> Maybe IBin
mOp :: Builtin -> Maybe IBin
mOp Builtin
Plus=IBin -> Maybe IBin
forall a. a -> Maybe a
Just IBin
IPlus;mOp Builtin
Times=IBin -> Maybe IBin
forall a. a -> Maybe a
Just IBin
ITimes;mOp Builtin
Minus=IBin -> Maybe IBin
forall a. a -> Maybe a
Just IBin
IMinus; mOp Builtin
Mod=IBin -> Maybe IBin
forall a. a -> Maybe a
Just IBin
IRem; mOp Builtin
Sl=IBin -> Maybe IBin
forall a. a -> Maybe a
Just IBin
IAsl;mOp Builtin
Sr=IBin -> Maybe IBin
forall a. a -> Maybe a
Just IBin
IAsr;mOp Builtin
A.IDiv=IBin -> Maybe IBin
forall a. a -> Maybe a
Just IBin
Op.IDiv;mOp Builtin
a=BBin -> IBin
BI(BBin -> IBin) -> Maybe BBin -> Maybe IBin
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>Builtin -> Maybe BBin
mB Builtin
a

mFun :: Builtin -> Maybe FUn
mFun :: Builtin -> Maybe FUn
mFun Builtin
Sqrt=FUn -> Maybe FUn
forall a. a -> Maybe a
Just FUn
FSqrt; mFun Builtin
Log=FUn -> Maybe FUn
forall a. a -> Maybe a
Just FUn
FLog; mFun Builtin
Sin=FUn -> Maybe FUn
forall a. a -> Maybe a
Just FUn
FSin; mFun Builtin
Cos=FUn -> Maybe FUn
forall a. a -> Maybe a
Just FUn
FCos; mFun Builtin
Abs=FUn -> Maybe FUn
forall a. a -> Maybe a
Just FUn
FAbs; mFun Builtin
_=Maybe FUn
forall a. Maybe a
Nothing

mFEval :: E (T ()) -> Maybe (CM CFE)
mFEval :: E (T ()) -> Maybe (CM CFE)
mFEval (FLit T ()
_ Double
d) = CM CFE -> Maybe (CM CFE)
forall a. a -> Maybe a
Just (CFE -> CM CFE
forall a. a -> StateT CSt Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CFE -> CM CFE) -> CFE -> CM CFE
forall a b. (a -> b) -> a -> b
$ Double -> CFE
ConstF Double
d)
mFEval (Var T ()
_ Nm (T ())
x) = CM CFE -> Maybe (CM CFE)
forall a. a -> Maybe a
Just (CM CFE -> Maybe (CM CFE)) -> CM CFE -> Maybe (CM CFE)
forall a b. (a -> b) -> a -> b
$ do
    st <- (CSt -> IntMap FTemp) -> StateT CSt Identity (IntMap FTemp)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets CSt -> IntMap FTemp
dvars
    pure (FTmp (getT st x))
mFEval E (T ())
_ = Maybe (CM CFE)
forall a. Maybe a
Nothing

cond :: E (T ()) -> E (T ()) -> E (T ()) -> RT -> CM (Maybe AL, [CS ()])
cond :: E (T ()) -> E (T ()) -> E (T ()) -> RT -> CM (Maybe AL, [CS ()])
cond (EApp T ()
_ (EApp T ()
_ (Builtin (Arrow T ()
F T ()
_) Builtin
op) E (T ())
c0) E (T ())
c1) E (T ())
e E (T ())
e1 (FT FTemp
t) | Just FRel
cmp <- Builtin -> Maybe FRel
frel Builtin
op, Just CM CFE
cfe <- E (T ()) -> Maybe (CM CFE)
mFEval E (T ())
e1 = do
    c0R <- CM FTemp
newFTemp; c1R <- newFTemp
    plC0 <- feval c0 c0R; plC1 <- feval c1 c1R
    eR <- newFTemp; fe <- cfe
    plE <- feval e eR
    pure (Nothing, plC0 ++ plC1 ++ [MX () t fe] ++ plE ++ [Fcmov () (FRel cmp (FTmp c0R) (FTmp c1R)) t (FTmp eR)])
cond (EApp T ()
_ (EApp T ()
_ (Builtin (Arrow T ()
F T ()
_) Builtin
o) E (T ())
c0) E (T ())
c1) E (T ())
e0 E (T ())
e1 RT
t | Just FRel
f <- Builtin -> Maybe FRel
frel Builtin
o, T () -> Bool
forall a. T a -> Bool
isIF (E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
e0) = do
    c0R <- CM FTemp
newFTemp; c1R <- newFTemp
    plC0 <- feval c0 c0R; plC1 <- feval c1 c1R
    plE0 <- eeval e0 t; plE1 <- eeval e1 t
    pure (Nothing, plC0 ++ plC1 ++ [If () (FRel f (FTmp c0R) (FTmp c1R)) plE0 plE1])
cond (EApp T ()
_ (EApp T ()
_ (Builtin (Arrow T ()
I T ()
_) Builtin
op) E (T ())
c0) E (T ())
c1) E (T ())
e E (T ())
e1 (FT FTemp
t) | Just IRel
cmp <- Builtin -> Maybe IRel
rel Builtin
op, Just CM CFE
cfe <- E (T ()) -> Maybe (CM CFE)
mFEval E (T ())
e1 = do
    c0R <- CM Temp
newITemp
    plC0 <- eval c0 c0R
    (plC1,c1e) <- plC c1
    eR <- newFTemp; fe <- cfe
    plE <- feval e eR
    pure (Nothing, plC0 ++ plC1 ([MX () t fe] ++ plE ++ [Fcmov () (IRel cmp (Tmp c0R) c1e) t (FTmp eR)]))
cond (EApp T ()
_ (EApp T ()
_ (Builtin (Arrow T ()
I T ()
_) Builtin
op) E (T ())
c0) E (T ())
c1) E (T ())
e0 E (T ())
e1 RT
t | Just IRel
cmp <- Builtin -> Maybe IRel
rel Builtin
op, T () -> Bool
forall a. T a -> Bool
isIF (E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
e0) = do
    c0R <- CM Temp
newITemp; c1R <- newITemp
    plC0 <- eval c0 c0R; plC1 <- eval c1 c1R
    plE0 <- eeval e0 t; plE1 <- eeval e1 t
    pure (Nothing, plC0 ++ plC1 ++ [If () (IRel cmp (Tmp c0R) (Tmp c1R)) plE0 plE1])
cond E (T ())
p E (T ())
e0 E (T ())
e1 RT
t | T () -> Bool
forall a. T a -> Bool
isIF (E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
e0) = do
    pR <- CM BTemp
nBT
    plPP <- peval p pR; plE0 <- eeval e0 t; plE1 <- eeval e1 t
    pure (Nothing, plPP ++ [If () (Is pR) plE0 plE1])

feval :: E (T ()) -> FTemp -> CM [CS ()]
feval :: E (T ()) -> FTemp -> State CSt [CS ()]
feval (LLet T ()
_ (Nm (T ()), E (T ()))
b E (T ())
e) FTemp
t = do
    ss <- (Nm (T ()), E (T ())) -> State CSt [CS ()]
llet (Nm (T ()), E (T ()))
b
    (ss++) <$> feval e t
feval (ILit T ()
_ Integer
x) FTemp
t = [CS ()] -> State CSt [CS ()]
forall a. a -> StateT CSt Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [() -> FTemp -> CFE -> CS ()
forall a. a -> FTemp -> CFE -> CS a
MX () FTemp
t (Double -> CFE
ConstF (Double -> CFE) -> Double -> CFE
forall a b. (a -> b) -> a -> b
$ Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
x)] -- if it overflows you deserve it
feval (FLit T ()
_ Double
x) FTemp
t = [CS ()] -> State CSt [CS ()]
forall a. a -> StateT CSt Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [() -> FTemp -> CFE -> CS ()
forall a. a -> FTemp -> CFE -> CS a
MX () FTemp
t (Double -> CFE
ConstF Double
x)]
feval (Var T ()
_ Nm (T ())
x) FTemp
t = do
    st <- (CSt -> IntMap FTemp) -> StateT CSt Identity (IntMap FTemp)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets CSt -> IntMap FTemp
dvars
    pure [MX () t (FTmp $ getT st x)]
feval (EApp T ()
_ (EApp T ()
_ (Builtin T ()
_ Builtin
A.R) (FLit T ()
_ Double
0)) (FLit T ()
_ Double
1)) FTemp
t = [CS ()] -> State CSt [CS ()]
forall a. a -> StateT CSt Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [() -> FTemp -> CS ()
forall a. a -> FTemp -> CS a
FRnd () FTemp
t]
feval (EApp T ()
_ (EApp T ()
_ (Builtin T ()
_ Builtin
A.R) (FLit T ()
_ Double
0)) E (T ())
e1) FTemp
t = do
    (plE1,e1e) <- E (T ()) -> CM ([CS ()] -> [CS ()], CFE)
plD E (T ())
e1
    pure $ plE1 [FRnd () t, MX () t (FTmp t*e1e)]
feval (EApp T ()
_ (EApp T ()
_ (Builtin T ()
_ Builtin
A.R) E (T ())
e0) E (T ())
e1) FTemp
t = do
    (plE0,e0e) <- E (T ()) -> CM ([CS ()] -> [CS ()], CFE)
plD E (T ())
e0; (plE1, e1e) <- plD e1
    pure $ plE0 $ plE1 [FRnd () t, MX () t ((e1e-e0e)*FTmp t+e0e)]
feval (EApp T ()
_ (EApp T ()
_ (Builtin T ()
_ Builtin
Plus) E (T ())
e0) (EApp T ()
_ (EApp T ()
_ (Builtin T ()
_ Builtin
Times) E (T ())
e1) E (T ())
e2)) FTemp
t = do
    (pl0,t0) <- E (T ()) -> CM ([CS ()] -> [CS ()], FTemp)
plF E (T ())
e0; (pl1,t1) <- plF e1; (pl2,t2) <- plF e2
    pure $ pl0 $ pl1 $ pl2 [MX () t (FTmp t0+FTmp t1*FTmp t2)]
feval (EApp T ()
_ (EApp T ()
_ (Builtin T ()
_ Builtin
op) E (T ())
e0) E (T ())
e1) FTemp
t | Just FBin
fb <- Builtin -> Maybe FBin
mFop Builtin
op = do
    (pl0,e0e) <- E (T ()) -> CM ([CS ()] -> [CS ()], CFE)
plD E (T ())
e0; (pl1,e1R) <- plF e1
    pure $ pl0 $ pl1 [MX () t (FBin fb e0e (FTmp e1R))]
feval (EApp T ()
_ (EApp T ()
_ (Builtin T ()
_ Builtin
IntExp) (FLit T ()
_ (-1))) E (T ())
n) FTemp
t = do
    (plR,nR) <- E (T ()) -> CM ([CS ()] -> [CS ()], Temp)
plEV E (T ())
n
    pure $ plR [MX () t 1, Fcmov () (IUn IOdd (Tmp nR)) t (ConstF (-1))]
feval (EApp T ()
_ (EApp T ()
_ (Builtin T ()
_ Builtin
IntExp) E (T ())
x) E (T ())
n) FTemp
t = do
    xR <- CM FTemp
newFTemp; nR <- newITemp
    plX <- feval x xR; plN <- eval n nR
    pure $ plX ++ plN ++ [MX () t 1, While () nR IGt 0 [Ifn't () (IUn IEven (Tmp nR)) [MX () t (FTmp t*FTmp xR)], nR =: Bin IAsr (Tmp nR) 1, MX () xR (FTmp xR*FTmp xR)]]
feval (EApp T ()
_ (Builtin T ()
_ Builtin
f) E (T ())
e) FTemp
t | Just FUn
ff <- Builtin -> Maybe FUn
mFun Builtin
f = do
    (plE,eC) <- E (T ()) -> CM ([CS ()] -> [CS ()], CFE)
plD E (T ())
e
    pure $ plE [MX () t (FUn ff eC)]
feval (EApp T ()
_ (Builtin T ()
_ Builtin
Neg) E (T ())
x) FTemp
t = do
    (plE,f) <- E (T ()) -> CM ([CS ()] -> [CS ()], CFE)
plD E (T ())
x
    pure $ plE [MX () t (negate f)]
feval (EApp T ()
_ (Builtin T ()
_ Builtin
ItoF) E (T ())
e) FTemp
t = do
    (pl,iE) <- E (T ()) -> CM ([CS ()] -> [CS ()], CE)
plC E (T ())
e
    pure $ pl [MX () t (IE iE)]
feval (Cond T ()
_ E (T ())
p E (T ())
e0 E (T ())
e1) FTemp
t = (Maybe AL, [CS ()]) -> [CS ()]
forall a b. (a, b) -> b
snd ((Maybe AL, [CS ()]) -> [CS ()])
-> CM (Maybe AL, [CS ()]) -> State CSt [CS ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> E (T ()) -> E (T ()) -> E (T ()) -> RT -> CM (Maybe AL, [CS ()])
cond E (T ())
p E (T ())
e0 E (T ())
e1 (FTemp -> RT
FT FTemp
t)
feval (EApp T ()
_ (Builtin T ()
_ Builtin
Head) E (T ())
xs) FTemp
t = do
    (plX, (l, a)) <- E (T ()) -> CM ([CS ()] -> [CS ()], (Maybe AL, Temp))
plA E (T ())
xs
    pure $ plX [MX () t (FAt (AElem a 1 0 l 8))]
feval (EApp T ()
_ (EApp T ()
_ (Builtin T ()
_ Builtin
A1) E (T ())
e) E (T ())
i) FTemp
t = do
    (plE, (lE, eR)) <- E (T ()) -> CM ([CS ()] -> [CS ()], (Maybe AL, Temp))
plA E (T ())
e; (plI, iR) <- plC i
    pure $ plE $ plI [MX () t (FAt (AElem eR 1 iR lE 8))]
feval (EApp T ()
_ (Builtin T ()
_ Builtin
Last) E (T ())
xs) FTemp
t = do
    (plX, (l, a)) <- E (T ()) -> CM ([CS ()] -> [CS ()], (Maybe AL, Temp))
plA E (T ())
xs
    pure $ plX [MX () t (FAt (AElem a 1 (ev (eAnn xs) (a,l)-1) l 8))]
feval (Id T ()
_ (FoldOfZip E (T ())
zop E (T ())
op [E (T ())
p])) FTemp
acc | T ()
tPs <- E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
p, Just (T ()
tP, Int64
pSz) <- T () -> Maybe (T (), Int64)
forall b a. Integral b => T a -> Maybe (T a, b)
aRr T ()
tPs = do
    x <- T () -> CM RT
forall a. T a -> CM RT
rtemp T ()
tP
    szR <- newITemp
    i <- newITemp
    (plPP, (lP, pR)) <- plA p
    ss <- writeRF op [FT acc, x] (FT acc)
    let step = ArrAcc -> RT -> CS ()
mt (Temp -> CE -> CE -> Maybe AL -> Int64 -> ArrAcc
AElem Temp
pR CE
1 (Temp -> CE
Tmp Temp
i) Maybe AL
lP Int64
pSz) RT
xCS () -> [CS ()] -> [CS ()]
forall a. a -> [a] -> [a]
:[CS ()]
ss
        loop = T () -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
forall {a}. T a -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
for1 (E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
p) Temp
i CE
1 IRel
ILt (Temp -> CE
Tmp Temp
szR) [CS ()]
step
    sseed <- writeRF zop [x] (FT acc)
    pure $ plPP$szR =: ev tPs (pR,lP):mt (AElem pR 1 0 lP pSz) x:sseed++[loop]
feval (Id T ()
_ (FoldOfZip E (T ())
zop E (T ())
op [EApp T ()
_ (EApp T ()
_ (EApp T ()
_ (Builtin T ()
_ Builtin
FRange) (FLit T ()
_ Double
start)) (FLit T ()
_ Double
end)) (ILit T ()
_ Integer
steps), E (T ())
ys])) FTemp
acc | Just (T ()
tQ, Int64
qSz) <- T () -> Maybe (T (), Int64)
forall b a. Integral b => T a -> Maybe (T a, b)
aRr (E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
ys) = do
    x <- CM FTemp
newFTemp; y <- rtemp tQ
    incrR <- newFTemp; i <- newITemp
    plY <- eeval (EApp tQ (Builtin undefined Head) ys) y
    (plYs, (lY, yR)) <- plA ys
    plIncr <- feval (FLit F$(end-start)/realToFrac (steps-1)) incrR
    seed <- writeRF zop [FT x, y] (FT acc)
    ss <- writeRF op [FT acc, FT x, y] (FT acc)
    pure $ plYs $ plY ++ MX () x (ConstF start):seed ++ plIncr ++ [for1 (eAnn ys) i 1 ILt (ConstI$fromIntegral steps) (mt (AElem yR 1 (Tmp i) lY qSz) y:MX () x (FTmp x+FTmp incrR):ss)]
feval (Id T ()
_ (FoldOfZip E (T ())
zop E (T ())
op [EApp T ()
_ (EApp T ()
_ (EApp T ()
_ (Builtin T ()
_ Builtin
FRange) E (T ())
start) E (T ())
end) E (T ())
steps, E (T ())
ys])) FTemp
acc | Just (T ()
tQ, Int64
qSz) <- T () -> Maybe (T (), Int64)
forall b a. Integral b => T a -> Maybe (T a, b)
aRr (E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
ys) = do
    x <- CM FTemp
newFTemp; y <- rtemp tQ
    incrR <- newFTemp; n <- newITemp; i <- newITemp
    plX <- feval start x; plY <- eeval (EApp tQ (Builtin undefined Head) ys) y
    (plYs, (lY, yR)) <- plA ys
    plN <- eval steps n
    plIncr <- feval ((end `eMinus` start) `eDiv` (EApp F (Builtin (Arrow I F) ItoF) steps `eMinus` FLit F 1)) incrR
    seed <- writeRF zop [FT x, y] (FT acc)
    ss <- writeRF op [FT acc, FT x, y] (FT acc)
    pure $ plYs $ plY ++ plX ++ seed ++ plIncr ++ plN ++ [for1 (eAnn ys) i 1 ILt (Tmp n) (mt (AElem yR 1 (Tmp i) lY qSz) y:MX () x (FTmp x+FTmp incrR):ss)]
feval (Id T ()
_ (FoldOfZip E (T ())
zop E (T ())
op [EApp T ()
_ (EApp T ()
_ (EApp T ()
_ (Builtin T ()
_ Builtin
IRange) E (T ())
start) E (T ())
_) E (T ())
incr, E (T ())
ys])) FTemp
acc | Just (T ()
tQ, Int64
qSz) <- T () -> Maybe (T (), Int64)
forall b a. Integral b => T a -> Maybe (T a, b)
aRr (E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
ys) = do
    x <- CM Temp
newITemp; y <- rtemp tQ
    szR <- newITemp; i <- newITemp
    plX <- eval start x; plY <- eeval (EApp tQ (Builtin undefined Head) ys) y
    (plYs, (lY, yR)) <- plA ys
    (plI,iE) <- plC incr
    seed <- writeRF zop [IT x, y] (FT acc)
    ss <- writeRF op [FT acc, IT x, y] (FT acc)
    pure $ plYs $ plY ++ plX ++ seed ++ plI (szR =: ev (eAnn ys) (yR,lY):[for1 (eAnn ys) i 1 ILt (Tmp szR) (mt (AElem yR 1 (Tmp i) lY qSz) y:x+=iE:ss)])
feval (Id T ()
_ (FoldOfZip E (T ())
zop E (T ())
op [E (T ())
p, E (T ())
q])) FTemp
acc | T ()
tPs <- E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
p, Just (T ()
tP, Int64
pSz) <- T () -> Maybe (T (), Int64)
forall b a. Integral b => T a -> Maybe (T a, b)
aRr T ()
tPs, Just (T ()
tQ, Int64
qSz) <- T () -> Maybe (T (), Int64)
forall b a. Integral b => T a -> Maybe (T a, b)
aRr (E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
q) = do
    x <- T () -> CM RT
forall a. T a -> CM RT
rtemp T ()
tP; y <- rtemp tQ
    szR <- newITemp
    i <- newITemp
    (plPP, (lP, pR)) <- plA p; (plQ, (lQ, qR)) <- plA q
    ss <- writeRF op [FT acc, x, y] (FT acc)
    let step = ArrAcc -> RT -> CS ()
mt (Temp -> CE -> CE -> Maybe AL -> Int64 -> ArrAcc
AElem Temp
pR CE
1 (Temp -> CE
Tmp Temp
i) Maybe AL
lP Int64
pSz) RT
xCS () -> [CS ()] -> [CS ()]
forall a. a -> [a] -> [a]
:ArrAcc -> RT -> CS ()
mt (Temp -> CE -> CE -> Maybe AL -> Int64 -> ArrAcc
AElem Temp
qR CE
1 (Temp -> CE
Tmp Temp
i) Maybe AL
lQ Int64
qSz) RT
yCS () -> [CS ()] -> [CS ()]
forall a. a -> [a] -> [a]
:[CS ()]
ss
        loop = T () -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
forall {a}. T a -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
for1 T ()
tP Temp
i CE
1 IRel
ILt (Temp -> CE
Tmp Temp
szR) [CS ()]
step
    seed <- writeRF zop [x,y] (FT acc)
    pure $ plPP$plQ$szR =: ev tPs (pR,lP):mt (AElem pR 1 0 lP pSz) x:mt (AElem qR 1 0 lQ qSz) y:seed++[loop]
feval (EApp T ()
_ (EApp T ()
_ (Builtin T ()
_ Builtin
Fold) E (T ())
op) E (T ())
e) FTemp
acc | (Arrow T ()
tX T ()
_) <- E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
op, T () -> Bool
forall a. T a -> Bool
isF T ()
tX = do
    x <- CM FTemp
newFTemp
    szR <- newITemp
    i <- newITemp
    (plE, (l, aP)) <- plA e
    ss <- writeRF op [FT acc, FT x] (FT acc)
    let loopBody=() -> FTemp -> CFE -> CS ()
forall a. a -> FTemp -> CFE -> CS a
MX () FTemp
x (ArrAcc -> CFE
FAt (Temp -> CE -> CE -> Maybe AL -> Int64 -> ArrAcc
AElem Temp
aP CE
1 (Temp -> CE
Tmp Temp
i) Maybe AL
l Int64
8))CS () -> [CS ()] -> [CS ()]
forall a. a -> [a] -> [a]
:[CS ()]
ss
        loop=T () -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
forall {a}. T a -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
for1 (E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
e) Temp
i CE
1 IRel
ILt (Temp -> CE
Tmp Temp
szR) [CS ()]
loopBody
    pure $ plE$szR =: ev (eAnn e) (aP,l):MX () acc (FAt (AElem aP 1 0 l 8)):[loop]
feval (EApp T ()
_ (EApp T ()
_ (EApp T ()
_ (Builtin T ()
_ Builtin
Foldl) E (T ())
op) E (T ())
seed) E (T ())
e) FTemp
acc | (Arrow T ()
_ (Arrow T ()
tX T ()
_)) <- E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
op, T () -> Bool
forall a. T a -> Bool
isIF T ()
tX = do
    x <- T () -> CM RT
forall a. T a -> CM RT
rtemp T ()
tX
    i <- newITemp
    (plE, (l, eR)) <- plA e
    plAcc <- feval seed acc
    ss <- writeRF op [x, FT acc] (FT acc)
    let loopBody=ArrAcc -> RT -> CS ()
mt (Temp -> CE -> CE -> Maybe AL -> Int64 -> ArrAcc
AElem Temp
eR CE
1 (Temp -> CE
Tmp Temp
i) Maybe AL
l Int64
8) RT
xCS () -> [CS ()] -> [CS ()]
forall a. a -> [a] -> [a]
:[CS ()]
ss[CS ()] -> [CS ()] -> [CS ()]
forall a. [a] -> [a] -> [a]
++[Temp
i Temp -> CE -> CS ()
=: (Temp -> CE
Tmp Temp
iCE -> CE -> CE
forall a. Num a => a -> a -> a
-CE
1)]
        loop=() -> Temp -> IRel -> CE -> [CS ()] -> CS ()
forall a. a -> Temp -> IRel -> CE -> [CS a] -> CS a
While () Temp
i IRel
IGeq CE
0 [CS ()]
loopBody
    pure $ plE $ plAcc++i =: (ev (eAnn e) (eR,l)-1):[loop]
feval (EApp T ()
_ (EApp T ()
_ (EApp T ()
_ (Builtin T ()
_ Builtin
FoldA) E (T ())
op) E (T ())
seed) E (T ())
xs) FTemp
acc | Arr Sh ()
sh T ()
_ <- E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
xs, (Arrow T ()
_ (Arrow T ()
tX T ()
_)) <- E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
op, T () -> Bool
forall a. T a -> Bool
isIF T ()
tX = do
    x <- T () -> CM RT
forall a. T a -> CM RT
rtemp T ()
tX
    rnkR <- newITemp; szR <- newITemp; k <- newITemp
    (plE, (lX, xsR)) <- plA xs
    plAcc <- feval seed acc
    ss <- writeRF op [x, FT acc] (FT acc)
    let step=ArrAcc -> RT -> CS ()
mt (Temp -> CE -> CE -> Maybe AL -> Int64 -> ArrAcc
AElem Temp
xsR (Temp -> CE
Tmp Temp
rnkR) (Temp -> CE
Tmp Temp
k) Maybe AL
lX Int64
8) RT
xCS () -> [CS ()] -> [CS ()]
forall a. a -> [a] -> [a]
:[CS ()]
ss
        loop=T () -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
forall {a}. T a -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
for (E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
xs) Temp
k CE
0 IRel
ILt (Temp -> CE
Tmp Temp
szR) [CS ()]
step
        plSz = case T () -> Maybe (T (), [Int64])
forall a. T a -> Maybe (T a, [Int64])
tIx (E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
xs) of {Just (T ()
_, [Int64]
is) -> Temp
szRTemp -> CE -> CS ()
=:Int64 -> CE
ConstI ([Int64] -> Int64
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product [Int64]
is); Maybe (T (), [Int64])
Nothing -> () -> Temp -> Temp -> CE -> Maybe AL -> CS ()
forall a. a -> Temp -> Temp -> CE -> Maybe AL -> CS a
SZ () Temp
szR Temp
xsR (Temp -> CE
Tmp Temp
rnkR) Maybe AL
lX}
    pure $ plE $ plAcc ++ [rnkR =: eRnk sh (xsR, lX), plSz, loop]
feval (EApp T ()
_ (EApp T ()
_ (EApp T ()
_ (Builtin T ()
_ Builtin
FoldS) E (T ())
op) E (T ())
seed) (EApp T ()
_ (EApp T ()
_ (EApp T ()
_ (Builtin T ()
_ Builtin
IRange) E (T ())
start) E (T ())
end) E (T ())
incr)) FTemp
acc = do
    i <- CM Temp
newITemp
    endR <- newITemp
    (plI,iE) <- plC incr
    plStart <- eval start i; plAcc <- feval seed acc; plEnd <- eval end endR
    ss <- writeRF op [FT acc, IT i] (FT acc)
    pure $ plStart ++ plAcc ++ plEnd ++ plI [While () i ILeq (Tmp endR) (ss++[i+=iE])]
feval (EApp T ()
_ (EApp T ()
_ (EApp T ()
_ (Builtin T ()
_ Builtin
FoldS) E (T ())
op) E (T ())
seed) (EApp T ()
ty (EApp T ()
_ (EApp T ()
_ (Builtin T ()
_ Builtin
FRange) E (T ())
start) E (T ())
end) E (T ())
nSteps)) FTemp
acc = do
    i <- CM Temp
newITemp; startR <- newFTemp; incrR <- newFTemp; xR <- newFTemp; endI <- newITemp
    plStart <- feval start startR
    plAcc <- feval seed acc
    plEnd <- eval nSteps endI
    plIncr <- feval ((end `eMinus` start) `eDiv` (EApp F (Builtin (Arrow I F) ItoF) nSteps `eMinus` FLit F 1)) incrR
    ss <- writeRF op [FT acc, FT xR] (FT acc)
    pure $ plStart ++ MX () xR (FTmp startR):plEnd++plIncr++plAcc++[for ty i 0 ILt (Tmp endI) (ss++[MX () xR (FTmp xR+FTmp incrR)])]
feval (EApp T ()
_ (EApp T ()
_ (EApp T ()
_ (Builtin T ()
_ Builtin
FoldS) E (T ())
op) E (T ())
seed) E (T ())
e) FTemp
acc | (Arrow T ()
_ (Arrow T ()
tX T ()
_)) <- E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
op, Just Int64
xSz <- T () -> Maybe Int64
forall b a. Integral b => T a -> Maybe b
rSz T ()
tX = do
    x <- T () -> CM RT
forall a. T a -> CM RT
rtemp T ()
tX
    szR <- newITemp
    i <- newITemp
    (plE, (l, eR)) <- plA e
    plAcc <- feval seed acc
    ss <- writeRF op [FT acc, x] (FT acc)
    let loopBody=ArrAcc -> RT -> CS ()
mt (Temp -> CE -> CE -> Maybe AL -> Int64 -> ArrAcc
AElem Temp
eR CE
1 (Temp -> CE
Tmp Temp
i) Maybe AL
l Int64
xSz) RT
xCS () -> [CS ()] -> [CS ()]
forall a. a -> [a] -> [a]
:[CS ()]
ss
        loop=T () -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
forall {a}. T a -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
for (E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
e) Temp
i CE
0 IRel
ILt (Temp -> CE
Tmp Temp
szR) [CS ()]
loopBody
    pure $ plE $ plAcc++szR =: ev (eAnn e) (eR,l):[loop]
feval (EApp T ()
_ (EApp T ()
_ (EApp T ()
_ (Builtin T ()
_ Builtin
Iter) E (T ())
f) E (T ())
n) E (T ())
x) FTemp
t = do
    (plN,nR) <- E (T ()) -> CM ([CS ()] -> [CS ()], CE)
plC E (T ())
n
    plX <- feval x t
    ss <- writeRF f [FT t] (FT t)
    i <- newITemp
    let loop=() -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
forall a. a -> Temp -> CE -> IRel -> CE -> [CS a] -> CS a
For () Temp
i CE
0 IRel
ILt CE
nR [CS ()]
ss
    pure $ plX ++ plN [loop]
feval (EApp T ()
_ (Builtin T ()
_ (TAt Int
i)) E (T ())
e) FTemp
t = do
    k <- CM Temp
newITemp
    (offs, a, _, plT) <- πe e k
    pure $ m'sa k a++plT ++ MX () t (FAt (Raw k (ConstI$offs!!(i-1)) Nothing 1)):m'pop a
feval (EApp T ()
_ (Var T ()
_ Nm (T ())
f) E (T ())
x) FTemp
t | T () -> Bool
forall a. T a -> Bool
isF (E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
x) = do
    st <- (CSt -> IntMap (Label, [Arg], Either FTemp Temp))
-> StateT CSt Identity (IntMap (Label, [Arg], Either FTemp Temp))
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets CSt -> IntMap (Label, [Arg], Either FTemp Temp)
fvars
    let (l, [FA a], Left r) = getT st f
    plX <- feval x a
    retL <- neL
    pure $ plX ++ [G () l retL, MX () t (FTmp r)]
feval (Id T ()
_ (FoldGen E (T ())
seed E (T ())
g E (T ())
f E (T ())
n)) FTemp
t = do
    x <- CM FTemp
newFTemp; acc <- newFTemp
    nR <- newITemp; k <- newITemp
    (plSeed,seedR) <- plF seed
    plN <- eval n nR
    uss <- writeRF g [FT x] (FT x)
    fss <- writeRF f [FT acc, FT x] (FT acc)
    pure $ plSeed $ plN++[MX () acc (FTmp seedR), MX () x (FTmp seedR), For () k 0 ILt (Tmp nR) (fss++uss), MX () t (FTmp acc)]
feval E (T ())
e FTemp
_ = [Char] -> State CSt [CS ()]
forall a. HasCallStack => [Char] -> a
error (E (T ()) -> [Char]
forall a. Show a => a -> [Char]
show E (T ())
e)

m'pop :: Maybe CE -> [CS ()]
m'pop :: Maybe CE -> [CS ()]
m'pop = [CS ()] -> (CE -> [CS ()]) -> Maybe CE -> [CS ()]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((CS () -> [CS ()] -> [CS ()]
forall a. a -> [a] -> [a]
:[])(CS () -> [CS ()]) -> (CE -> CS ()) -> CE -> [CS ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.() -> CE -> CS ()
forall a. a -> CE -> CS a
Pop ())

m'sa :: Temp -> Maybe CE -> [CS ()]
m'sa :: Temp -> Maybe CE -> [CS ()]
m'sa Temp
t = [CS ()] -> (CE -> [CS ()]) -> Maybe CE -> [CS ()]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe []  ((CS () -> [CS ()] -> [CS ()]
forall a. a -> [a] -> [a]
:[])(CS () -> [CS ()]) -> (CE -> CS ()) -> CE -> [CS ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.() -> Temp -> CE -> CS ()
forall a. a -> Temp -> CE -> CS a
Sa () Temp
t)

πe :: E (T ()) -> Temp -> CM ([Int64], Maybe CE, [AL], [CS ()]) -- element offsets, size to be popped off the stack, array labels kept live
πe :: E (T ()) -> Temp -> CM ([Int64], Maybe CE, [AL], [CS ()])
πe (EApp (P [T ()]
tys) (Builtin T ()
_ Builtin
Head) E (T ())
xs) Temp
t | [Int64]
offs <- [T ()] -> [Int64]
forall {a}. [T a] -> [Int64]
szT [T ()]
tys, Int64
sz <- [Int64] -> Int64
forall a. HasCallStack => [a] -> a
last [Int64]
offs, CE
szE <- Int64 -> CE
ConstI Int64
sz = do
    xR <- CM Temp
newITemp
    (lX, plX) <- aeval xs xR
    pure (offs, Just szE, [], plX++[CpyE () (TupM t Nothing) (AElem xR 1 0 lX sz) 1 sz])
πe (EApp (P [T ()]
tys) (Builtin T ()
_ Builtin
Last) E (T ())
xs) Temp
t | [Int64]
offs <- [T ()] -> [Int64]
forall {a}. [T a] -> [Int64]
szT [T ()]
tys, Int64
sz <- [Int64] -> Int64
forall a. HasCallStack => [a] -> a
last [Int64]
offs, CE
szE <- Int64 -> CE
ConstI Int64
sz = do
    xR <- CM Temp
newITemp
    (lX, plX) <- aeval xs xR
    pure (offs, Just szE, [], plX++[CpyE () (TupM t Nothing) (AElem xR 1 (ev (eAnn xs) (xR,lX)-1) lX sz) 1 sz])
πe (Tup (P [T ()]
tys) [E (T ())]
es) Temp
t | [Int64]
offs <- [T ()] -> [Int64]
forall {a}. [T a] -> [Int64]
szT [T ()]
tys, Int64
sz <- [Int64] -> Int64
forall a. HasCallStack => [a] -> a
last [Int64]
offs, CE
szE <- Int64 -> CE
ConstI Int64
sz = do
    (ls, ss) <- [(Maybe AL, [CS ()])] -> ([Maybe AL], [[CS ()]])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(Maybe AL, [CS ()])] -> ([Maybe AL], [[CS ()]]))
-> StateT CSt Identity [(Maybe AL, [CS ()])]
-> StateT CSt Identity ([Maybe AL], [[CS ()]])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        (E (T ()) -> Int64 -> CM (Maybe AL, [CS ()]))
-> [E (T ())]
-> [Int64]
-> StateT CSt Identity [(Maybe AL, [CS ()])]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (\E (T ())
e Int64
off ->
            case E (T ()) -> T ()
forall a. E a -> a
eAnn E (T ())
e of
                T ()
F     -> do {(plX, f) <- E (T ()) -> CM ([CS ()] -> [CS ()], CFE)
plD E (T ())
e; pure (Nothing, plX [WrF () (Raw t (ConstI off) Nothing 1) f])}
                T ()
I     -> do {(plX, i) <- E (T ()) -> CM ([CS ()] -> [CS ()], CE)
plC E (T ())
e; pure (Nothing, plX [Wr () (Raw t (ConstI off) Nothing 1) i])}
                T ()
B     -> do {(plX, r) <- E (T ()) -> CM ([CS ()] -> [CS ()], PE)
plP E (T ())
e; pure (Nothing, plX [WrP () (Raw t (ConstI off) Nothing 1) r])}
                Arr{} -> do {(pl, (l, r)) <- E (T ()) -> CM ([CS ()] -> [CS ()], (Maybe AL, Temp))
plA E (T ())
e; pure (l, pl [Wr () (Raw t (ConstI off) Nothing 1) (Tmp r)])}) [E (T ())]
es [Int64]
offs
    pure (offs, Just szE, catMaybes ls, concat ss)
πe (EApp (P [T ()]
tys) (EApp T ()
_ (Builtin T ()
_ Builtin
A1) E (T ())
e) E (T ())
i) Temp
t | [Int64]
offs <- [T ()] -> [Int64]
forall {a}. [T a] -> [Int64]
szT [T ()]
tys, Int64
sz <- [Int64] -> Int64
forall a. HasCallStack => [a] -> a
last [Int64]
offs, CE
szE <- Int64 -> CE
ConstI Int64
sz = do
    xR <- CM Temp
newITemp; iR <- newITemp
    (lX, plX) <- aeval e xR; plI <- eval i iR
    pure (offs, Just szE, mempty, plX ++ plI ++ [CpyE () (TupM t Nothing) (AElem xR 1 (Tmp iR) lX sz) 1 sz])
πe (Var (P [T ()]
tys) Nm (T ())
x) Temp
t = do
    st <- (CSt -> IntMap Temp) -> StateT CSt Identity (IntMap Temp)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets CSt -> IntMap Temp
vars
    pure (szT tys, Nothing, undefined, [t =: Tmp (getT st x)])
πe (LLet T ()
_ (Nm (T ()), E (T ()))
b E (T ())
e) Temp
t = do
    ss <- (Nm (T ()), E (T ())) -> State CSt [CS ()]
llet (Nm (T ()), E (T ()))
b
    fourth (ss++) <$> πe e t
πe (EApp T ()
_ (EApp T ()
_ (EApp T ()
_ (Builtin T ()
_ Builtin
Iter) E (T ())
f) E (T ())
n) E (T ())
x) Temp
t = do
    pre <- CM Temp
newITemp
    ttemp <- newITemp
    (plN,nR) <- plC n
    (offs, mSz, _, plX) <- πe x pre
    let sz=[Int64] -> Int64
forall a. HasCallStack => [a] -> a
last [Int64]
offs; szE=Int64 -> CE
ConstI Int64
sz
    (_, ss) <- writeF f [IPA pre] (IT t)
    i <- newITemp
    let loop=() -> Temp -> CE -> IRel -> CE -> [CS ()] -> CS ()
forall a. a -> Temp -> CE -> IRel -> CE -> [CS a] -> CS a
For () Temp
i CE
0 IRel
ILt CE
nR ([CS ()]
ss[CS ()] -> [CS ()] -> [CS ()]
forall a. [a] -> [a] -> [a]
++[() -> ArrAcc -> ArrAcc -> CE -> Int64 -> CS ()
forall a. a -> ArrAcc -> ArrAcc -> CE -> Int64 -> CS a
CpyE () (Temp -> Maybe AL -> ArrAcc
TupM Temp
ttemp Maybe AL
forall a. Maybe a
Nothing) (Temp -> Maybe AL -> ArrAcc
TupM Temp
t Maybe AL
forall a. Maybe a
Nothing) CE
1 Int64
sz, () -> ArrAcc -> ArrAcc -> CE -> Int64 -> CS ()
forall a. a -> ArrAcc -> ArrAcc -> CE -> Int64 -> CS a
CpyE () (Temp -> Maybe AL -> ArrAcc
TupM Temp
pre Maybe AL
forall a. Maybe a
Nothing) (Temp -> Maybe AL -> ArrAcc
TupM Temp
ttemp Maybe AL
forall a. Maybe a
Nothing) CE
1 Int64
sz])
    pure (offs, Just szE, [], m'sa pre mSz++plX++plN [Sa () ttemp szE, loop, Pop () szE]++m'pop mSz)
πe E (T ())
e Temp
_ = [Char] -> CM ([Int64], Maybe CE, [AL], [CS ()])
forall a. HasCallStack => [Char] -> a
error (E (T ()) -> [Char]
forall a. Show a => a -> [Char]
show E (T ())
e)

fourth :: (t -> d) -> (a, b, c, t) -> (a, b, c, d)
fourth t -> d
f ~(a
x,b
y,c
z,t
w) = (a
x,b
y,c
z,t -> d
f t
w)

qmap :: (t -> a)
-> (t -> b) -> (t -> c) -> (t -> d) -> (t, t, t, t) -> (a, b, c, d)
qmap t -> a
f t -> b
g t -> c
h t -> d
k ~(t
x,t
y,t
z,t
w) = (t -> a
f t
x, t -> b
g t
y, t -> c
h t
z, t -> d
k t
w)