-- SPDX-FileCopyrightText: 2020 Tocqueville Group
--
-- SPDX-License-Identifier: LicenseRef-MIT-TQ

-- | 'Expr' compilation

module Indigo.Internal.Expr.Compilation
  ( compileExpr
  , compileToExpr

  , ObjManipulationRes (..)
  , runObjectManipulation

  , nullaryOp
  , unaryOp
  , binaryOp
  , ternaryOp

  , nullaryOpFlat
  , unaryOpFlat
  , binaryOpFlat
  , ternaryOpFlat
  ) where

import Data.Vinyl.Core (RMap(..))

import qualified Lorentz.ADT as L
import qualified Lorentz.Instr as L
import qualified Lorentz.Macro as L
import Michelson.Typed.Haskell.Instr.Product (GetFieldType)

import Indigo.Backend.Prelude
import Indigo.Internal.Expr.Types
import Indigo.Internal.Field
import Indigo.Internal.Lookup (varActionGet)
import Indigo.Internal.Object
  (IndigoObjectF(..), NamedFieldVar(..), castFieldConstructors, namedToTypedRec, pushNoRefMd,
  typedToNamedRec)
import Indigo.Internal.State
  (GenCode(..), IndigoState(..), MetaData(..), iget, iput, usingIndigoState, (>>=))
import Indigo.Lorentz

compileExpr :: forall a inp . Expr a -> IndigoState inp (a & inp) ()
compileExpr :: Expr a -> IndigoState inp (a & inp) ()
compileExpr (C a :: a
a) = do
  MetaData inp
md <- IndigoState inp inp (MetaData inp)
forall (inp :: [*]). IndigoState inp inp (MetaData inp)
iget
  GenCode inp (a & inp) () -> IndigoState inp (a & inp) ()
forall (inp :: [*]) (out :: [*]) a.
GenCode inp out a -> IndigoState inp out a
iput (GenCode inp (a & inp) () -> IndigoState inp (a & inp) ())
-> GenCode inp (a & inp) () -> IndigoState inp (a & inp) ()
forall a b. (a -> b) -> a -> b
$ ()
-> MetaData (a & inp)
-> (inp :-> (a & inp))
-> ((a & inp) :-> inp)
-> GenCode inp (a & inp) ()
forall (inp :: [*]) (out :: [*]) a.
a
-> MetaData out
-> (inp :-> out)
-> (out :-> inp)
-> GenCode inp out a
GenCode () (MetaData inp -> MetaData (a & inp)
forall a (inp :: [*]).
KnownValue a =>
MetaData inp -> MetaData (a & inp)
pushNoRefMd MetaData inp
md) (a -> inp :-> (a & inp)
forall t (s :: [*]). NiceConstant t => t -> s :-> (t & s)
L.push a
a) (a & inp) :-> inp
forall a (s :: [*]). (a & s) :-> s
L.drop
compileExpr (V v :: Var a
v) = (forall (name :: Symbol).
 NamedFieldVar a name -> Expr (GetFieldType a name))
-> Var a -> IndigoState inp (a & inp) ()
forall a (inp :: [*]) (f :: Symbol -> *).
(forall (name :: Symbol). f name -> Expr (GetFieldType a name))
-> IndigoObjectF f a -> IndigoState inp (a & inp) ()
compileObjectF (\(NamedFieldVar fl) -> Var
  (LnrFieldType (LNRequireFound name a (GLookupNamed name (Rep a))))
-> Expr
     (LnrFieldType (LNRequireFound name a (GLookupNamed name (Rep a))))
forall a. KnownValue a => Var a -> Expr a
V Var
  (LnrFieldType (LNRequireFound name a (GLookupNamed name (Rep a))))
fl) Var a
v
compileExpr (Update m :: exStructure
m key :: exKey
key val :: exVal
val) = exKey
-> exVal
-> exStructure
-> ((UpdOpKeyHs a & (UpdOpParamsHs a & (a & inp))) :-> (a & inp))
-> IndigoState inp (a & inp) ()
forall n m l ex1 ex2 ex3 res (inp :: [*]).
(AreExprs ex1 ex2 n m, IsExpr ex3 l, KnownValue res) =>
ex1
-> ex2
-> ex3
-> ((n & (m & (l & inp))) :-> (res & inp))
-> IndigoState inp (res & inp) ()
ternaryOp exKey
key exVal
val exStructure
m (UpdOpKeyHs a & (UpdOpParamsHs a & (a & inp))) :-> (a & inp)
forall c (s :: [*]).
UpdOpHs c =>
(UpdOpKeyHs c & (UpdOpParamsHs c & (c & s))) :-> (c & s)
L.update
compileExpr (Add e1 :: ex1
e1 e2 :: ex2
e2) = ex1
-> ex2
-> ((n & (m & inp)) :-> (a & inp))
-> IndigoState inp (a & inp) ()
forall n m ex1 ex2 res (inp :: [*]).
(AreExprs ex1 ex2 n m, KnownValue res) =>
ex1
-> ex2
-> ((n & (m & inp)) :-> (res & inp))
-> IndigoState inp (res & inp) ()
binaryOp ex1
e1 ex2
e2 (n & (m & inp)) :-> (a & inp)
forall n m (s :: [*]).
ArithOpHs Add n m =>
(n & (m & s)) :-> (ArithResHs Add n m & s)
L.add
compileExpr (Sub e1 :: ex1
e1 e2 :: ex2
e2)  = ex1
-> ex2
-> ((n & (m & inp)) :-> (a & inp))
-> IndigoState inp (a & inp) ()
forall n m ex1 ex2 res (inp :: [*]).
(AreExprs ex1 ex2 n m, KnownValue res) =>
ex1
-> ex2
-> ((n & (m & inp)) :-> (res & inp))
-> IndigoState inp (res & inp) ()
binaryOp ex1
e1 ex2
e2 (n & (m & inp)) :-> (a & inp)
forall n m (s :: [*]).
ArithOpHs Sub n m =>
(n & (m & s)) :-> (ArithResHs Sub n m & s)
L.sub
compileExpr (Mul e1 :: ex1
e1 e2 :: ex2
e2) = ex1
-> ex2
-> ((n & (m & inp)) :-> (a & inp))
-> IndigoState inp (a & inp) ()
forall n m ex1 ex2 res (inp :: [*]).
(AreExprs ex1 ex2 n m, KnownValue res) =>
ex1
-> ex2
-> ((n & (m & inp)) :-> (res & inp))
-> IndigoState inp (res & inp) ()
binaryOp ex1
e1 ex2
e2 (n & (m & inp)) :-> (a & inp)
forall n m (s :: [*]).
ArithOpHs Mul n m =>
(n & (m & s)) :-> (ArithResHs Mul n m & s)
L.mul
compileExpr (Div e1 :: ex1
e1 e2 :: ex2
e2) = ex1
-> ex2
-> ((n & (m & inp)) :-> (a & inp))
-> IndigoState inp (a & inp) ()
forall n m ex1 ex2 res (inp :: [*]).
(AreExprs ex1 ex2 n m, KnownValue res) =>
ex1
-> ex2
-> ((n & (m & inp)) :-> (res & inp))
-> IndigoState inp (res & inp) ()
binaryOp ex1
e1 ex2
e2 ((n & (m & inp)) :-> (Maybe (a, EModOpResHs n m) : inp)
forall n m (s :: [*]).
EDivOpHs n m =>
(n & (m & s)) :-> (Maybe (EDivOpResHs n m, EModOpResHs n m) & s)
L.ediv ((n & (m & inp)) :-> (Maybe (a, EModOpResHs n m) : inp))
-> ((Maybe (a, EModOpResHs n m) : inp) :-> (a & inp))
-> (n & (m & inp)) :-> (a & inp)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# (((a, EModOpResHs n m) & inp) :-> (a & inp))
-> (inp :-> (a & inp))
-> (Maybe (a, EModOpResHs n m) : inp) :-> (a & inp)
forall a (s :: [*]) (s' :: [*]).
((a & s) :-> s') -> (s :-> s') -> (Maybe a & s) :-> s'
L.ifSome ((a, EModOpResHs n m) & inp) :-> (a & inp)
forall a b (s :: [*]). ((a, b) & s) :-> (a & s)
L.car (MText -> inp :-> (a & inp)
forall e (s :: [*]) (t :: [*]). IsError e => e -> s :-> t
failUsing [mt|devision by zero|]))
compileExpr (Mod e1 :: ex1
e1 e2 :: ex2
e2) = ex1
-> ex2
-> ((n & (m & inp)) :-> (a & inp))
-> IndigoState inp (a & inp) ()
forall n m ex1 ex2 res (inp :: [*]).
(AreExprs ex1 ex2 n m, KnownValue res) =>
ex1
-> ex2
-> ((n & (m & inp)) :-> (res & inp))
-> IndigoState inp (res & inp) ()
binaryOp ex1
e1 ex2
e2 ((n & (m & inp)) :-> (Maybe (EDivOpResHs n m, a) : inp)
forall n m (s :: [*]).
EDivOpHs n m =>
(n & (m & s)) :-> (Maybe (EDivOpResHs n m, EModOpResHs n m) & s)
L.ediv ((n & (m & inp)) :-> (Maybe (EDivOpResHs n m, a) : inp))
-> ((Maybe (EDivOpResHs n m, a) : inp) :-> (a & inp))
-> (n & (m & inp)) :-> (a & inp)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# (((EDivOpResHs n m, a) & inp) :-> (a & inp))
-> (inp :-> (a & inp))
-> (Maybe (EDivOpResHs n m, a) : inp) :-> (a & inp)
forall a (s :: [*]) (s' :: [*]).
((a & s) :-> s') -> (s :-> s') -> (Maybe a & s) :-> s'
L.ifSome ((EDivOpResHs n m, a) & inp) :-> (a & inp)
forall a b (s :: [*]). ((a, b) & s) :-> (b & s)
L.cdr (MText -> inp :-> (a & inp)
forall e (s :: [*]) (t :: [*]). IsError e => e -> s :-> t
failUsing [mt|devision by zero|]))
compileExpr (Abs e :: ex
e) = ex -> ((n & inp) :-> (a & inp)) -> IndigoState inp (a & inp) ()
forall n ex res (inp :: [*]).
(IsExpr ex n, KnownValue res) =>
ex -> ((n & inp) :-> (res & inp)) -> IndigoState inp (res & inp) ()
unaryOp ex
e (n & inp) :-> (a & inp)
forall n (s :: [*]).
UnaryArithOpHs Abs n =>
(n & s) :-> (UnaryArithResHs Abs n & s)
L.abs
compileExpr (Neg e :: ex
e) = ex -> ((n & inp) :-> (a & inp)) -> IndigoState inp (a & inp) ()
forall n ex res (inp :: [*]).
(IsExpr ex n, KnownValue res) =>
ex -> ((n & inp) :-> (res & inp)) -> IndigoState inp (res & inp) ()
unaryOp ex
e (n & inp) :-> (a & inp)
forall n (s :: [*]).
UnaryArithOpHs Neg n =>
(n & s) :-> (UnaryArithResHs Neg n & s)
L.neg

compileExpr (Lsl e1 :: ex1
e1 e2 :: ex2
e2) = ex1
-> ex2
-> ((n & (m & inp)) :-> (a & inp))
-> IndigoState inp (a & inp) ()
forall n m ex1 ex2 res (inp :: [*]).
(AreExprs ex1 ex2 n m, KnownValue res) =>
ex1
-> ex2
-> ((n & (m & inp)) :-> (res & inp))
-> IndigoState inp (res & inp) ()
binaryOp ex1
e1 ex2
e2 (n & (m & inp)) :-> (a & inp)
forall n m (s :: [*]).
ArithOpHs Lsl n m =>
(n & (m & s)) :-> (ArithResHs Lsl n m & s)
L.lsl
compileExpr (Lsr e1 :: ex1
e1 e2 :: ex2
e2) = ex1
-> ex2
-> ((n & (m & inp)) :-> (a & inp))
-> IndigoState inp (a & inp) ()
forall n m ex1 ex2 res (inp :: [*]).
(AreExprs ex1 ex2 n m, KnownValue res) =>
ex1
-> ex2
-> ((n & (m & inp)) :-> (res & inp))
-> IndigoState inp (res & inp) ()
binaryOp ex1
e1 ex2
e2 (n & (m & inp)) :-> (a & inp)
forall n m (s :: [*]).
ArithOpHs Lsr n m =>
(n & (m & s)) :-> (ArithResHs Lsr n m & s)
L.lsr

compileExpr (Eq' e1 :: ex1
e1 e2 :: ex2
e2) = ex1
-> ex2
-> ((n & (n & inp)) :-> (Bool & inp))
-> IndigoState inp (Bool & inp) ()
forall n m ex1 ex2 res (inp :: [*]).
(AreExprs ex1 ex2 n m, KnownValue res) =>
ex1
-> ex2
-> ((n & (m & inp)) :-> (res & inp))
-> IndigoState inp (res & inp) ()
binaryOp ex1
e1 ex2
e2 (n & (n & inp)) :-> (Bool & inp)
forall n (s :: [*]).
NiceComparable n =>
(n & (n & s)) :-> (Bool & s)
L.eq
compileExpr (Neq e1 :: ex1
e1 e2 :: ex2
e2) = ex1
-> ex2
-> ((n & (n & inp)) :-> (Bool & inp))
-> IndigoState inp (Bool & inp) ()
forall n m ex1 ex2 res (inp :: [*]).
(AreExprs ex1 ex2 n m, KnownValue res) =>
ex1
-> ex2
-> ((n & (m & inp)) :-> (res & inp))
-> IndigoState inp (res & inp) ()
binaryOp ex1
e1 ex2
e2 (n & (n & inp)) :-> (Bool & inp)
forall n (s :: [*]).
NiceComparable n =>
(n & (n & s)) :-> (Bool & s)
L.neq
compileExpr (Lt e1 :: ex1
e1 e2 :: ex2
e2) = ex1
-> ex2
-> ((n & (n & inp)) :-> (Bool & inp))
-> IndigoState inp (Bool & inp) ()
forall n m ex1 ex2 res (inp :: [*]).
(AreExprs ex1 ex2 n m, KnownValue res) =>
ex1
-> ex2
-> ((n & (m & inp)) :-> (res & inp))
-> IndigoState inp (res & inp) ()
binaryOp ex1
e1 ex2
e2 (n & (n & inp)) :-> (Bool & inp)
forall n (s :: [*]).
NiceComparable n =>
(n & (n & s)) :-> (Bool & s)
L.lt
compileExpr (Le e1 :: ex1
e1 e2 :: ex2
e2) = ex1
-> ex2
-> ((n & (n & inp)) :-> (Bool & inp))
-> IndigoState inp (Bool & inp) ()
forall n m ex1 ex2 res (inp :: [*]).
(AreExprs ex1 ex2 n m, KnownValue res) =>
ex1
-> ex2
-> ((n & (m & inp)) :-> (res & inp))
-> IndigoState inp (res & inp) ()
binaryOp ex1
e1 ex2
e2 (n & (n & inp)) :-> (Bool & inp)
forall n (s :: [*]).
NiceComparable n =>
(n & (n & s)) :-> (Bool & s)
L.le
compileExpr (Gt e1 :: ex1
e1 e2 :: ex2
e2) = ex1
-> ex2
-> ((n & (n & inp)) :-> (Bool & inp))
-> IndigoState inp (Bool & inp) ()
forall n m ex1 ex2 res (inp :: [*]).
(AreExprs ex1 ex2 n m, KnownValue res) =>
ex1
-> ex2
-> ((n & (m & inp)) :-> (res & inp))
-> IndigoState inp (res & inp) ()
binaryOp ex1
e1 ex2
e2 (n & (n & inp)) :-> (Bool & inp)
forall n (s :: [*]).
NiceComparable n =>
(n & (n & s)) :-> (Bool & s)
L.gt
compileExpr (Ge e1 :: ex1
e1 e2 :: ex2
e2) = ex1
-> ex2
-> ((n & (n & inp)) :-> (Bool & inp))
-> IndigoState inp (Bool & inp) ()
forall n m ex1 ex2 res (inp :: [*]).
(AreExprs ex1 ex2 n m, KnownValue res) =>
ex1
-> ex2
-> ((n & (m & inp)) :-> (res & inp))
-> IndigoState inp (res & inp) ()
binaryOp ex1
e1 ex2
e2 (n & (n & inp)) :-> (Bool & inp)
forall n (s :: [*]).
NiceComparable n =>
(n & (n & s)) :-> (Bool & s)
L.ge
compileExpr (IsNat e :: ex
e) = ex
-> ((Integer & inp) :-> (Maybe Natural & inp))
-> IndigoState inp (Maybe Natural & inp) ()
forall n ex res (inp :: [*]).
(IsExpr ex n, KnownValue res) =>
ex -> ((n & inp) :-> (res & inp)) -> IndigoState inp (res & inp) ()
unaryOp ex
e (Integer & inp) :-> (Maybe Natural & inp)
forall (s :: [*]). (Integer & s) :-> (Maybe Natural & s)
L.isNat
compileExpr (Int' e :: ex
e) = ex
-> ((Natural & inp) :-> (Integer & inp))
-> IndigoState inp (Integer & inp) ()
forall n ex res (inp :: [*]).
(IsExpr ex n, KnownValue res) =>
ex -> ((n & inp) :-> (res & inp)) -> IndigoState inp (res & inp) ()
unaryOp ex
e (Natural & inp) :-> (Integer & inp)
forall (s :: [*]). (Natural & s) :-> (Integer & s)
L.int
compileExpr (And e1 :: ex1
e1 e2 :: ex2
e2) = ex1
-> ex2
-> ((n & (m & inp)) :-> (a & inp))
-> IndigoState inp (a & inp) ()
forall n m ex1 ex2 res (inp :: [*]).
(AreExprs ex1 ex2 n m, KnownValue res) =>
ex1
-> ex2
-> ((n & (m & inp)) :-> (res & inp))
-> IndigoState inp (res & inp) ()
binaryOp ex1
e1 ex2
e2 (n & (m & inp)) :-> (a & inp)
forall n m (s :: [*]).
ArithOpHs And n m =>
(n & (m & s)) :-> (ArithResHs And n m & s)
L.and
compileExpr (Or e1 :: ex1
e1 e2 :: ex2
e2) = ex1
-> ex2
-> ((n & (m & inp)) :-> (a & inp))
-> IndigoState inp (a & inp) ()
forall n m ex1 ex2 res (inp :: [*]).
(AreExprs ex1 ex2 n m, KnownValue res) =>
ex1
-> ex2
-> ((n & (m & inp)) :-> (res & inp))
-> IndigoState inp (res & inp) ()
binaryOp ex1
e1 ex2
e2 (n & (m & inp)) :-> (a & inp)
forall n m (s :: [*]).
ArithOpHs Or n m =>
(n & (m & s)) :-> (ArithResHs Or n m & s)
L.or
compileExpr (Xor e1 :: ex1
e1 e2 :: ex2
e2) = ex1
-> ex2
-> ((n & (m & inp)) :-> (a & inp))
-> IndigoState inp (a & inp) ()
forall n m ex1 ex2 res (inp :: [*]).
(AreExprs ex1 ex2 n m, KnownValue res) =>
ex1
-> ex2
-> ((n & (m & inp)) :-> (res & inp))
-> IndigoState inp (res & inp) ()
binaryOp ex1
e1 ex2
e2 (n & (m & inp)) :-> (a & inp)
forall n m (s :: [*]).
ArithOpHs Xor n m =>
(n & (m & s)) :-> (ArithResHs Xor n m & s)
L.xor
compileExpr (Not e :: op
e) = op -> ((n & inp) :-> (a & inp)) -> IndigoState inp (a & inp) ()
forall n ex res (inp :: [*]).
(IsExpr ex n, KnownValue res) =>
ex -> ((n & inp) :-> (res & inp)) -> IndigoState inp (res & inp) ()
unaryOp op
e (n & inp) :-> (a & inp)
forall n (s :: [*]).
UnaryArithOpHs Not n =>
(n & s) :-> (UnaryArithResHs Not n & s)
L.not

compileExpr (Fst e :: op
e) = op
-> (((a, m) & inp) :-> (a & inp)) -> IndigoState inp (a & inp) ()
forall n ex res (inp :: [*]).
(IsExpr ex n, KnownValue res) =>
ex -> ((n & inp) :-> (res & inp)) -> IndigoState inp (res & inp) ()
unaryOp op
e ((a, m) & inp) :-> (a & inp)
forall a b (s :: [*]). ((a, b) & s) :-> (a & s)
L.car
compileExpr (Snd e :: op
e) = op
-> (((n, a) & inp) :-> (a & inp)) -> IndigoState inp (a & inp) ()
forall n ex res (inp :: [*]).
(IsExpr ex n, KnownValue res) =>
ex -> ((n & inp) :-> (res & inp)) -> IndigoState inp (res & inp) ()
unaryOp op
e ((n, a) & inp) :-> (a & inp)
forall a b (s :: [*]). ((a, b) & s) :-> (b & s)
L.cdr
compileExpr (Pair e1 :: ex1
e1 e2 :: ex2
e2) = ex1
-> ex2
-> ((n & (m & inp)) :-> ((n, m) & inp))
-> IndigoState inp ((n, m) & inp) ()
forall n m ex1 ex2 res (inp :: [*]).
(AreExprs ex1 ex2 n m, KnownValue res) =>
ex1
-> ex2
-> ((n & (m & inp)) :-> (res & inp))
-> IndigoState inp (res & inp) ()
binaryOp ex1
e1 ex2
e2 (n & (m & inp)) :-> ((n, m) & inp)
forall a b (s :: [*]). (a & (b & s)) :-> ((a, b) & s)
L.pair

compileExpr (Some e :: ex
e) = ex
-> ((t & inp) :-> (Maybe t & inp))
-> IndigoState inp (Maybe t & inp) ()
forall n ex res (inp :: [*]).
(IsExpr ex n, KnownValue res) =>
ex -> ((n & inp) :-> (res & inp)) -> IndigoState inp (res & inp) ()
unaryOp ex
e (t & inp) :-> (Maybe t & inp)
forall a (s :: [*]). (a & s) :-> (Maybe a & s)
L.some
compileExpr None = (inp :-> (Maybe t : inp)) -> IndigoState inp (Maybe t : inp) ()
forall res (inp :: [*]).
KnownValue res =>
(inp :-> (res : inp)) -> IndigoState inp (res : inp) ()
nullaryOp inp :-> (Maybe t : inp)
forall a (s :: [*]). KnownValue a => s :-> (Maybe a & s)
L.none
compileExpr (Right' e :: ex
e) = ex
-> ((x & inp) :-> (Either y x & inp))
-> IndigoState inp (Either y x & inp) ()
forall n ex res (inp :: [*]).
(IsExpr ex n, KnownValue res) =>
ex -> ((n & inp) :-> (res & inp)) -> IndigoState inp (res & inp) ()
unaryOp ex
e (x & inp) :-> (Either y x & inp)
forall a b (s :: [*]). KnownValue a => (b & s) :-> (Either a b & s)
L.right
compileExpr (Left' e :: ex
e) = ex
-> ((y & inp) :-> (Either y x & inp))
-> IndigoState inp (Either y x & inp) ()
forall n ex res (inp :: [*]).
(IsExpr ex n, KnownValue res) =>
ex -> ((n & inp) :-> (res & inp)) -> IndigoState inp (res & inp) ()
unaryOp ex
e (y & inp) :-> (Either y x & inp)
forall a b (s :: [*]). KnownValue b => (a & s) :-> (Either a b & s)
L.left
compileExpr (Pack e :: ex
e) = ex
-> ((a & inp) :-> (ByteString & inp))
-> IndigoState inp (ByteString & inp) ()
forall n ex res (inp :: [*]).
(IsExpr ex n, KnownValue res) =>
ex -> ((n & inp) :-> (res & inp)) -> IndigoState inp (res & inp) ()
unaryOp ex
e (a & inp) :-> (ByteString & inp)
forall a (s :: [*]).
NicePackedValue a =>
(a & s) :-> (ByteString & s)
L.pack
compileExpr (Unpack e :: bsExpr
e) = bsExpr
-> ((ByteString & inp) :-> (Maybe a & inp))
-> IndigoState inp (Maybe a & inp) ()
forall n ex res (inp :: [*]).
(IsExpr ex n, KnownValue res) =>
ex -> ((n & inp) :-> (res & inp)) -> IndigoState inp (res & inp) ()
unaryOp bsExpr
e (ByteString & inp) :-> (Maybe a & inp)
forall a (s :: [*]).
NiceUnpackedValue a =>
(ByteString & s) :-> (Maybe a & s)
L.unpack
compileExpr Nil = (inp :-> (List a : inp)) -> IndigoState inp (List a : inp) ()
forall res (inp :: [*]).
KnownValue res =>
(inp :-> (res : inp)) -> IndigoState inp (res : inp) ()
nullaryOp inp :-> (List a : inp)
forall p (s :: [*]). KnownValue p => s :-> (List p & s)
L.nil
compileExpr (Cons e1 :: ex1
e1 e2 :: ex2
e2) = ex1
-> ex2
-> ((a & (List a & inp)) :-> (List a & inp))
-> IndigoState inp (List a & inp) ()
forall n m ex1 ex2 res (inp :: [*]).
(AreExprs ex1 ex2 n m, KnownValue res) =>
ex1
-> ex2
-> ((n & (m & inp)) :-> (res & inp))
-> IndigoState inp (res & inp) ()
binaryOp ex1
e1 ex2
e2 (a & (List a & inp)) :-> (List a & inp)
forall a (s :: [*]). (a & (List a & s)) :-> (List a & s)
L.cons
compileExpr (Contract e :: exAddr
e) = exAddr
-> ((addr & inp) :-> (Maybe (ContractRef p) & inp))
-> IndigoState inp (Maybe (ContractRef p) & inp) ()
forall n ex res (inp :: [*]).
(IsExpr ex n, KnownValue res) =>
ex -> ((n & inp) :-> (res & inp)) -> IndigoState inp (res & inp) ()
unaryOp exAddr
e (addr & inp) :-> (Maybe (ContractRef p) & inp)
forall p addr (s :: [*]).
(NiceParameterFull p, ForbidExplicitDefaultEntryPoint p,
 ToTAddress_ p addr) =>
(addr & s) :-> (Maybe (ContractRef p) & s)
L.contract
compileExpr Self = (inp :-> (ContractRef p : inp))
-> IndigoState inp (ContractRef p : inp) ()
forall res (inp :: [*]).
KnownValue res =>
(inp :-> (res : inp)) -> IndigoState inp (res : inp) ()
nullaryOp inp :-> (ContractRef p : inp)
forall p (s :: [*]).
(NiceParameterFull p, ForbidExplicitDefaultEntryPoint p) =>
s :-> (ContractRef p & s)
L.self
compileExpr (ContractAddress ec :: exc
ec) = exc
-> ((ContractRef p & inp) :-> (Address & inp))
-> IndigoState inp (Address & inp) ()
forall n ex res (inp :: [*]).
(IsExpr ex n, KnownValue res) =>
ex -> ((n & inp) :-> (res & inp)) -> IndigoState inp (res & inp) ()
unaryOp exc
ec (ContractRef p & inp) :-> (Address & inp)
forall a (s :: [*]). (ContractRef a & s) :-> (Address & s)
L.address
compileExpr (ContractCallingUnsafe epName :: EpName
epName addr :: exAddr
addr) = exAddr
-> ((Address & inp) :-> (Maybe (ContractRef arg) & inp))
-> IndigoState inp (Maybe (ContractRef arg) & inp) ()
forall n ex res (inp :: [*]).
(IsExpr ex n, KnownValue res) =>
ex -> ((n & inp) :-> (res & inp)) -> IndigoState inp (res & inp) ()
unaryOp exAddr
addr (EpName -> (Address & inp) :-> (Maybe (ContractRef arg) & inp)
forall arg (s :: [*]).
NiceParameter arg =>
EpName -> (Address & s) :-> (Maybe (ContractRef arg) & s)
L.contractCallingUnsafe EpName
epName)
compileExpr (RunFutureContract con :: conExpr
con) = conExpr
-> ((FutureContract p & inp) :-> (Maybe (ContractRef p) & inp))
-> IndigoState inp (Maybe (ContractRef p) & inp) ()
forall n ex res (inp :: [*]).
(IsExpr ex n, KnownValue res) =>
ex -> ((n & inp) :-> (res & inp)) -> IndigoState inp (res & inp) ()
unaryOp conExpr
con (FutureContract p & inp) :-> (Maybe (ContractRef p) & inp)
forall p (s :: [*]).
NiceParameter p =>
(FutureContract p & s) :-> (Maybe (ContractRef p) & s)
L.runFutureContract
compileExpr (ConvertEpAddressToContract epAddr :: epExpr
epAddr) = epExpr
-> ((EpAddress & inp) :-> (Maybe (ContractRef p) & inp))
-> IndigoState inp (Maybe (ContractRef p) & inp) ()
forall n ex res (inp :: [*]).
(IsExpr ex n, KnownValue res) =>
ex -> ((n & inp) :-> (res & inp)) -> IndigoState inp (res & inp) ()
unaryOp epExpr
epAddr (EpAddress & inp) :-> (Maybe (ContractRef p) & inp)
forall p (s :: [*]).
NiceParameter p =>
(EpAddress & s) :-> (Maybe (ContractRef p) & s)
L.epAddressToContract
compileExpr (MakeView e1 :: exa
e1 e2 :: exCRef
e2) = exa
-> exCRef
-> ((a & (ContractRef r & inp)) :-> (View a r & inp))
-> IndigoState inp (View a r & inp) ()
forall n m ex1 ex2 res (inp :: [*]).
(AreExprs ex1 ex2 n m, KnownValue res) =>
ex1
-> ex2
-> ((n & (m & inp)) :-> (res & inp))
-> IndigoState inp (res & inp) ()
binaryOp exa
e1 exCRef
e2 ((a & (ContractRef r & inp)) :-> ((a, ContractRef r) & inp)
forall a b (s :: [*]). (a & (b & s)) :-> ((a, b) & s)
L.pair ((a & (ContractRef r & inp)) :-> ((a, ContractRef r) & inp))
-> (((a, ContractRef r) & inp) :-> (View a r & inp))
-> (a & (ContractRef r & inp)) :-> (View a r & inp)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# ((a, ContractRef r) & inp) :-> (View a r & inp)
forall a r (s :: [*]). ((a, ContractRef r) : s) :-> (View a r : s)
L.wrapView)
compileExpr (MakeVoid e1 :: exa
e1 e2 :: exCRef
e2) = exa
-> exCRef
-> ((a & (Lambda b b & inp)) :-> (Void_ a b & inp))
-> IndigoState inp (Void_ a b & inp) ()
forall n m ex1 ex2 res (inp :: [*]).
(AreExprs ex1 ex2 n m, KnownValue res) =>
ex1
-> ex2
-> ((n & (m & inp)) :-> (res & inp))
-> IndigoState inp (res & inp) ()
binaryOp exa
e1 exCRef
e2 ((a & (Lambda b b & inp)) :-> ((a, Lambda b b) & inp)
forall a b (s :: [*]). (a & (b & s)) :-> ((a, b) & s)
L.pair ((a & (Lambda b b & inp)) :-> ((a, Lambda b b) & inp))
-> (((a, Lambda b b) & inp) :-> (Void_ a b & inp))
-> (a & (Lambda b b & inp)) :-> (Void_ a b & inp)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# ((a, Lambda b b) & inp) :-> (Void_ a b & inp)
forall a b (s :: [*]). ((a, Lambda b b) : s) :-> (Void_ a b : s)
L.wrapVoid)

compileExpr (Mem k :: exck
k c :: exc
c) = exck
-> exc
-> ((MemOpKeyHs c & (c & inp)) :-> (Bool & inp))
-> IndigoState inp (Bool & inp) ()
forall n m ex1 ex2 res (inp :: [*]).
(AreExprs ex1 ex2 n m, KnownValue res) =>
ex1
-> ex2
-> ((n & (m & inp)) :-> (res & inp))
-> IndigoState inp (res & inp) ()
binaryOp exck
k exc
c (MemOpKeyHs c & (c & inp)) :-> (Bool & inp)
forall c (s :: [*]).
MemOpHs c =>
(MemOpKeyHs c & (c & s)) :-> (Bool & s)
L.mem
compileExpr (Size s :: exc
s) = exc
-> ((c & inp) :-> (Natural & inp))
-> IndigoState inp (Natural & inp) ()
forall n ex res (inp :: [*]).
(IsExpr ex n, KnownValue res) =>
ex -> ((n & inp) :-> (res & inp)) -> IndigoState inp (res & inp) ()
unaryOp exc
s (c & inp) :-> (Natural & inp)
forall c (s :: [*]). SizeOpHs c => (c & s) :-> (Natural & s)
L.size

compileExpr (UInsertNew l :: Label name
l err :: err
err k :: exKey
k v :: exVal
v store :: exStore
store) =
  exKey
-> exVal
-> exStore
-> ((key & (value & (UStore store & inp)))
    :-> (UStore store & inp))
-> IndigoState inp (UStore store & inp) ()
forall n m l ex1 ex2 ex3 res (inp :: [*]).
(AreExprs ex1 ex2 n m, IsExpr ex3 l, KnownValue res) =>
ex1
-> ex2
-> ex3
-> ((n & (m & (l & inp))) :-> (res & inp))
-> IndigoState inp (res & inp) ()
ternaryOp exKey
k exVal
v exStore
store (((key & (value & (UStore store & inp))) :-> (UStore store & inp))
 -> IndigoState inp (a & inp) ())
-> ((key & (value & (UStore store & inp)))
    :-> (UStore store & inp))
-> IndigoState inp (a & inp) ()
forall a b. (a -> b) -> a -> b
$ Label name
-> (forall (s0 :: [*]) (any :: [*]).
    (GetUStoreKey store name : s0) :-> any)
-> (GetUStoreKey store name
      : GetUStoreValue store name : (UStore store & inp))
   :-> (UStore store & inp)
forall store (name :: Symbol) (s :: [*]).
(KeyAccessC store name, ValueAccessC store name) =>
Label name
-> (forall (s0 :: [*]) (any :: [*]).
    (GetUStoreKey store name : s0) :-> any)
-> (GetUStoreKey store name
      : GetUStoreValue store name : UStore store : s)
   :-> (UStore store : s)
ustoreInsertNew Label name
l (err -> (key : s0) :-> any
forall e (s :: [*]) (t :: [*]). IsError e => e -> s :-> t
failUsing err
err)
compileExpr (UInsert l :: Label name
l k :: exKey
k v :: exVal
v store :: exStore
store) =
  exKey
-> exVal
-> exStore
-> ((key & (value & (UStore store & inp)))
    :-> (UStore store & inp))
-> IndigoState inp (UStore store & inp) ()
forall n m l ex1 ex2 ex3 res (inp :: [*]).
(AreExprs ex1 ex2 n m, IsExpr ex3 l, KnownValue res) =>
ex1
-> ex2
-> ex3
-> ((n & (m & (l & inp))) :-> (res & inp))
-> IndigoState inp (res & inp) ()
ternaryOp exKey
k exVal
v exStore
store (((key & (value & (UStore store & inp))) :-> (UStore store & inp))
 -> IndigoState inp (a & inp) ())
-> ((key & (value & (UStore store & inp)))
    :-> (UStore store & inp))
-> IndigoState inp (a & inp) ()
forall a b. (a -> b) -> a -> b
$ Label name
-> (GetUStoreKey store name
      : GetUStoreValue store name : (UStore store & inp))
   :-> (UStore store & inp)
forall store (name :: Symbol) (s :: [*]).
(KeyAccessC store name, ValueAccessC store name) =>
Label name
-> (GetUStoreKey store name
      : GetUStoreValue store name : UStore store : s)
   :-> (UStore store : s)
ustoreInsert Label name
l
compileExpr (UGet l :: Label name
l ekey :: exKey
ekey estore :: exStore
estore) = exKey
-> exStore
-> ((key & (UStore store & inp)) :-> (a & inp))
-> IndigoState inp (a & inp) ()
forall n m ex1 ex2 res (inp :: [*]).
(AreExprs ex1 ex2 n m, KnownValue res) =>
ex1
-> ex2
-> ((n & (m & inp)) :-> (res & inp))
-> IndigoState inp (res & inp) ()
binaryOp exKey
ekey exStore
estore (Label name
-> (GetUStoreKey store name : (UStore store & inp))
   :-> (Maybe (GetUStoreValue store name) : inp)
forall store (name :: Symbol) (s :: [*]).
(KeyAccessC store name, ValueAccessC store name) =>
Label name
-> (GetUStoreKey store name : UStore store : s)
   :-> (Maybe (GetUStoreValue store name) : s)
ustoreGet Label name
l)
compileExpr (UMem l :: Label name
l ekey :: exKey
ekey estore :: exStore
estore) = exKey
-> exStore
-> ((key & (UStore store & inp)) :-> (Bool & inp))
-> IndigoState inp (Bool & inp) ()
forall n m ex1 ex2 res (inp :: [*]).
(AreExprs ex1 ex2 n m, KnownValue res) =>
ex1
-> ex2
-> ((n & (m & inp)) :-> (res & inp))
-> IndigoState inp (res & inp) ()
binaryOp exKey
ekey exStore
estore (Label name
-> (GetUStoreKey store name : (UStore store & inp))
   :-> (Bool & inp)
forall store (name :: Symbol) (s :: [*]).
KeyAccessC store name =>
Label name
-> (GetUStoreKey store name : UStore store : s) :-> (Bool : s)
ustoreMem Label name
l)
compileExpr (UUpdate l :: Label name
l ekey :: exKey
ekey evalue :: exVal
evalue estore :: exStore
estore) = exKey
-> exVal
-> exStore
-> ((key
     & (Maybe
          (MSValue
             (MERequireFound name store (GLookupStore name (Rep store))))
        & (UStore store & inp)))
    :-> (UStore store & inp))
-> IndigoState inp (UStore store & inp) ()
forall n m l ex1 ex2 ex3 res (inp :: [*]).
(AreExprs ex1 ex2 n m, IsExpr ex3 l, KnownValue res) =>
ex1
-> ex2
-> ex3
-> ((n & (m & (l & inp))) :-> (res & inp))
-> IndigoState inp (res & inp) ()
ternaryOp exKey
ekey exVal
evalue exStore
estore (Label name
-> (GetUStoreKey store name
      : (Maybe
           (MSValue
              (MERequireFound name store (GLookupStore name (Rep store))))
         & (UStore store & inp)))
   :-> (UStore store & inp)
forall store (name :: Symbol) (s :: [*]).
(KeyAccessC store name, ValueAccessC store name) =>
Label name
-> (GetUStoreKey store name
      : Maybe (GetUStoreValue store name) : UStore store : s)
   :-> (UStore store : s)
ustoreUpdate Label name
l)
compileExpr (UDelete l :: Label name
l ekey :: exKey
ekey estore :: exStore
estore) = exKey
-> exStore
-> ((key & (UStore store & inp)) :-> (UStore store & inp))
-> IndigoState inp (UStore store & inp) ()
forall n m ex1 ex2 res (inp :: [*]).
(AreExprs ex1 ex2 n m, KnownValue res) =>
ex1
-> ex2
-> ((n & (m & inp)) :-> (res & inp))
-> IndigoState inp (res & inp) ()
binaryOp exKey
ekey exStore
estore (Label name
-> (GetUStoreKey store name : (UStore store & inp))
   :-> (UStore store & inp)
forall store (name :: Symbol) (s :: [*]).
KeyAccessC store name =>
Label name
-> (GetUStoreKey store name : UStore store : s)
   :-> (UStore store : s)
ustoreDelete Label name
l)

compileExpr (ObjMan fldAcc :: ObjectManipulation a
fldAcc) = ObjectManipulation a -> IndigoState inp (a & inp) ()
forall a (inp :: [*]).
ObjectManipulation a -> IndigoState inp (a & inp) ()
compileObjectManipulation ObjectManipulation a
fldAcc
compileExpr (Construct fields :: Rec Expr (ConstructorFieldTypes a)
fields) = (MetaData inp -> GenCode inp (a & inp) ())
-> IndigoState inp (a & inp) ()
forall (inp :: [*]) (out :: [*]) a.
(MetaData inp -> GenCode inp out a) -> IndigoState inp out a
IndigoState ((MetaData inp -> GenCode inp (a & inp) ())
 -> IndigoState inp (a & inp) ())
-> (MetaData inp -> GenCode inp (a & inp) ())
-> IndigoState inp (a & inp) ()
forall a b. (a -> b) -> a -> b
$ \md :: MetaData inp
md ->
  let cd :: inp :-> (a & inp)
cd = Rec (FieldConstructor inp) (ConstructorFieldTypes a)
-> inp :-> (a & inp)
forall dt (st :: [*]).
(InstrConstructC dt, RMap (ConstructorFieldTypes dt)) =>
Rec (FieldConstructor st) (ConstructorFieldTypes dt)
-> st :-> (dt & st)
L.construct (Rec (FieldConstructor inp) (ConstructorFieldTypes a)
 -> inp :-> (a & inp))
-> Rec (FieldConstructor inp) (ConstructorFieldTypes a)
-> inp :-> (a & inp)
forall a b. (a -> b) -> a -> b
$ (forall x. Expr x -> FieldConstructor inp x)
-> Rec Expr (ConstructorFieldTypes a)
-> Rec (FieldConstructor inp) (ConstructorFieldTypes a)
forall u (rs :: [u]) (f :: u -> *) (g :: u -> *).
RMap rs =>
(forall (x :: u). f x -> g x) -> Rec f rs -> Rec g rs
rmap (\e :: Expr x
e -> (inp :-> (x & inp)) -> FieldConstructor inp x
forall (st :: [*]) f.
HasCallStack =>
(st :-> (f & st)) -> FieldConstructor st f
fieldCtor ((inp :-> (x & inp)) -> FieldConstructor inp x)
-> (inp :-> (x & inp)) -> FieldConstructor inp x
forall a b. (a -> b) -> a -> b
$ GenCode inp (x & inp) () -> inp :-> (x & inp)
forall (inp :: [*]) (out :: [*]) a.
GenCode inp out a -> inp :-> out
gcCode (GenCode inp (x & inp) () -> inp :-> (x & inp))
-> GenCode inp (x & inp) () -> inp :-> (x & inp)
forall a b. (a -> b) -> a -> b
$ IndigoState inp (x & inp) ()
-> MetaData inp -> GenCode inp (x & inp) ()
forall (inp :: [*]) (out :: [*]) a.
IndigoState inp out a -> MetaData inp -> GenCode inp out a
runIndigoState (Expr x -> IndigoState inp (x & inp) ()
forall a (inp :: [*]). Expr a -> IndigoState inp (a & inp) ()
compileExpr Expr x
e) MetaData inp
md) Rec Expr (ConstructorFieldTypes a)
fields in
  ()
-> MetaData (a & inp)
-> (inp :-> (a & inp))
-> ((a & inp) :-> inp)
-> GenCode inp (a & inp) ()
forall (inp :: [*]) (out :: [*]) a.
a
-> MetaData out
-> (inp :-> out)
-> (out :-> inp)
-> GenCode inp out a
GenCode () (MetaData inp -> MetaData (a & inp)
forall a (inp :: [*]).
KnownValue a =>
MetaData inp -> MetaData (a & inp)
pushNoRefMd MetaData inp
md) inp :-> (a & inp)
cd (a & inp) :-> inp
forall a (s :: [*]). (a & s) :-> s
L.drop
compileExpr (ConstructWithoutNamed fields :: Rec Expr (FieldTypes a)
fields) = (MetaData inp -> GenCode inp (a & inp) ())
-> IndigoState inp (a & inp) ()
forall (inp :: [*]) (out :: [*]) a.
(MetaData inp -> GenCode inp out a) -> IndigoState inp out a
IndigoState ((MetaData inp -> GenCode inp (a & inp) ())
 -> IndigoState inp (a & inp) ())
-> (MetaData inp -> GenCode inp (a & inp) ())
-> IndigoState inp (a & inp) ()
forall a b. (a -> b) -> a -> b
$ \md :: MetaData inp
md ->
  let fieldCtrs :: Rec (FieldConstructor inp) (ConstructorFieldTypes a)
fieldCtrs =
          forall (st :: [*]).
CastFieldConstructors (FieldTypes a) (ConstructorFieldTypes a) =>
Rec (FieldConstructor st) (FieldTypes a)
-> Rec (FieldConstructor st) (ConstructorFieldTypes a)
forall k a (st :: [k]).
CastFieldConstructors (FieldTypes a) (ConstructorFieldTypes a) =>
Rec (FieldConstructor st) (FieldTypes a)
-> Rec (FieldConstructor st) (ConstructorFieldTypes a)
castFieldConstructors @a (Rec (FieldConstructor inp) (FieldTypes a)
 -> Rec (FieldConstructor inp) (ConstructorFieldTypes a))
-> Rec (FieldConstructor inp) (FieldTypes a)
-> Rec (FieldConstructor inp) (ConstructorFieldTypes a)
forall a b. (a -> b) -> a -> b
$
            (forall x. Expr x -> FieldConstructor inp x)
-> Rec Expr (FieldTypes a)
-> Rec (FieldConstructor inp) (FieldTypes a)
forall u (rs :: [u]) (f :: u -> *) (g :: u -> *).
RMap rs =>
(forall (x :: u). f x -> g x) -> Rec f rs -> Rec g rs
rmap ((inp :-> (x & inp)) -> FieldConstructor inp x
forall (st :: [*]) f.
HasCallStack =>
(st :-> (f & st)) -> FieldConstructor st f
fieldCtor ((inp :-> (x & inp)) -> FieldConstructor inp x)
-> (Expr x -> inp :-> (x & inp))
-> Expr x
-> FieldConstructor inp x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenCode inp (x & inp) () -> inp :-> (x & inp)
forall (inp :: [*]) (out :: [*]) a.
GenCode inp out a -> inp :-> out
gcCode (GenCode inp (x & inp) () -> inp :-> (x & inp))
-> (Expr x -> GenCode inp (x & inp) ())
-> Expr x
-> inp :-> (x & inp)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MetaData inp
-> IndigoState inp (x & inp) () -> GenCode inp (x & inp) ()
forall (inp :: [*]) (out :: [*]) a.
MetaData inp -> IndigoState inp out a -> GenCode inp out a
usingIndigoState MetaData inp
md (IndigoState inp (x & inp) () -> GenCode inp (x & inp) ())
-> (Expr x -> IndigoState inp (x & inp) ())
-> Expr x
-> GenCode inp (x & inp) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr x -> IndigoState inp (x & inp) ()
forall a (inp :: [*]). Expr a -> IndigoState inp (a & inp) ()
compileExpr) Rec Expr (FieldTypes a)
fields
  in ()
-> MetaData (a & inp)
-> (inp :-> (a & inp))
-> ((a & inp) :-> inp)
-> GenCode inp (a & inp) ()
forall (inp :: [*]) (out :: [*]) a.
a
-> MetaData out
-> (inp :-> out)
-> (out :-> inp)
-> GenCode inp out a
GenCode () (MetaData inp -> MetaData (a & inp)
forall a (inp :: [*]).
KnownValue a =>
MetaData inp -> MetaData (a & inp)
pushNoRefMd MetaData inp
md) (Rec (FieldConstructor inp) (ConstructorFieldTypes a)
-> inp :-> (a & inp)
forall dt (st :: [*]).
(InstrConstructC dt, RMap (ConstructorFieldTypes dt)) =>
Rec (FieldConstructor st) (ConstructorFieldTypes dt)
-> st :-> (dt & st)
L.construct @a Rec (FieldConstructor inp) (ConstructorFieldTypes a)
fieldCtrs) (a & inp) :-> inp
forall a (s :: [*]). (a & s) :-> s
L.drop
compileExpr (Name _ e :: ex
e) = ex -> ((t & inp) :-> (a & inp)) -> IndigoState inp (a & inp) ()
forall n ex res (inp :: [*]).
(IsExpr ex n, KnownValue res) =>
ex -> ((n & inp) :-> (res & inp)) -> IndigoState inp (res & inp) ()
unaryOp ex
e (t & inp) :-> (a & inp)
forall a b (s :: [*]).
MichelsonCoercible a b =>
(a & s) :-> (b & s)
forcedCoerce_
compileExpr (UnName _ e :: ex
e) = ex
-> (((name :! a) & inp) :-> (a & inp))
-> IndigoState inp (a & inp) ()
forall n ex res (inp :: [*]).
(IsExpr ex n, KnownValue res) =>
ex -> ((n & inp) :-> (res & inp)) -> IndigoState inp (res & inp) ()
unaryOp ex
e ((name :! a) & inp) :-> (a & inp)
forall a b (s :: [*]).
MichelsonCoercible a b =>
(a & s) :-> (b & s)
forcedCoerce_

compileExpr (Slice ex1 :: an
ex1 ex2 :: bn
ex2 ex3 :: ex
ex3) = an
-> bn
-> ex
-> ((Natural & (Natural & (c & inp))) :-> (Maybe c & inp))
-> IndigoState inp (Maybe c & inp) ()
forall n m l ex1 ex2 ex3 res (inp :: [*]).
(AreExprs ex1 ex2 n m, IsExpr ex3 l, KnownValue res) =>
ex1
-> ex2
-> ex3
-> ((n & (m & (l & inp))) :-> (res & inp))
-> IndigoState inp (res & inp) ()
ternaryOp an
ex1 bn
ex2 ex
ex3 (Natural & (Natural & (c & inp))) :-> (Maybe c & inp)
forall c (s :: [*]).
(SliceOpHs c, KnownValue c) =>
(Natural & (Natural & (c & s))) :-> (Maybe c & s)
L.slice
compileExpr (Cast ex :: ex
ex) = ex -> ((a & inp) :-> (a & inp)) -> IndigoState inp (a & inp) ()
forall n ex res (inp :: [*]).
(IsExpr ex n, KnownValue res) =>
ex -> ((n & inp) :-> (res & inp)) -> IndigoState inp (res & inp) ()
unaryOp ex
ex (a & inp) :-> (a & inp)
forall a (s :: [*]). KnownValue a => (a & s) :-> (a & s)
L.cast
compileExpr (Concat ex1 :: ex1
ex1 ex2 :: ex2
ex2) = ex1
-> ex2
-> ((a & (a & inp)) :-> (a & inp))
-> IndigoState inp (a & inp) ()
forall n m ex1 ex2 res (inp :: [*]).
(AreExprs ex1 ex2 n m, KnownValue res) =>
ex1
-> ex2
-> ((n & (m & inp)) :-> (res & inp))
-> IndigoState inp (res & inp) ()
binaryOp ex1
ex1 ex2
ex2 (a & (a & inp)) :-> (a & inp)
forall c (s :: [*]). ConcatOpHs c => (c & (c & s)) :-> (c & s)
L.concat
compileExpr (Concat' ex :: ex
ex) = ex
-> ((List a & inp) :-> (a & inp)) -> IndigoState inp (a & inp) ()
forall n ex res (inp :: [*]).
(IsExpr ex n, KnownValue res) =>
ex -> ((n & inp) :-> (res & inp)) -> IndigoState inp (res & inp) ()
unaryOp ex
ex (List a & inp) :-> (a & inp)
forall c (s :: [*]). ConcatOpHs c => (List c & s) :-> (c & s)
L.concat'

compileExpr (ImplicitAccount kh :: exkh
kh) = exkh
-> ((KeyHash & inp) :-> (ContractRef () & inp))
-> IndigoState inp (ContractRef () & inp) ()
forall n ex res (inp :: [*]).
(IsExpr ex n, KnownValue res) =>
ex -> ((n & inp) :-> (res & inp)) -> IndigoState inp (res & inp) ()
unaryOp exkh
kh (KeyHash & inp) :-> (ContractRef () & inp)
forall (s :: [*]). (KeyHash & s) :-> (ContractRef () & s)
L.implicitAccount
compileExpr Now = (inp :-> (Timestamp : inp)) -> IndigoState inp (Timestamp : inp) ()
forall res (inp :: [*]).
KnownValue res =>
(inp :-> (res : inp)) -> IndigoState inp (res : inp) ()
nullaryOp inp :-> (Timestamp : inp)
forall (s :: [*]). s :-> (Timestamp & s)
L.now
compileExpr Sender = (inp :-> (Address & inp)) -> IndigoState inp (Address & inp) ()
forall res (inp :: [*]).
KnownValue res =>
(inp :-> (res : inp)) -> IndigoState inp (res : inp) ()
nullaryOp inp :-> (Address & inp)
forall (s :: [*]). s :-> (Address & s)
L.sender
compileExpr Amount = (inp :-> (Mutez : inp)) -> IndigoState inp (Mutez : inp) ()
forall res (inp :: [*]).
KnownValue res =>
(inp :-> (res : inp)) -> IndigoState inp (res : inp) ()
nullaryOp inp :-> (Mutez : inp)
forall (s :: [*]). s :-> (Mutez & s)
L.amount
compileExpr (CheckSignature pk :: pkExpr
pk sig :: sigExpr
sig bs :: hashExpr
bs) = pkExpr
-> sigExpr
-> hashExpr
-> ((PublicKey & (Signature & (ByteString & inp)))
    :-> (Bool & inp))
-> IndigoState inp (Bool & inp) ()
forall n m l ex1 ex2 ex3 res (inp :: [*]).
(AreExprs ex1 ex2 n m, IsExpr ex3 l, KnownValue res) =>
ex1
-> ex2
-> ex3
-> ((n & (m & (l & inp))) :-> (res & inp))
-> IndigoState inp (res & inp) ()
ternaryOp pkExpr
pk sigExpr
sig hashExpr
bs (PublicKey & (Signature & (ByteString & inp))) :-> (Bool & inp)
forall (s :: [*]).
(PublicKey & (Signature & (ByteString & s))) :-> (Bool & s)
L.checkSignature
compileExpr (Sha256 c :: hashExpr
c) = hashExpr
-> ((ByteString & inp) :-> (ByteString & inp))
-> IndigoState inp (ByteString & inp) ()
forall n ex res (inp :: [*]).
(IsExpr ex n, KnownValue res) =>
ex -> ((n & inp) :-> (res & inp)) -> IndigoState inp (res & inp) ()
unaryOp hashExpr
c (ByteString & inp) :-> (ByteString & inp)
forall (s :: [*]). (ByteString & s) :-> (ByteString & s)
L.sha256
compileExpr (Sha512 c :: hashExpr
c) = hashExpr
-> ((ByteString & inp) :-> (ByteString & inp))
-> IndigoState inp (ByteString & inp) ()
forall n ex res (inp :: [*]).
(IsExpr ex n, KnownValue res) =>
ex -> ((n & inp) :-> (res & inp)) -> IndigoState inp (res & inp) ()
unaryOp hashExpr
c (ByteString & inp) :-> (ByteString & inp)
forall (s :: [*]). (ByteString & s) :-> (ByteString & s)
L.sha512
compileExpr (Blake2b c :: hashExpr
c) = hashExpr
-> ((ByteString & inp) :-> (ByteString & inp))
-> IndigoState inp (ByteString & inp) ()
forall n ex res (inp :: [*]).
(IsExpr ex n, KnownValue res) =>
ex -> ((n & inp) :-> (res & inp)) -> IndigoState inp (res & inp) ()
unaryOp hashExpr
c (ByteString & inp) :-> (ByteString & inp)
forall (s :: [*]). (ByteString & s) :-> (ByteString & s)
L.blake2B
compileExpr (HashKey hk :: keyExpr
hk) = keyExpr
-> ((PublicKey & inp) :-> (KeyHash & inp))
-> IndigoState inp (KeyHash & inp) ()
forall n ex res (inp :: [*]).
(IsExpr ex n, KnownValue res) =>
ex -> ((n & inp) :-> (res & inp)) -> IndigoState inp (res & inp) ()
unaryOp keyExpr
hk (PublicKey & inp) :-> (KeyHash & inp)
forall (s :: [*]). (PublicKey & s) :-> (KeyHash & s)
L.hashKey
compileExpr ChainId = (inp :-> (ChainId : inp)) -> IndigoState inp (ChainId : inp) ()
forall res (inp :: [*]).
KnownValue res =>
(inp :-> (res : inp)) -> IndigoState inp (res : inp) ()
nullaryOp inp :-> (ChainId : inp)
forall (s :: [*]). s :-> (ChainId & s)
L.chainId
compileExpr Balance = (inp :-> (Mutez : inp)) -> IndigoState inp (Mutez : inp) ()
forall res (inp :: [*]).
KnownValue res =>
(inp :-> (res : inp)) -> IndigoState inp (res : inp) ()
nullaryOp inp :-> (Mutez : inp)
forall (s :: [*]). s :-> (Mutez & s)
L.balance

compileExpr EmptySet = (inp :-> (Set key : inp)) -> IndigoState inp (Set key : inp) ()
forall res (inp :: [*]).
KnownValue res =>
(inp :-> (res : inp)) -> IndigoState inp (res : inp) ()
nullaryOp inp :-> (Set key : inp)
forall e (s :: [*]). NiceComparable e => s :-> (Set e & s)
L.emptySet

compileExpr (Get k :: exKey
k m :: exMap
m) = exKey
-> exMap
-> ((GetOpKeyHs c & (c & inp)) :-> (a & inp))
-> IndigoState inp (a & inp) ()
forall n m ex1 ex2 res (inp :: [*]).
(AreExprs ex1 ex2 n m, KnownValue res) =>
ex1
-> ex2
-> ((n & (m & inp)) :-> (res & inp))
-> IndigoState inp (res & inp) ()
binaryOp exKey
k exMap
m (GetOpKeyHs c & (c & inp)) :-> (a & inp)
forall c (s :: [*]).
(GetOpHs c, KnownValue (GetOpValHs c)) =>
(GetOpKeyHs c & (c & s)) :-> (Maybe (GetOpValHs c) & s)
L.get
compileExpr EmptyMap = (inp :-> (Map key value : inp))
-> IndigoState inp (Map key value : inp) ()
forall res (inp :: [*]).
KnownValue res =>
(inp :-> (res : inp)) -> IndigoState inp (res : inp) ()
nullaryOp inp :-> (Map key value : inp)
forall k v (s :: [*]).
(NiceComparable k, KnownValue v) =>
s :-> (Map k v & s)
L.emptyMap
compileExpr EmptyBigMap = (inp :-> (BigMap key value : inp))
-> IndigoState inp (BigMap key value : inp) ()
forall res (inp :: [*]).
KnownValue res =>
(inp :-> (res : inp)) -> IndigoState inp (res : inp) ()
nullaryOp inp :-> (BigMap key value : inp)
forall k v (s :: [*]).
(NiceComparable k, KnownValue v) =>
s :-> (BigMap k v & s)
L.emptyBigMap

compileExpr (Exec inp :: exA
inp lambda :: exLambda
lambda) = exA
-> exLambda
-> ((a & (Lambda a a & inp)) :-> (a & inp))
-> IndigoState inp (a & inp) ()
forall n m ex1 ex2 res (inp :: [*]).
(AreExprs ex1 ex2 n m, KnownValue res) =>
ex1
-> ex2
-> ((n & (m & inp)) :-> (res & inp))
-> IndigoState inp (res & inp) ()
binaryOp exA
inp exLambda
lambda (a & (Lambda a a & inp)) :-> (a & inp)
forall a b (s :: [*]). (a & (Lambda a b & s)) :-> (b & s)
L.exec
compileExpr (NonZero e :: ex
e) = ex
-> ((n & inp) :-> (Maybe n & inp))
-> IndigoState inp (Maybe n & inp) ()
forall n ex res (inp :: [*]).
(IsExpr ex n, KnownValue res) =>
ex -> ((n & inp) :-> (res & inp)) -> IndigoState inp (res & inp) ()
unaryOp ex
e (n & inp) :-> (Maybe n & inp)
forall t (s :: [*]). NonZero t => (t : s) :-> (Maybe t : s)
L.nonZero

-- | Convert arbitrary 'IndigoObjectF' into 'Expr',
-- having converter for fields.
objToExpr
  :: forall a f .
     (forall name . f name -> Expr (GetFieldType a name))
  -> IndigoObjectF f a
  -> Expr a
objToExpr :: (forall (name :: Symbol). f name -> Expr (GetFieldType a name))
-> IndigoObjectF f a -> Expr a
objToExpr _ (Cell refId :: RefId
refId) = Var a -> Expr a
forall a. KnownValue a => Var a -> Expr a
V (RefId -> Var a
forall a (f :: Symbol -> *).
KnownValue a =>
RefId -> IndigoObjectF f a
Cell @a RefId
refId)
objToExpr convExpr :: forall (name :: Symbol). f name -> Expr (GetFieldType a name)
convExpr (Decomposed fields :: Rec f (ConstructorFieldNames a)
fields) =
  Rec Expr (FieldTypes a) -> Expr a
forall dt. ComplexObjectC dt => Rec Expr (FieldTypes dt) -> Expr dt
ConstructWithoutNamed (Rec Expr (FieldTypes a) -> Expr a)
-> Rec Expr (FieldTypes a) -> Expr a
forall a b. (a -> b) -> a -> b
$ (forall (name :: Symbol). f name -> Expr (GetFieldType a name))
-> Rec f (ConstructorFieldNames a) -> Rec Expr (FieldTypes a)
forall a (f :: Symbol -> *) (g :: * -> *).
(forall (name :: Symbol). f name -> g (GetFieldType a name))
-> Rec f (ConstructorFieldNames a) -> Rec g (FieldTypes a)
namedToTypedRec @a forall (name :: Symbol). f name -> Expr (GetFieldType a name)
convExpr Rec f (ConstructorFieldNames a)
fields

-- | Compile 'IndigoObjectF' to a stack cell,
-- having a function which compiles inner fields.
compileObjectF
  :: forall a inp f .
     (forall name . f name -> Expr (GetFieldType a name))
  -> IndigoObjectF f a
  -> IndigoState inp (a & inp) ()
compileObjectF :: (forall (name :: Symbol). f name -> Expr (GetFieldType a name))
-> IndigoObjectF f a -> IndigoState inp (a & inp) ()
compileObjectF _ (Cell ref :: RefId
ref) = do
  md :: MetaData inp
md@(MetaData s :: StackVars inp
s _) <- IndigoState inp inp (MetaData inp)
forall (inp :: [*]). IndigoState inp inp (MetaData inp)
iget
  GenCode inp (a & inp) () -> IndigoState inp (a & inp) ()
forall (inp :: [*]) (out :: [*]) a.
GenCode inp out a -> IndigoState inp out a
iput (GenCode inp (a & inp) () -> IndigoState inp (a & inp) ())
-> GenCode inp (a & inp) () -> IndigoState inp (a & inp) ()
forall a b. (a -> b) -> a -> b
$ ()
-> MetaData (a & inp)
-> (inp :-> (a & inp))
-> ((a & inp) :-> inp)
-> GenCode inp (a & inp) ()
forall (inp :: [*]) (out :: [*]) a.
a
-> MetaData out
-> (inp :-> out)
-> (out :-> inp)
-> GenCode inp out a
GenCode () (MetaData inp -> MetaData (a & inp)
forall a (inp :: [*]).
KnownValue a =>
MetaData inp -> MetaData (a & inp)
pushNoRefMd MetaData inp
md) (RefId -> StackVars inp -> inp :-> (a & inp)
forall a (stk :: [*]).
KnownValue a =>
RefId -> StackVars stk -> stk :-> (a & stk)
varActionGet @a RefId
ref StackVars inp
s) (a & inp) :-> inp
forall a (s :: [*]). (a & s) :-> s
L.drop
compileObjectF conv :: forall (name :: Symbol). f name -> Expr (GetFieldType a name)
conv obj :: IndigoObjectF f a
obj = Expr a -> IndigoState inp (a & inp) ()
forall a (inp :: [*]). Expr a -> IndigoState inp (a & inp) ()
compileExpr (Expr a -> IndigoState inp (a & inp) ())
-> Expr a -> IndigoState inp (a & inp) ()
forall a b. (a -> b) -> a -> b
$ (forall (name :: Symbol). f name -> Expr (GetFieldType a name))
-> IndigoObjectF f a -> Expr a
forall a (f :: Symbol -> *).
(forall (name :: Symbol). f name -> Expr (GetFieldType a name))
-> IndigoObjectF f a -> Expr a
objToExpr forall (name :: Symbol). f name -> Expr (GetFieldType a name)
conv IndigoObjectF f a
obj

-- | Compile 'ObjectManipulation' datatype to a cell on the stack.
-- This function leverages 'ObjManipulationRes' to put off actual field compilation.
compileObjectManipulation :: forall a inp . ObjectManipulation a -> IndigoState inp (a & inp) ()
compileObjectManipulation :: ObjectManipulation a -> IndigoState inp (a & inp) ()
compileObjectManipulation fa :: ObjectManipulation a
fa = case ObjectManipulation a -> ObjManipulationRes inp a
forall x (inp :: [*]).
ObjectManipulation x -> ObjManipulationRes inp x
runObjectManipulation ObjectManipulation a
fa of
  StillObject composite :: ObjectExpr a
composite -> (forall (name :: Symbol).
 NamedFieldExpr a name -> Expr (GetFieldType a name))
-> ObjectExpr a -> IndigoState inp (a & inp) ()
forall a (inp :: [*]) (f :: Symbol -> *).
(forall (name :: Symbol). f name -> Expr (GetFieldType a name))
-> IndigoObjectF f a -> IndigoState inp (a & inp) ()
compileObjectF forall a (name :: Symbol).
NamedFieldExpr a name -> Expr (GetFieldType a name)
forall (name :: Symbol).
NamedFieldExpr a name -> Expr (GetFieldType a name)
unNamedFieldExpr ObjectExpr a
composite
  OnStack comp :: IndigoState inp (a & inp) ()
comp -> IndigoState inp (a & inp) ()
comp

-- | 'ObjManipulationRes' represents a postponed compilation of
-- 'ObjectManipulation' datatype. When 'ObjectManipulation' is being compiled
-- we are trying to put off the generation of code for work with an object
-- because we can just go to a deeper field without its "materialization"
-- onto stack.
data ObjManipulationRes inp a where
  StillObject :: ObjectExpr a -> ObjManipulationRes inp a
  OnStack :: IndigoState inp (a & inp) () -> ObjManipulationRes inp a

-- | This function might look cumbersome
-- but it basically either goes deeper to an inner field or generates Lorentz code.
runObjectManipulation :: ObjectManipulation x -> ObjManipulationRes inp x
runObjectManipulation :: ObjectManipulation x -> ObjManipulationRes inp x
runObjectManipulation (Object e :: Expr x
e) = Expr x -> ObjManipulationRes inp x
forall x (inp :: [*]). Expr x -> ObjManipulationRes inp x
exprToManRes Expr x
e

runObjectManipulation (ToField (ObjectManipulation dt
v :: ObjectManipulation dt) (Label fname
targetLb :: Label fname)) =
  case ObjectManipulation dt -> ObjManipulationRes inp dt
forall x (inp :: [*]).
ObjectManipulation x -> ObjManipulationRes inp x
runObjectManipulation ObjectManipulation dt
v of
    -- In case of decomposed fields, we just go deeper.
    StillObject (Decomposed fields :: Rec (NamedFieldExpr dt) (ConstructorFieldNames dt)
fields) ->
      case forall ftype. HasField dt fname ftype => FieldLens dt fname ftype
forall dt (fname :: Symbol) ftype.
HasField dt fname ftype =>
FieldLens dt fname ftype
fieldLens @dt @fname of
        -- If we access direct field, we just fetch it from fields
        TargetField lb :: Label fname
lb _ -> Expr x -> ObjManipulationRes inp x
forall x (inp :: [*]). Expr x -> ObjManipulationRes inp x
exprToManRes (Expr x -> ObjManipulationRes inp x)
-> Expr x -> ObjManipulationRes inp x
forall a b. (a -> b) -> a -> b
$ NamedFieldExpr dt fname -> Expr (GetFieldType dt fname)
forall a (name :: Symbol).
NamedFieldExpr a name -> Expr (GetFieldType a name)
unNamedFieldExpr (Label fname
-> Rec (NamedFieldExpr dt) (ConstructorFieldNames dt)
-> NamedFieldExpr dt fname
forall a (name :: Symbol) (f :: Symbol -> *)
       (proxy :: Symbol -> *).
AccessFieldC a name =>
proxy name -> Rec f (ConstructorFieldNames a) -> f name
fetchField @dt Label fname
lb Rec (NamedFieldExpr dt) (ConstructorFieldNames dt)
fields)
        -- If we access deeper field, we fetch direct field and goes to the deeper field
        DeeperField lb :: Label fname
lb _ ->
          let fe :: Expr (GetFieldType dt fname)
fe = NamedFieldExpr dt fname -> Expr (GetFieldType dt fname)
forall a (name :: Symbol).
NamedFieldExpr a name -> Expr (GetFieldType a name)
unNamedFieldExpr (NamedFieldExpr dt fname -> Expr (GetFieldType dt fname))
-> NamedFieldExpr dt fname -> Expr (GetFieldType dt fname)
forall a b. (a -> b) -> a -> b
$ Label fname
-> Rec (NamedFieldExpr dt) (ConstructorFieldNames dt)
-> NamedFieldExpr dt fname
forall a (name :: Symbol) (f :: Symbol -> *)
       (proxy :: Symbol -> *).
AccessFieldC a name =>
proxy name -> Rec f (ConstructorFieldNames a) -> f name
fetchField @dt Label fname
lb Rec (NamedFieldExpr dt) (ConstructorFieldNames dt)
fields in
          ObjectManipulation x -> ObjManipulationRes inp x
forall x (inp :: [*]).
ObjectManipulation x -> ObjManipulationRes inp x
runObjectManipulation (ObjectManipulation (GetFieldType dt fname)
-> Label fname -> ObjectManipulation x
forall dt (fname :: Symbol) ftype.
HasField dt fname ftype =>
ObjectManipulation dt -> Label fname -> ObjectManipulation ftype
ToField (Expr (GetFieldType dt fname)
-> ObjectManipulation (GetFieldType dt fname)
forall a. Expr a -> ObjectManipulation a
Object Expr (GetFieldType dt fname)
fe) Label fname
targetLb)
    -- If stored object as cell on the stack, we get its field
    -- using 'sopToField', and since this moment 'ObjManipulationRes becomes
    -- a computation, not object anymore.
    StillObject (Cell refId :: RefId
refId) ->
      IndigoState inp (x & inp) () -> ObjManipulationRes inp x
forall (inp :: [*]) a.
IndigoState inp (a & inp) () -> ObjManipulationRes inp a
OnStack (IndigoState inp (x & inp) () -> ObjManipulationRes inp x)
-> IndigoState inp (x & inp) () -> ObjManipulationRes inp x
forall a b. (a -> b) -> a -> b
$ Expr dt
-> ((dt & inp) :-> (x & inp)) -> IndigoState inp (x & inp) ()
forall n ex res (inp :: [*]).
(IsExpr ex n, KnownValue res) =>
ex -> ((n & inp) :-> (res & inp)) -> IndigoState inp (res & inp) ()
unaryOp (Var dt -> Expr dt
forall a. KnownValue a => Var a -> Expr a
V (Var dt -> Expr dt) -> Var dt -> Expr dt
forall a b. (a -> b) -> a -> b
$ RefId -> Var dt
forall a (f :: Symbol -> *).
KnownValue a =>
RefId -> IndigoObjectF f a
Cell RefId
refId) (StoreFieldOps dt fname x -> Label fname -> (dt & inp) :-> (x & inp)
forall store (fname :: Symbol) ftype.
StoreFieldOps store fname ftype
-> forall (s :: [*]). Label fname -> (store : s) :-> (ftype : s)
sopToField @dt (FieldLens dt fname x -> StoreFieldOps dt fname x
forall dt (fname :: Symbol) ftype.
FieldLens dt fname ftype -> StoreFieldOps dt fname ftype
flSFO FieldLens dt fname x
forall dt (fname :: Symbol) ftype.
HasField dt fname ftype =>
FieldLens dt fname ftype
fieldLens) Label fname
targetLb)
    -- If we already got into computation, we use 'sopToField' to fetch field.
    OnStack compLHS :: IndigoState inp (dt & inp) ()
compLHS -> IndigoState inp (x & inp) () -> ObjManipulationRes inp x
forall (inp :: [*]) a.
IndigoState inp (a & inp) () -> ObjManipulationRes inp a
OnStack (IndigoState inp (x & inp) () -> ObjManipulationRes inp x)
-> IndigoState inp (x & inp) () -> ObjManipulationRes inp x
forall a b. (a -> b) -> a -> b
$ (MetaData inp -> GenCode inp (x & inp) ())
-> IndigoState inp (x & inp) ()
forall (inp :: [*]) (out :: [*]) a.
(MetaData inp -> GenCode inp out a) -> IndigoState inp out a
IndigoState ((MetaData inp -> GenCode inp (x & inp) ())
 -> IndigoState inp (x & inp) ())
-> (MetaData inp -> GenCode inp (x & inp) ())
-> IndigoState inp (x & inp) ()
forall a b. (a -> b) -> a -> b
$ \md :: MetaData inp
md ->
      let cd :: inp :-> (dt & inp)
cd = GenCode inp (dt & inp) () -> inp :-> (dt & inp)
forall (inp :: [*]) (out :: [*]) a.
GenCode inp out a -> inp :-> out
gcCode (GenCode inp (dt & inp) () -> inp :-> (dt & inp))
-> GenCode inp (dt & inp) () -> inp :-> (dt & inp)
forall a b. (a -> b) -> a -> b
$ IndigoState inp (dt & inp) ()
-> MetaData inp -> GenCode inp (dt & inp) ()
forall (inp :: [*]) (out :: [*]) a.
IndigoState inp out a -> MetaData inp -> GenCode inp out a
runIndigoState IndigoState inp (dt & inp) ()
compLHS MetaData inp
md in
      ()
-> MetaData (x & inp)
-> (inp :-> (x & inp))
-> ((x & inp) :-> inp)
-> GenCode inp (x & inp) ()
forall (inp :: [*]) (out :: [*]) a.
a
-> MetaData out
-> (inp :-> out)
-> (out :-> inp)
-> GenCode inp out a
GenCode () (MetaData inp -> MetaData (x & inp)
forall a (inp :: [*]).
KnownValue a =>
MetaData inp -> MetaData (a & inp)
pushNoRefMd MetaData inp
md) (inp :-> (dt & inp)
cd (inp :-> (dt & inp))
-> ((dt & inp) :-> (x & inp)) -> inp :-> (x & inp)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# StoreFieldOps dt fname x -> Label fname -> (dt & inp) :-> (x & inp)
forall store (fname :: Symbol) ftype.
StoreFieldOps store fname ftype
-> forall (s :: [*]). Label fname -> (store : s) :-> (ftype : s)
sopToField (FieldLens dt fname x -> StoreFieldOps dt fname x
forall dt (fname :: Symbol) ftype.
FieldLens dt fname ftype -> StoreFieldOps dt fname ftype
flSFO FieldLens dt fname x
forall dt (fname :: Symbol) ftype.
HasField dt fname ftype =>
FieldLens dt fname ftype
fieldLens) Label fname
targetLb) (x & inp) :-> inp
forall a (s :: [*]). (a & s) :-> s
L.drop

runObjectManipulation (SetField (ObjectManipulation x
ev :: ObjectManipulation dt) (Label fname
targetLb :: Label fname) ef :: Expr ftype
ef) =
  case ObjectManipulation x -> ObjManipulationRes inp x
forall x (inp :: [*]).
ObjectManipulation x -> ObjManipulationRes inp x
runObjectManipulation ObjectManipulation x
ev of
    StillObject lhsObj :: ObjectExpr x
lhsObj@(Decomposed fields :: Rec (NamedFieldExpr x) (ConstructorFieldNames x)
fields) ->
      case forall ftype. HasField x fname ftype => FieldLens x fname ftype
forall dt (fname :: Symbol) ftype.
HasField dt fname ftype =>
FieldLens dt fname ftype
fieldLens @dt @fname of
        -- If we set direct field, we just reassign its value with new one.
        TargetField lb :: Label fname
lb _ ->
          ObjectExpr x -> ObjManipulationRes inp x
forall a (inp :: [*]). ObjectExpr a -> ObjManipulationRes inp a
StillObject (ObjectExpr x -> ObjManipulationRes inp x)
-> ObjectExpr x -> ObjManipulationRes inp x
forall a b. (a -> b) -> a -> b
$ Rec (NamedFieldExpr x) (ConstructorFieldNames x) -> ObjectExpr x
forall a (f :: Symbol -> *).
ComplexObjectC a =>
Rec f (ConstructorFieldNames a) -> IndigoObjectF f a
Decomposed (Rec (NamedFieldExpr x) (ConstructorFieldNames x) -> ObjectExpr x)
-> Rec (NamedFieldExpr x) (ConstructorFieldNames x) -> ObjectExpr x
forall a b. (a -> b) -> a -> b
$ Label fname
-> NamedFieldExpr x fname
-> Rec (NamedFieldExpr x) (ConstructorFieldNames x)
-> Rec (NamedFieldExpr x) (ConstructorFieldNames x)
forall a (name :: Symbol) (f :: Symbol -> *)
       (proxy :: Symbol -> *).
AccessFieldC a name =>
proxy name
-> f name
-> Rec f (ConstructorFieldNames a)
-> Rec f (ConstructorFieldNames a)
assignField @dt Label fname
lb (Expr (GetFieldType x fname) -> NamedFieldExpr x fname
forall a (name :: Symbol).
Expr (GetFieldType a name) -> NamedFieldExpr a name
NamedFieldExpr Expr ftype
Expr (GetFieldType x fname)
ef) Rec (NamedFieldExpr x) (ConstructorFieldNames x)
fields
        -- If we set deeper field, we need to call recursively
        -- from a direct field, and set a target field of direct field.
        -- Getting a new value of direct field, we set the direct field to this value.
        DeeperField (Label fname
lb :: Label interm) _ ->
          let fe :: Expr (GetFieldType x fname)
fe = NamedFieldExpr x fname -> Expr (GetFieldType x fname)
forall a (name :: Symbol).
NamedFieldExpr a name -> Expr (GetFieldType a name)
unNamedFieldExpr (Label fname
-> Rec (NamedFieldExpr x) (ConstructorFieldNames x)
-> NamedFieldExpr x fname
forall a (name :: Symbol) (f :: Symbol -> *)
       (proxy :: Symbol -> *).
AccessFieldC a name =>
proxy name -> Rec f (ConstructorFieldNames a) -> f name
fetchField @dt Label fname
lb Rec (NamedFieldExpr x) (ConstructorFieldNames x)
fields) in
          -- Computing new value of direct field
          case ObjectManipulation (GetFieldType x fname)
-> ObjManipulationRes (x & inp) (GetFieldType x fname)
forall x (inp :: [*]).
ObjectManipulation x -> ObjManipulationRes inp x
runObjectManipulation (ObjectManipulation (GetFieldType x fname)
-> Label fname
-> Expr ftype
-> ObjectManipulation (GetFieldType x fname)
forall dt (fname :: Symbol) ftype.
HasField dt fname ftype =>
ObjectManipulation dt
-> Label fname -> Expr ftype -> ObjectManipulation dt
SetField (Expr (GetFieldType x fname)
-> ObjectManipulation (GetFieldType x fname)
forall a. Expr a -> ObjectManipulation a
Object Expr (GetFieldType x fname)
fe) Label fname
targetLb Expr ftype
ef) of
            -- If it's still object, we just reassign direct field with it.
            StillObject updField :: ObjectExpr (GetFieldType x fname)
updField -> ObjectExpr x -> ObjManipulationRes inp x
forall a (inp :: [*]). ObjectExpr a -> ObjManipulationRes inp a
StillObject (ObjectExpr x -> ObjManipulationRes inp x)
-> ObjectExpr x -> ObjManipulationRes inp x
forall a b. (a -> b) -> a -> b
$ Rec (NamedFieldExpr x) (ConstructorFieldNames x) -> ObjectExpr x
forall a (f :: Symbol -> *).
ComplexObjectC a =>
Rec f (ConstructorFieldNames a) -> IndigoObjectF f a
Decomposed (Rec (NamedFieldExpr x) (ConstructorFieldNames x) -> ObjectExpr x)
-> Rec (NamedFieldExpr x) (ConstructorFieldNames x) -> ObjectExpr x
forall a b. (a -> b) -> a -> b
$
              Label fname
-> NamedFieldExpr x fname
-> Rec (NamedFieldExpr x) (ConstructorFieldNames x)
-> Rec (NamedFieldExpr x) (ConstructorFieldNames x)
forall a (name :: Symbol) (f :: Symbol -> *)
       (proxy :: Symbol -> *).
AccessFieldC a name =>
proxy name
-> f name
-> Rec f (ConstructorFieldNames a)
-> Rec f (ConstructorFieldNames a)
assignField @dt Label fname
lb (Expr (GetFieldType x fname) -> NamedFieldExpr x fname
forall a (name :: Symbol).
Expr (GetFieldType a name) -> NamedFieldExpr a name
NamedFieldExpr (Expr (GetFieldType x fname) -> NamedFieldExpr x fname)
-> Expr (GetFieldType x fname) -> NamedFieldExpr x fname
forall a b. (a -> b) -> a -> b
$ (forall (name :: Symbol).
 NamedFieldExpr (GetFieldType x fname) name
 -> Expr (GetFieldType (GetFieldType x fname) name))
-> ObjectExpr (GetFieldType x fname) -> Expr (GetFieldType x fname)
forall a (f :: Symbol -> *).
(forall (name :: Symbol). f name -> Expr (GetFieldType a name))
-> IndigoObjectF f a -> Expr a
objToExpr forall a (name :: Symbol).
NamedFieldExpr a name -> Expr (GetFieldType a name)
forall (name :: Symbol).
NamedFieldExpr (GetFieldType x fname) name
-> Expr (GetFieldType (GetFieldType x fname) name)
unNamedFieldExpr ObjectExpr (GetFieldType x fname)
updField) Rec (NamedFieldExpr x) (ConstructorFieldNames x)
fields
            -- Otherwise, we use power of 'L.setField' to set a new value.
            OnStack rhs :: IndigoState (x & inp) (GetFieldType x fname & (x & inp)) ()
rhs ->
              IndigoState inp (x & inp) ()
-> IndigoState (x & inp) (GetFieldType x fname & (x & inp)) ()
-> ((GetFieldType x fname & (x & inp)) :-> (x & inp))
-> ObjManipulationRes inp x
forall (inp :: [*]) fld.
IndigoState inp (x & inp) ()
-> IndigoState (x & inp) (fld & (x & inp)) ()
-> ((fld & (x & inp)) :-> (x & inp))
-> ObjManipulationRes inp x
setFieldOnStack ((forall (name :: Symbol).
 NamedFieldExpr x name -> Expr (GetFieldType x name))
-> ObjectExpr x -> IndigoState inp (x & inp) ()
forall a (inp :: [*]) (f :: Symbol -> *).
(forall (name :: Symbol). f name -> Expr (GetFieldType a name))
-> IndigoObjectF f a -> IndigoState inp (a & inp) ()
compileObjectF forall a (name :: Symbol).
NamedFieldExpr a name -> Expr (GetFieldType a name)
forall (name :: Symbol).
NamedFieldExpr x name -> Expr (GetFieldType x name)
unNamedFieldExpr ObjectExpr x
lhsObj) IndigoState (x & inp) (GetFieldType x fname & (x & inp)) ()
rhs (Label fname -> (GetFieldType x fname & (x & inp)) :-> (x & inp)
forall dt (name :: Symbol) (st :: [*]).
InstrSetFieldC dt name =>
Label name -> (GetFieldType dt name : dt : st) :-> (dt : st)
L.setField @dt @interm Label fname
lb)
    -- If stored object is Cell on stack, we set its field
    -- using 'sopSetField', and since this moment 'ObjManipulationRes' becomes
    -- a computation, not object anymore.
    StillObject (Cell refId :: RefId
refId) ->
      IndigoState inp (x & inp) () -> ObjManipulationRes inp x
forall (inp :: [*]) a.
IndigoState inp (a & inp) () -> ObjManipulationRes inp a
OnStack (IndigoState inp (x & inp) () -> ObjManipulationRes inp x)
-> IndigoState inp (x & inp) () -> ObjManipulationRes inp x
forall a b. (a -> b) -> a -> b
$ Expr ftype
-> Expr x
-> ((ftype & (x & inp)) :-> (x & inp))
-> IndigoState inp (x & inp) ()
forall n m ex1 ex2 res (inp :: [*]).
(AreExprs ex1 ex2 n m, KnownValue res) =>
ex1
-> ex2
-> ((n & (m & inp)) :-> (res & inp))
-> IndigoState inp (res & inp) ()
binaryOp Expr ftype
ef (Var x -> Expr x
forall a. KnownValue a => Var a -> Expr a
V (Var x -> Expr x) -> Var x -> Expr x
forall a b. (a -> b) -> a -> b
$ RefId -> Var x
forall a (f :: Symbol -> *).
KnownValue a =>
RefId -> IndigoObjectF f a
Cell RefId
refId) (((ftype & (x & inp)) :-> (x & inp))
 -> IndigoState inp (x & inp) ())
-> ((ftype & (x & inp)) :-> (x & inp))
-> IndigoState inp (x & inp) ()
forall a b. (a -> b) -> a -> b
$ StoreFieldOps x fname ftype
-> Label fname -> (ftype & (x & inp)) :-> (x & inp)
forall store (fname :: Symbol) ftype.
StoreFieldOps store fname ftype
-> forall (s :: [*]).
   Label fname -> (ftype : store : s) :-> (store : s)
sopSetField (FieldLens x fname ftype -> StoreFieldOps x fname ftype
forall dt (fname :: Symbol) ftype.
FieldLens dt fname ftype -> StoreFieldOps dt fname ftype
flSFO FieldLens x fname ftype
forall dt (fname :: Symbol) ftype.
HasField dt fname ftype =>
FieldLens dt fname ftype
fieldLens) Label fname
targetLb
    -- If we already got into computation, we use 'sopSetField' to set a field.
    OnStack compLHS :: IndigoState inp (x & inp) ()
compLHS ->
      IndigoState inp (x & inp) ()
-> IndigoState (x & inp) (ftype & (x & inp)) ()
-> ((ftype & (x & inp)) :-> (x & inp))
-> ObjManipulationRes inp x
forall (inp :: [*]) fld.
IndigoState inp (x & inp) ()
-> IndigoState (x & inp) (fld & (x & inp)) ()
-> ((fld & (x & inp)) :-> (x & inp))
-> ObjManipulationRes inp x
setFieldOnStack IndigoState inp (x & inp) ()
compLHS (Expr ftype -> IndigoState (x & inp) (ftype & (x & inp)) ()
forall a (inp :: [*]). Expr a -> IndigoState inp (a & inp) ()
compileExpr Expr ftype
ef) (StoreFieldOps x fname ftype
-> Label fname -> (ftype & (x & inp)) :-> (x & inp)
forall store (fname :: Symbol) ftype.
StoreFieldOps store fname ftype
-> forall (s :: [*]).
   Label fname -> (ftype : store : s) :-> (store : s)
sopSetField (FieldLens x fname ftype -> StoreFieldOps x fname ftype
forall dt (fname :: Symbol) ftype.
FieldLens dt fname ftype -> StoreFieldOps dt fname ftype
flSFO (FieldLens x fname ftype -> StoreFieldOps x fname ftype)
-> FieldLens x fname ftype -> StoreFieldOps x fname ftype
forall a b. (a -> b) -> a -> b
$ forall dt (fname :: Symbol) ftype.
HasField dt fname ftype =>
FieldLens dt fname ftype
forall (fname :: Symbol) ftype.
HasField x fname ftype =>
FieldLens x fname ftype
fieldLens @dt) Label fname
targetLb)
  where
    setFieldOnStack
      :: IndigoState inp (dt & inp) ()
      -> IndigoState (dt & inp) (fld & dt & inp) ()
      -> fld & dt & inp :-> dt & inp
      -> ObjManipulationRes inp dt
    setFieldOnStack :: IndigoState inp (x & inp) ()
-> IndigoState (x & inp) (fld & (x & inp)) ()
-> ((fld & (x & inp)) :-> (x & inp))
-> ObjManipulationRes inp x
setFieldOnStack lhs :: IndigoState inp (x & inp) ()
lhs rhs :: IndigoState (x & inp) (fld & (x & inp)) ()
rhs setOp :: (fld & (x & inp)) :-> (x & inp)
setOp = IndigoState inp (x & inp) () -> ObjManipulationRes inp x
forall (inp :: [*]) a.
IndigoState inp (a & inp) () -> ObjManipulationRes inp a
OnStack (IndigoState inp (x & inp) () -> ObjManipulationRes inp x)
-> IndigoState inp (x & inp) () -> ObjManipulationRes inp x
forall a b. (a -> b) -> a -> b
$ (MetaData inp -> GenCode inp (x & inp) ())
-> IndigoState inp (x & inp) ()
forall (inp :: [*]) (out :: [*]) a.
(MetaData inp -> GenCode inp out a) -> IndigoState inp out a
IndigoState ((MetaData inp -> GenCode inp (x & inp) ())
 -> IndigoState inp (x & inp) ())
-> (MetaData inp -> GenCode inp (x & inp) ())
-> IndigoState inp (x & inp) ()
forall a b. (a -> b) -> a -> b
$ \md :: MetaData inp
md ->
      let GenCode _ md1 :: MetaData (x & inp)
md1 cdObj :: inp :-> (x & inp)
cdObj _cl1 :: (x & inp) :-> inp
_cl1 = IndigoState inp (x & inp) ()
-> MetaData inp -> GenCode inp (x & inp) ()
forall (inp :: [*]) (out :: [*]) a.
IndigoState inp out a -> MetaData inp -> GenCode inp out a
runIndigoState IndigoState inp (x & inp) ()
lhs MetaData inp
md in
      let GenCode _ _md2 :: MetaData (fld & (x & inp))
_md2 cdFld :: (x & inp) :-> (fld & (x & inp))
cdFld _cl2 :: (fld & (x & inp)) :-> (x & inp)
_cl2 = IndigoState (x & inp) (fld & (x & inp)) ()
-> MetaData (x & inp) -> GenCode (x & inp) (fld & (x & inp)) ()
forall (inp :: [*]) (out :: [*]) a.
IndigoState inp out a -> MetaData inp -> GenCode inp out a
runIndigoState IndigoState (x & inp) (fld & (x & inp)) ()
rhs MetaData (x & inp)
md1 in
      ()
-> MetaData (x & inp)
-> (inp :-> (x & inp))
-> ((x & inp) :-> inp)
-> GenCode inp (x & inp) ()
forall (inp :: [*]) (out :: [*]) a.
a
-> MetaData out
-> (inp :-> out)
-> (out :-> inp)
-> GenCode inp out a
GenCode () (MetaData inp -> MetaData (x & inp)
forall a (inp :: [*]).
KnownValue a =>
MetaData inp -> MetaData (a & inp)
pushNoRefMd MetaData inp
md) (inp :-> (x & inp)
cdObj (inp :-> (x & inp))
-> ((x & inp) :-> (fld & (x & inp))) -> inp :-> (fld & (x & inp))
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# (x & inp) :-> (fld & (x & inp))
cdFld (inp :-> (fld & (x & inp)))
-> ((fld & (x & inp)) :-> (x & inp)) -> inp :-> (x & inp)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# (fld & (x & inp)) :-> (x & inp)
setOp) (x & inp) :-> inp
forall a (s :: [*]). (a & s) :-> s
L.drop

-- | Convert an expression to 'ObjManipulationRes'.
-- The function pattern matches on some specific cases
-- of expression those compilation into a stack cell may be postponed.
-- They include 'Decomposed' variables and 'ConstructWithoutNamed' expressions.
--
-- This function can't be called for 'ObjMan' constructor, but we
-- take care of it just in case.
exprToManRes :: forall x inp . Expr x -> ObjManipulationRes inp x
exprToManRes :: Expr x -> ObjManipulationRes inp x
exprToManRes (ObjMan objMan :: ObjectManipulation x
objMan) = ObjectManipulation x -> ObjManipulationRes inp x
forall x (inp :: [*]).
ObjectManipulation x -> ObjManipulationRes inp x
runObjectManipulation ObjectManipulation x
objMan
exprToManRes (ConstructWithoutNamed fields :: Rec Expr (FieldTypes x)
fields) =
  ObjectExpr x -> ObjManipulationRes inp x
forall a (inp :: [*]). ObjectExpr a -> ObjManipulationRes inp a
StillObject (ObjectExpr x -> ObjManipulationRes inp x)
-> ObjectExpr x -> ObjManipulationRes inp x
forall a b. (a -> b) -> a -> b
$ Rec (NamedFieldExpr x) (ConstructorFieldNames x) -> ObjectExpr x
forall a (f :: Symbol -> *).
ComplexObjectC a =>
Rec f (ConstructorFieldNames a) -> IndigoObjectF f a
Decomposed (Rec (NamedFieldExpr x) (ConstructorFieldNames x) -> ObjectExpr x)
-> Rec (NamedFieldExpr x) (ConstructorFieldNames x) -> ObjectExpr x
forall a b. (a -> b) -> a -> b
$ (forall (name :: Symbol).
 Expr (GetFieldType x name) -> NamedFieldExpr x name)
-> Rec Expr (FieldTypes x)
-> Rec (NamedFieldExpr x) (ConstructorFieldNames x)
forall a (f :: * -> *) (g :: Symbol -> *).
KnownList (ConstructorFieldNames a) =>
(forall (name :: Symbol). f (GetFieldType a name) -> g name)
-> Rec f (FieldTypes a) -> Rec g (ConstructorFieldNames a)
typedToNamedRec @x forall a (name :: Symbol).
Expr (GetFieldType a name) -> NamedFieldExpr a name
forall (name :: Symbol).
Expr (GetFieldType x name) -> NamedFieldExpr x name
NamedFieldExpr Rec Expr (FieldTypes x)
fields
exprToManRes (V (Decomposed fields :: Rec (NamedFieldVar x) (ConstructorFieldNames x)
fields)) =
  ObjectExpr x -> ObjManipulationRes inp x
forall a (inp :: [*]). ObjectExpr a -> ObjManipulationRes inp a
StillObject (ObjectExpr x -> ObjManipulationRes inp x)
-> ObjectExpr x -> ObjManipulationRes inp x
forall a b. (a -> b) -> a -> b
$ Rec (NamedFieldExpr x) (ConstructorFieldNames x) -> ObjectExpr x
forall a (f :: Symbol -> *).
ComplexObjectC a =>
Rec f (ConstructorFieldNames a) -> IndigoObjectF f a
Decomposed (Rec (NamedFieldExpr x) (ConstructorFieldNames x) -> ObjectExpr x)
-> Rec (NamedFieldExpr x) (ConstructorFieldNames x) -> ObjectExpr x
forall a b. (a -> b) -> a -> b
$ (forall (x :: Symbol). NamedFieldVar x x -> NamedFieldExpr x x)
-> Rec (NamedFieldVar x) (ConstructorFieldNames x)
-> Rec (NamedFieldExpr x) (ConstructorFieldNames x)
forall u (rs :: [u]) (f :: u -> *) (g :: u -> *).
RMap rs =>
(forall (x :: u). f x -> g x) -> Rec f rs -> Rec g rs
rmap (\(NamedFieldVar f) -> Expr (GetFieldType x x) -> NamedFieldExpr x x
forall a (name :: Symbol).
Expr (GetFieldType a name) -> NamedFieldExpr a name
NamedFieldExpr (Expr (GetFieldType x x) -> NamedFieldExpr x x)
-> Expr (GetFieldType x x) -> NamedFieldExpr x x
forall a b. (a -> b) -> a -> b
$ Var (GetFieldType x x) -> Expr (GetFieldType x x)
forall a. KnownValue a => Var a -> Expr a
V Var (GetFieldType x x)
f) Rec (NamedFieldVar x) (ConstructorFieldNames x)
fields
exprToManRes (V (Cell refId :: RefId
refId)) = ObjectExpr x -> ObjManipulationRes inp x
forall a (inp :: [*]). ObjectExpr a -> ObjManipulationRes inp a
StillObject (ObjectExpr x -> ObjManipulationRes inp x)
-> ObjectExpr x -> ObjManipulationRes inp x
forall a b. (a -> b) -> a -> b
$ RefId -> ObjectExpr x
forall a (f :: Symbol -> *).
KnownValue a =>
RefId -> IndigoObjectF f a
Cell RefId
refId
exprToManRes ex :: Expr x
ex = IndigoState inp (x & inp) () -> ObjManipulationRes inp x
forall (inp :: [*]) a.
IndigoState inp (a & inp) () -> ObjManipulationRes inp a
OnStack (IndigoState inp (x & inp) () -> ObjManipulationRes inp x)
-> IndigoState inp (x & inp) () -> ObjManipulationRes inp x
forall a b. (a -> b) -> a -> b
$ Expr x -> IndigoState inp (x & inp) ()
forall a (inp :: [*]). Expr a -> IndigoState inp (a & inp) ()
compileExpr Expr x
ex

ternaryOp
  :: forall n m l ex1 ex2 ex3 res inp. (AreExprs ex1 ex2 n m, IsExpr ex3 l, KnownValue res)
  => ex1
  -> ex2
  -> ex3
  -> n & m & l & inp :-> res & inp -> IndigoState inp (res & inp) ()
ternaryOp :: ex1
-> ex2
-> ex3
-> ((n & (m & (l & inp))) :-> (res & inp))
-> IndigoState inp (res & inp) ()
ternaryOp e1 :: ex1
e1 e2 :: ex2
e2 e3 :: ex3
e3 opCode :: (n & (m & (l & inp))) :-> (res & inp)
opCode = (MetaData inp -> GenCode inp (res & inp) ())
-> IndigoState inp (res & inp) ()
forall (inp :: [*]) (out :: [*]) a.
(MetaData inp -> GenCode inp out a) -> IndigoState inp out a
IndigoState ((MetaData inp -> GenCode inp (res & inp) ())
 -> IndigoState inp (res & inp) ())
-> (MetaData inp -> GenCode inp (res & inp) ())
-> IndigoState inp (res & inp) ()
forall a b. (a -> b) -> a -> b
$ \md :: MetaData inp
md ->
  let GenCode _ md3 :: MetaData (l & inp)
md3 cd3 :: inp :-> (l & inp)
cd3 _cl3 :: (l & inp) :-> inp
_cl3  = IndigoState inp (l & inp) ()
-> MetaData inp -> GenCode inp (l & inp) ()
forall (inp :: [*]) (out :: [*]) a.
IndigoState inp out a -> MetaData inp -> GenCode inp out a
runIndigoState (ex3 -> IndigoState inp (ExprType ex3 & inp) ()
forall a (inp :: [*]).
ToExpr a =>
a -> IndigoState inp (ExprType a & inp) ()
compileToExpr ex3
e3) MetaData inp
md in
  let GenCode _ md2 :: MetaData (m & (l & inp))
md2 cd2 :: (l & inp) :-> (m & (l & inp))
cd2 _cl2 :: (m & (l & inp)) :-> (l & inp)
_cl2  = IndigoState (l & inp) (m & (l & inp)) ()
-> MetaData (l & inp) -> GenCode (l & inp) (m & (l & inp)) ()
forall (inp :: [*]) (out :: [*]) a.
IndigoState inp out a -> MetaData inp -> GenCode inp out a
runIndigoState (ex2 -> IndigoState (l & inp) (ExprType ex2 & (l & inp)) ()
forall a (inp :: [*]).
ToExpr a =>
a -> IndigoState inp (ExprType a & inp) ()
compileToExpr ex2
e2) MetaData (l & inp)
md3 in
  let GenCode _ _md1 :: MetaData (n & (m & (l & inp)))
_md1 cd1 :: (m & (l & inp)) :-> (n & (m & (l & inp)))
cd1 _cl1 :: (n & (m & (l & inp))) :-> (m & (l & inp))
_cl1 = IndigoState (m & (l & inp)) (n & (m & (l & inp))) ()
-> MetaData (m & (l & inp))
-> GenCode (m & (l & inp)) (n & (m & (l & inp))) ()
forall (inp :: [*]) (out :: [*]) a.
IndigoState inp out a -> MetaData inp -> GenCode inp out a
runIndigoState (ex1
-> IndigoState (m & (l & inp)) (ExprType ex1 & (m & (l & inp))) ()
forall a (inp :: [*]).
ToExpr a =>
a -> IndigoState inp (ExprType a & inp) ()
compileToExpr ex1
e1) MetaData (m & (l & inp))
md2 in
  ()
-> MetaData (res & inp)
-> (inp :-> (res & inp))
-> ((res & inp) :-> inp)
-> GenCode inp (res & inp) ()
forall (inp :: [*]) (out :: [*]) a.
a
-> MetaData out
-> (inp :-> out)
-> (out :-> inp)
-> GenCode inp out a
GenCode () (MetaData inp -> MetaData (res & inp)
forall a (inp :: [*]).
KnownValue a =>
MetaData inp -> MetaData (a & inp)
pushNoRefMd MetaData inp
md) (inp :-> (l & inp)
cd3 (inp :-> (l & inp))
-> ((l & inp) :-> (m & (l & inp))) -> inp :-> (m & (l & inp))
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# (l & inp) :-> (m & (l & inp))
cd2 (inp :-> (m & (l & inp)))
-> ((m & (l & inp)) :-> (n & (m & (l & inp))))
-> inp :-> (n & (m & (l & inp)))
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# (m & (l & inp)) :-> (n & (m & (l & inp)))
cd1 (inp :-> (n & (m & (l & inp))))
-> ((n & (m & (l & inp))) :-> (res & inp)) -> inp :-> (res & inp)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# (n & (m & (l & inp))) :-> (res & inp)
opCode) (res & inp) :-> inp
forall a (s :: [*]). (a & s) :-> s
L.drop

binaryOp
  :: forall n m ex1 ex2 res inp . (AreExprs ex1 ex2 n m, KnownValue res)
  => ex1 -> ex2 -> n & m & inp :-> res & inp -> IndigoState inp (res & inp) ()
binaryOp :: ex1
-> ex2
-> ((n & (m & inp)) :-> (res & inp))
-> IndigoState inp (res & inp) ()
binaryOp e1 :: ex1
e1 e2 :: ex2
e2 opCode :: (n & (m & inp)) :-> (res & inp)
opCode = (MetaData inp -> GenCode inp (res & inp) ())
-> IndigoState inp (res & inp) ()
forall (inp :: [*]) (out :: [*]) a.
(MetaData inp -> GenCode inp out a) -> IndigoState inp out a
IndigoState ((MetaData inp -> GenCode inp (res & inp) ())
 -> IndigoState inp (res & inp) ())
-> (MetaData inp -> GenCode inp (res & inp) ())
-> IndigoState inp (res & inp) ()
forall a b. (a -> b) -> a -> b
$ \md :: MetaData inp
md ->
  let GenCode _ md2 :: MetaData (m & inp)
md2 cd2 :: inp :-> (m & inp)
cd2 _cl2 :: (m & inp) :-> inp
_cl2  = IndigoState inp (m & inp) ()
-> MetaData inp -> GenCode inp (m & inp) ()
forall (inp :: [*]) (out :: [*]) a.
IndigoState inp out a -> MetaData inp -> GenCode inp out a
runIndigoState (ex2 -> IndigoState inp (ExprType ex2 & inp) ()
forall a (inp :: [*]).
ToExpr a =>
a -> IndigoState inp (ExprType a & inp) ()
compileToExpr ex2
e2) MetaData inp
md in
  let GenCode _ _md1 :: MetaData (n & (m & inp))
_md1 cd1 :: (m & inp) :-> (n & (m & inp))
cd1 _cl1 :: (n & (m & inp)) :-> (m & inp)
_cl1 = IndigoState (m & inp) (n & (m & inp)) ()
-> MetaData (m & inp) -> GenCode (m & inp) (n & (m & inp)) ()
forall (inp :: [*]) (out :: [*]) a.
IndigoState inp out a -> MetaData inp -> GenCode inp out a
runIndigoState (ex1 -> IndigoState (m & inp) (ExprType ex1 & (m & inp)) ()
forall a (inp :: [*]).
ToExpr a =>
a -> IndigoState inp (ExprType a & inp) ()
compileToExpr ex1
e1) MetaData (m & inp)
md2 in
  ()
-> MetaData (res & inp)
-> (inp :-> (res & inp))
-> ((res & inp) :-> inp)
-> GenCode inp (res & inp) ()
forall (inp :: [*]) (out :: [*]) a.
a
-> MetaData out
-> (inp :-> out)
-> (out :-> inp)
-> GenCode inp out a
GenCode () (MetaData inp -> MetaData (res & inp)
forall a (inp :: [*]).
KnownValue a =>
MetaData inp -> MetaData (a & inp)
pushNoRefMd MetaData inp
md) (inp :-> (m & inp)
cd2 (inp :-> (m & inp))
-> ((m & inp) :-> (n & (m & inp))) -> inp :-> (n & (m & inp))
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# (m & inp) :-> (n & (m & inp))
cd1 (inp :-> (n & (m & inp)))
-> ((n & (m & inp)) :-> (res & inp)) -> inp :-> (res & inp)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# (n & (m & inp)) :-> (res & inp)
opCode) (res & inp) :-> inp
forall a (s :: [*]). (a & s) :-> s
L.drop

unaryOp
  :: forall n ex res inp . (IsExpr ex n, KnownValue res)
  => ex -> n & inp :-> res & inp -> IndigoState inp (res & inp) ()
unaryOp :: ex -> ((n & inp) :-> (res & inp)) -> IndigoState inp (res & inp) ()
unaryOp e :: ex
e opCode :: (n & inp) :-> (res & inp)
opCode = (MetaData inp -> GenCode inp (res & inp) ())
-> IndigoState inp (res & inp) ()
forall (inp :: [*]) (out :: [*]) a.
(MetaData inp -> GenCode inp out a) -> IndigoState inp out a
IndigoState ((MetaData inp -> GenCode inp (res & inp) ())
 -> IndigoState inp (res & inp) ())
-> (MetaData inp -> GenCode inp (res & inp) ())
-> IndigoState inp (res & inp) ()
forall a b. (a -> b) -> a -> b
$ \md :: MetaData inp
md ->
  let cd :: inp :-> (n & inp)
cd = GenCode inp (n & inp) () -> inp :-> (n & inp)
forall (inp :: [*]) (out :: [*]) a.
GenCode inp out a -> inp :-> out
gcCode (GenCode inp (n & inp) () -> inp :-> (n & inp))
-> GenCode inp (n & inp) () -> inp :-> (n & inp)
forall a b. (a -> b) -> a -> b
$ IndigoState inp (n & inp) ()
-> MetaData inp -> GenCode inp (n & inp) ()
forall (inp :: [*]) (out :: [*]) a.
IndigoState inp out a -> MetaData inp -> GenCode inp out a
runIndigoState (ex -> IndigoState inp (ExprType ex & inp) ()
forall a (inp :: [*]).
ToExpr a =>
a -> IndigoState inp (ExprType a & inp) ()
compileToExpr ex
e) MetaData inp
md in
  ()
-> MetaData (res & inp)
-> (inp :-> (res & inp))
-> ((res & inp) :-> inp)
-> GenCode inp (res & inp) ()
forall (inp :: [*]) (out :: [*]) a.
a
-> MetaData out
-> (inp :-> out)
-> (out :-> inp)
-> GenCode inp out a
GenCode () (MetaData inp -> MetaData (res & inp)
forall a (inp :: [*]).
KnownValue a =>
MetaData inp -> MetaData (a & inp)
pushNoRefMd MetaData inp
md) (inp :-> (n & inp)
cd (inp :-> (n & inp))
-> ((n & inp) :-> (res & inp)) -> inp :-> (res & inp)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# (n & inp) :-> (res & inp)
opCode) (res & inp) :-> inp
forall a (s :: [*]). (a & s) :-> s
L.drop

nullaryOp :: KnownValue res => inp :-> res ': inp -> IndigoState inp (res ': inp) ()
nullaryOp :: (inp :-> (res : inp)) -> IndigoState inp (res : inp) ()
nullaryOp lorentzInstr :: inp :-> (res : inp)
lorentzInstr = (MetaData inp -> GenCode inp (res : inp) ())
-> IndigoState inp (res : inp) ()
forall (inp :: [*]) (out :: [*]) a.
(MetaData inp -> GenCode inp out a) -> IndigoState inp out a
IndigoState ((MetaData inp -> GenCode inp (res : inp) ())
 -> IndigoState inp (res : inp) ())
-> (MetaData inp -> GenCode inp (res : inp) ())
-> IndigoState inp (res : inp) ()
forall a b. (a -> b) -> a -> b
$ \md :: MetaData inp
md ->
  ()
-> MetaData (res : inp)
-> (inp :-> (res : inp))
-> ((res : inp) :-> inp)
-> GenCode inp (res : inp) ()
forall (inp :: [*]) (out :: [*]) a.
a
-> MetaData out
-> (inp :-> out)
-> (out :-> inp)
-> GenCode inp out a
GenCode () (MetaData inp -> MetaData (res : inp)
forall a (inp :: [*]).
KnownValue a =>
MetaData inp -> MetaData (a & inp)
pushNoRefMd MetaData inp
md) inp :-> (res : inp)
lorentzInstr (res : inp) :-> inp
forall a (s :: [*]). (a & s) :-> s
L.drop

ternaryOpFlat
  :: forall n m l ex1 ex2 ex3 inp. (AreExprs ex1 ex2 n m, IsExpr ex3 l)
  => ex1
  -> ex2
  -> ex3
  -> n & m & l & inp :-> inp -> IndigoState inp inp ()
ternaryOpFlat :: ex1
-> ex2
-> ex3
-> ((n & (m & (l & inp))) :-> inp)
-> IndigoState inp inp ()
ternaryOpFlat e1 :: ex1
e1 e2 :: ex2
e2 e3 :: ex3
e3 opCode :: (n & (m & (l & inp))) :-> inp
opCode = (MetaData inp -> GenCode inp inp ()) -> IndigoState inp inp ()
forall (inp :: [*]) (out :: [*]) a.
(MetaData inp -> GenCode inp out a) -> IndigoState inp out a
IndigoState ((MetaData inp -> GenCode inp inp ()) -> IndigoState inp inp ())
-> (MetaData inp -> GenCode inp inp ()) -> IndigoState inp inp ()
forall a b. (a -> b) -> a -> b
$ \md :: MetaData inp
md ->
  let GenCode _ md3 :: MetaData (l & inp)
md3 cd3 :: inp :-> (l & inp)
cd3 _cl3 :: (l & inp) :-> inp
_cl3  = IndigoState inp (l & inp) ()
-> MetaData inp -> GenCode inp (l & inp) ()
forall (inp :: [*]) (out :: [*]) a.
IndigoState inp out a -> MetaData inp -> GenCode inp out a
runIndigoState (ex3 -> IndigoState inp (ExprType ex3 & inp) ()
forall a (inp :: [*]).
ToExpr a =>
a -> IndigoState inp (ExprType a & inp) ()
compileToExpr ex3
e3) MetaData inp
md in
  let GenCode _ md2 :: MetaData (m & (l & inp))
md2 cd2 :: (l & inp) :-> (m & (l & inp))
cd2 _cl2 :: (m & (l & inp)) :-> (l & inp)
_cl2  = IndigoState (l & inp) (m & (l & inp)) ()
-> MetaData (l & inp) -> GenCode (l & inp) (m & (l & inp)) ()
forall (inp :: [*]) (out :: [*]) a.
IndigoState inp out a -> MetaData inp -> GenCode inp out a
runIndigoState (ex2 -> IndigoState (l & inp) (ExprType ex2 & (l & inp)) ()
forall a (inp :: [*]).
ToExpr a =>
a -> IndigoState inp (ExprType a & inp) ()
compileToExpr ex2
e2) MetaData (l & inp)
md3 in
  let GenCode _ _md1 :: MetaData (n & (m & (l & inp)))
_md1 cd1 :: (m & (l & inp)) :-> (n & (m & (l & inp)))
cd1 _cl1 :: (n & (m & (l & inp))) :-> (m & (l & inp))
_cl1 = IndigoState (m & (l & inp)) (n & (m & (l & inp))) ()
-> MetaData (m & (l & inp))
-> GenCode (m & (l & inp)) (n & (m & (l & inp))) ()
forall (inp :: [*]) (out :: [*]) a.
IndigoState inp out a -> MetaData inp -> GenCode inp out a
runIndigoState (ex1
-> IndigoState (m & (l & inp)) (ExprType ex1 & (m & (l & inp))) ()
forall a (inp :: [*]).
ToExpr a =>
a -> IndigoState inp (ExprType a & inp) ()
compileToExpr ex1
e1) MetaData (m & (l & inp))
md2 in
  ()
-> MetaData inp
-> (inp :-> inp)
-> (inp :-> inp)
-> GenCode inp inp ()
forall (inp :: [*]) (out :: [*]) a.
a
-> MetaData out
-> (inp :-> out)
-> (out :-> inp)
-> GenCode inp out a
GenCode () MetaData inp
md (inp :-> (l & inp)
cd3 (inp :-> (l & inp))
-> ((l & inp) :-> (m & (l & inp))) -> inp :-> (m & (l & inp))
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# (l & inp) :-> (m & (l & inp))
cd2 (inp :-> (m & (l & inp)))
-> ((m & (l & inp)) :-> (n & (m & (l & inp))))
-> inp :-> (n & (m & (l & inp)))
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# (m & (l & inp)) :-> (n & (m & (l & inp)))
cd1 (inp :-> (n & (m & (l & inp))))
-> ((n & (m & (l & inp))) :-> inp) -> inp :-> inp
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# (n & (m & (l & inp))) :-> inp
opCode) inp :-> inp
forall (s :: [*]). s :-> s
L.nop

binaryOpFlat
  :: forall n m ex1 ex2 inp . (AreExprs ex1 ex2 n m)
  => ex1 -> ex2 -> n & m & inp :-> inp -> IndigoState inp inp ()
binaryOpFlat :: ex1 -> ex2 -> ((n & (m & inp)) :-> inp) -> IndigoState inp inp ()
binaryOpFlat e1 :: ex1
e1 e2 :: ex2
e2 opCode :: (n & (m & inp)) :-> inp
opCode = (MetaData inp -> GenCode inp inp ()) -> IndigoState inp inp ()
forall (inp :: [*]) (out :: [*]) a.
(MetaData inp -> GenCode inp out a) -> IndigoState inp out a
IndigoState ((MetaData inp -> GenCode inp inp ()) -> IndigoState inp inp ())
-> (MetaData inp -> GenCode inp inp ()) -> IndigoState inp inp ()
forall a b. (a -> b) -> a -> b
$ \md :: MetaData inp
md ->
  let GenCode _ md2 :: MetaData (m & inp)
md2 cd2 :: inp :-> (m & inp)
cd2 _cl2 :: (m & inp) :-> inp
_cl2  = IndigoState inp (m & inp) ()
-> MetaData inp -> GenCode inp (m & inp) ()
forall (inp :: [*]) (out :: [*]) a.
IndigoState inp out a -> MetaData inp -> GenCode inp out a
runIndigoState (ex2 -> IndigoState inp (ExprType ex2 & inp) ()
forall a (inp :: [*]).
ToExpr a =>
a -> IndigoState inp (ExprType a & inp) ()
compileToExpr ex2
e2) MetaData inp
md in
  let GenCode _ _md1 :: MetaData (n & (m & inp))
_md1 cd1 :: (m & inp) :-> (n & (m & inp))
cd1 _cl1 :: (n & (m & inp)) :-> (m & inp)
_cl1 = IndigoState (m & inp) (n & (m & inp)) ()
-> MetaData (m & inp) -> GenCode (m & inp) (n & (m & inp)) ()
forall (inp :: [*]) (out :: [*]) a.
IndigoState inp out a -> MetaData inp -> GenCode inp out a
runIndigoState (ex1 -> IndigoState (m & inp) (ExprType ex1 & (m & inp)) ()
forall a (inp :: [*]).
ToExpr a =>
a -> IndigoState inp (ExprType a & inp) ()
compileToExpr ex1
e1) MetaData (m & inp)
md2 in
  ()
-> MetaData inp
-> (inp :-> inp)
-> (inp :-> inp)
-> GenCode inp inp ()
forall (inp :: [*]) (out :: [*]) a.
a
-> MetaData out
-> (inp :-> out)
-> (out :-> inp)
-> GenCode inp out a
GenCode () MetaData inp
md (inp :-> (m & inp)
cd2 (inp :-> (m & inp))
-> ((m & inp) :-> (n & (m & inp))) -> inp :-> (n & (m & inp))
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# (m & inp) :-> (n & (m & inp))
cd1 (inp :-> (n & (m & inp)))
-> ((n & (m & inp)) :-> inp) -> inp :-> inp
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# (n & (m & inp)) :-> inp
opCode) inp :-> inp
forall (s :: [*]). s :-> s
L.nop

unaryOpFlat
  :: forall n ex inp . (IsExpr ex n)
  => ex -> n & inp :-> inp -> IndigoState inp inp ()
unaryOpFlat :: ex -> ((n & inp) :-> inp) -> IndigoState inp inp ()
unaryOpFlat e :: ex
e opCode :: (n & inp) :-> inp
opCode = (MetaData inp -> GenCode inp inp ()) -> IndigoState inp inp ()
forall (inp :: [*]) (out :: [*]) a.
(MetaData inp -> GenCode inp out a) -> IndigoState inp out a
IndigoState ((MetaData inp -> GenCode inp inp ()) -> IndigoState inp inp ())
-> (MetaData inp -> GenCode inp inp ()) -> IndigoState inp inp ()
forall a b. (a -> b) -> a -> b
$ \md :: MetaData inp
md ->
  let cd :: inp :-> (n & inp)
cd = GenCode inp (n & inp) () -> inp :-> (n & inp)
forall (inp :: [*]) (out :: [*]) a.
GenCode inp out a -> inp :-> out
gcCode (GenCode inp (n & inp) () -> inp :-> (n & inp))
-> GenCode inp (n & inp) () -> inp :-> (n & inp)
forall a b. (a -> b) -> a -> b
$ IndigoState inp (n & inp) ()
-> MetaData inp -> GenCode inp (n & inp) ()
forall (inp :: [*]) (out :: [*]) a.
IndigoState inp out a -> MetaData inp -> GenCode inp out a
runIndigoState (ex -> IndigoState inp (ExprType ex & inp) ()
forall a (inp :: [*]).
ToExpr a =>
a -> IndigoState inp (ExprType a & inp) ()
compileToExpr ex
e) MetaData inp
md in
  ()
-> MetaData inp
-> (inp :-> inp)
-> (inp :-> inp)
-> GenCode inp inp ()
forall (inp :: [*]) (out :: [*]) a.
a
-> MetaData out
-> (inp :-> out)
-> (out :-> inp)
-> GenCode inp out a
GenCode () MetaData inp
md (inp :-> (n & inp)
cd (inp :-> (n & inp)) -> ((n & inp) :-> inp) -> inp :-> inp
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# (n & inp) :-> inp
opCode) inp :-> inp
forall (s :: [*]). s :-> s
L.nop

nullaryOpFlat :: inp :-> inp -> IndigoState inp inp ()
nullaryOpFlat :: (inp :-> inp) -> IndigoState inp inp ()
nullaryOpFlat lorentzInstr :: inp :-> inp
lorentzInstr = (MetaData inp -> GenCode inp inp ()) -> IndigoState inp inp ()
forall (inp :: [*]) (out :: [*]) a.
(MetaData inp -> GenCode inp out a) -> IndigoState inp out a
IndigoState ((MetaData inp -> GenCode inp inp ()) -> IndigoState inp inp ())
-> (MetaData inp -> GenCode inp inp ()) -> IndigoState inp inp ()
forall a b. (a -> b) -> a -> b
$ \md :: MetaData inp
md -> ()
-> MetaData inp
-> (inp :-> inp)
-> (inp :-> inp)
-> GenCode inp inp ()
forall (inp :: [*]) (out :: [*]) a.
a
-> MetaData out
-> (inp :-> out)
-> (out :-> inp)
-> GenCode inp out a
GenCode () MetaData inp
md inp :-> inp
lorentzInstr inp :-> inp
forall (s :: [*]). s :-> s
L.nop

compileToExpr :: ToExpr a => a -> IndigoState inp ((ExprType a) & inp) ()
compileToExpr :: a -> IndigoState inp (ExprType a & inp) ()
compileToExpr = Expr (ExprType a) -> IndigoState inp (ExprType a & inp) ()
forall a (inp :: [*]). Expr a -> IndigoState inp (a & inp) ()
compileExpr (Expr (ExprType a) -> IndigoState inp (ExprType a & inp) ())
-> (a -> Expr (ExprType a))
-> a
-> IndigoState inp (ExprType a & inp) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Expr (ExprType a)
forall a. ToExpr a => a -> Expr (ExprType a)
toExpr