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

-- | 'Expr' compilation

module Indigo.Internal.Expr.Compilation
  ( compileExpr

  , ObjManipulationRes (..)
  , runObjectManipulation
  , namedToExpr

  , 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 qualified Lorentz.StoreClass 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(..), NamedFieldObj(..), castFieldConstructors, namedToTypedRec, typedToNamedRec)
import Indigo.Internal.State
  (DecomposedObjects, GenCode(..), IndigoState(..), MetaData(..), replStkMd, usingIndigoState,
  withObject, withObjectState)
import Indigo.Internal.Var (Var(..), pushNoRef)
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) = (MetaData inp -> GenCode inp (a : inp))
-> IndigoState inp (a : inp)
forall (inp :: [*]) (out :: [*]).
(MetaData inp -> GenCode inp out) -> IndigoState inp out
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 -> StackVars (a : inp)
-> (inp :-> (a : inp))
-> ((a : inp) :-> inp)
-> GenCode inp (a : inp)
forall (inp :: [*]) (out :: [*]).
StackVars out -> (inp :-> out) -> (out :-> inp) -> GenCode inp out
GenCode (StackVars inp -> StackVars (a : inp)
forall a (inp :: [*]).
KnownValue a =>
StackVars inp -> StackVars (a : inp)
pushNoRef (StackVars inp -> StackVars (a : inp))
-> StackVars inp -> StackVars (a : inp)
forall a b. (a -> b) -> a -> b
$ MetaData inp -> StackVars inp
forall (inp :: [*]). MetaData inp -> StackVars inp
mdStack 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) = Var a
-> (Object a -> IndigoState inp (a : inp))
-> IndigoState inp (a : inp)
forall a (inp :: [*]) (out :: [*]).
KnownValue a =>
Var a -> (Object a -> IndigoState inp out) -> IndigoState inp out
withObjectState Var a
v ((Object a -> IndigoState inp (a : inp))
 -> IndigoState inp (a : inp))
-> (Object a -> IndigoState inp (a : inp))
-> IndigoState inp (a : inp)
forall a b. (a -> b) -> a -> b
$ (forall (name :: Symbol).
 NamedFieldObj a name -> Expr (GetFieldType a name))
-> Object 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 x (name :: Symbol).
NamedFieldObj x name -> Expr (GetFieldType x name)
forall (name :: Symbol).
NamedFieldObj a name -> Expr (GetFieldType a name)
namedToExpr
compileExpr (Update m :: Expr a
m key :: Expr (UpdOpKeyHs a)
key val :: Expr (UpdOpParamsHs a)
val) = Expr (UpdOpKeyHs a)
-> Expr (UpdOpParamsHs a)
-> Expr a
-> ((UpdOpKeyHs a : UpdOpParamsHs a : a : inp) :-> (a : inp))
-> IndigoState inp (a : inp)
forall res n m l (inp :: [*]).
KnownValue res =>
Expr n
-> Expr m
-> Expr l
-> ((n : m : l : inp) :-> (res : inp))
-> IndigoState inp (res : inp)
ternaryOp Expr (UpdOpKeyHs a)
key Expr (UpdOpParamsHs a)
val Expr a
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 :: Expr n
e1 e2 :: Expr m
e2) = Expr n
-> Expr m
-> ((n : m : inp) :-> (a : inp))
-> IndigoState inp (a : inp)
forall res n m (inp :: [*]).
KnownValue res =>
Expr n
-> Expr m
-> ((n : m : inp) :-> (res : inp))
-> IndigoState inp (res : inp)
binaryOp Expr n
e1 Expr m
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 :: Expr n
e1 e2 :: Expr m
e2) = Expr n
-> Expr m
-> ((n : m : inp) :-> (a : inp))
-> IndigoState inp (a : inp)
forall res n m (inp :: [*]).
KnownValue res =>
Expr n
-> Expr m
-> ((n : m : inp) :-> (res : inp))
-> IndigoState inp (res : inp)
binaryOp Expr n
e1 Expr m
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 :: Expr n
e1 e2 :: Expr m
e2) = Expr n
-> Expr m
-> ((n : m : inp) :-> (a : inp))
-> IndigoState inp (a : inp)
forall res n m (inp :: [*]).
KnownValue res =>
Expr n
-> Expr m
-> ((n : m : inp) :-> (res : inp))
-> IndigoState inp (res : inp)
binaryOp Expr n
e1 Expr m
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 :: Expr n
e1 e2 :: Expr m
e2) = Expr n
-> Expr m
-> ((n : m : inp) :-> (a : inp))
-> IndigoState inp (a : inp)
forall res n m (inp :: [*]).
KnownValue res =>
Expr n
-> Expr m
-> ((n : m : inp) :-> (res : inp))
-> IndigoState inp (res : inp)
binaryOp Expr n
e1 Expr m
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 :: Expr n
e1 e2 :: Expr m
e2) = Expr n
-> Expr m
-> ((n : m : inp) :-> (a : inp))
-> IndigoState inp (a : inp)
forall res n m (inp :: [*]).
KnownValue res =>
Expr n
-> Expr m
-> ((n : m : inp) :-> (res : inp))
-> IndigoState inp (res : inp)
binaryOp Expr n
e1 Expr m
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 :: Expr n
e) = Expr n -> ((n : inp) :-> (a : inp)) -> IndigoState inp (a : inp)
forall res n (inp :: [*]).
KnownValue res =>
Expr n
-> ((n : inp) :-> (res : inp)) -> IndigoState inp (res : inp)
unaryOp Expr n
e (n : inp) :-> (a : inp)
forall n (s :: [*]).
UnaryArithOpHs Abs n =>
(n : s) :-> (UnaryArithResHs Abs n : s)
L.abs
compileExpr (Neg e :: Expr n
e) = Expr n -> ((n : inp) :-> (a : inp)) -> IndigoState inp (a : inp)
forall res n (inp :: [*]).
KnownValue res =>
Expr n
-> ((n : inp) :-> (res : inp)) -> IndigoState inp (res : inp)
unaryOp Expr n
e (n : inp) :-> (a : inp)
forall n (s :: [*]).
UnaryArithOpHs Neg n =>
(n : s) :-> (UnaryArithResHs Neg n : s)
L.neg

compileExpr (Lsl e1 :: Expr n
e1 e2 :: Expr m
e2) = Expr n
-> Expr m
-> ((n : m : inp) :-> (a : inp))
-> IndigoState inp (a : inp)
forall res n m (inp :: [*]).
KnownValue res =>
Expr n
-> Expr m
-> ((n : m : inp) :-> (res : inp))
-> IndigoState inp (res : inp)
binaryOp Expr n
e1 Expr m
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 :: Expr n
e1 e2 :: Expr m
e2) = Expr n
-> Expr m
-> ((n : m : inp) :-> (a : inp))
-> IndigoState inp (a : inp)
forall res n m (inp :: [*]).
KnownValue res =>
Expr n
-> Expr m
-> ((n : m : inp) :-> (res : inp))
-> IndigoState inp (res : inp)
binaryOp Expr n
e1 Expr m
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 :: Expr n
e1 e2 :: Expr n
e2) = Expr n
-> Expr n
-> ((n : n : inp) :-> (Bool : inp))
-> IndigoState inp (Bool : inp)
forall res n m (inp :: [*]).
KnownValue res =>
Expr n
-> Expr m
-> ((n : m : inp) :-> (res : inp))
-> IndigoState inp (res : inp)
binaryOp Expr n
e1 Expr n
e2 (n : n : inp) :-> (Bool : inp)
forall n (s :: [*]). NiceComparable n => (n : n : s) :-> (Bool : s)
L.eq
compileExpr (Neq e1 :: Expr n
e1 e2 :: Expr n
e2) = Expr n
-> Expr n
-> ((n : n : inp) :-> (Bool : inp))
-> IndigoState inp (Bool : inp)
forall res n m (inp :: [*]).
KnownValue res =>
Expr n
-> Expr m
-> ((n : m : inp) :-> (res : inp))
-> IndigoState inp (res : inp)
binaryOp Expr n
e1 Expr n
e2 (n : n : inp) :-> (Bool : inp)
forall n (s :: [*]). NiceComparable n => (n : n : s) :-> (Bool : s)
L.neq
compileExpr (Lt e1 :: Expr n
e1 e2 :: Expr n
e2) = Expr n
-> Expr n
-> ((n : n : inp) :-> (Bool : inp))
-> IndigoState inp (Bool : inp)
forall res n m (inp :: [*]).
KnownValue res =>
Expr n
-> Expr m
-> ((n : m : inp) :-> (res : inp))
-> IndigoState inp (res : inp)
binaryOp Expr n
e1 Expr n
e2 (n : n : inp) :-> (Bool : inp)
forall n (s :: [*]). NiceComparable n => (n : n : s) :-> (Bool : s)
L.lt
compileExpr (Le e1 :: Expr n
e1 e2 :: Expr n
e2) = Expr n
-> Expr n
-> ((n : n : inp) :-> (Bool : inp))
-> IndigoState inp (Bool : inp)
forall res n m (inp :: [*]).
KnownValue res =>
Expr n
-> Expr m
-> ((n : m : inp) :-> (res : inp))
-> IndigoState inp (res : inp)
binaryOp Expr n
e1 Expr n
e2 (n : n : inp) :-> (Bool : inp)
forall n (s :: [*]). NiceComparable n => (n : n : s) :-> (Bool : s)
L.le
compileExpr (Gt e1 :: Expr n
e1 e2 :: Expr n
e2) = Expr n
-> Expr n
-> ((n : n : inp) :-> (Bool : inp))
-> IndigoState inp (Bool : inp)
forall res n m (inp :: [*]).
KnownValue res =>
Expr n
-> Expr m
-> ((n : m : inp) :-> (res : inp))
-> IndigoState inp (res : inp)
binaryOp Expr n
e1 Expr n
e2 (n : n : inp) :-> (Bool : inp)
forall n (s :: [*]). NiceComparable n => (n : n : s) :-> (Bool : s)
L.gt
compileExpr (Ge e1 :: Expr n
e1 e2 :: Expr n
e2) = Expr n
-> Expr n
-> ((n : n : inp) :-> (Bool : inp))
-> IndigoState inp (Bool : inp)
forall res n m (inp :: [*]).
KnownValue res =>
Expr n
-> Expr m
-> ((n : m : inp) :-> (res : inp))
-> IndigoState inp (res : inp)
binaryOp Expr n
e1 Expr n
e2 (n : n : inp) :-> (Bool : inp)
forall n (s :: [*]). NiceComparable n => (n : n : s) :-> (Bool : s)
L.ge
compileExpr (IsNat e :: Expr Integer
e) = Expr Integer
-> ((Integer : inp) :-> (Maybe Natural : inp))
-> IndigoState inp (Maybe Natural : inp)
forall res n (inp :: [*]).
KnownValue res =>
Expr n
-> ((n : inp) :-> (res : inp)) -> IndigoState inp (res : inp)
unaryOp Expr Integer
e (Integer : inp) :-> (Maybe Natural : inp)
forall (s :: [*]). (Integer : s) :-> (Maybe Natural : s)
L.isNat
compileExpr (Int' e :: Expr Natural
e) = Expr Natural
-> ((Natural : inp) :-> (Integer : inp))
-> IndigoState inp (Integer : inp)
forall res n (inp :: [*]).
KnownValue res =>
Expr n
-> ((n : inp) :-> (res : inp)) -> IndigoState inp (res : inp)
unaryOp Expr Natural
e (Natural : inp) :-> (Integer : inp)
forall (s :: [*]). (Natural : s) :-> (Integer : s)
L.int
compileExpr (Coerce e :: Expr a
e) = Expr a -> ((a : inp) :-> (a : inp)) -> IndigoState inp (a : inp)
forall res n (inp :: [*]).
KnownValue res =>
Expr n
-> ((n : inp) :-> (res : inp)) -> IndigoState inp (res : inp)
unaryOp Expr a
e (a : inp) :-> (a : inp)
forall a b (s :: [*]). Castable_ a b => (a : s) :-> (b : s)
checkedCoerce_
compileExpr (ForcedCoerce e :: Expr a
e) = Expr a -> ((a : inp) :-> (a : inp)) -> IndigoState inp (a : inp)
forall res n (inp :: [*]).
KnownValue res =>
Expr n
-> ((n : inp) :-> (res : inp)) -> IndigoState inp (res : inp)
unaryOp Expr a
e (a : inp) :-> (a : inp)
forall a b (s :: [*]).
MichelsonCoercible a b =>
(a : s) :-> (b : s)
forcedCoerce_
compileExpr (And e1 :: Expr n
e1 e2 :: Expr m
e2) = Expr n
-> Expr m
-> ((n : m : inp) :-> (a : inp))
-> IndigoState inp (a : inp)
forall res n m (inp :: [*]).
KnownValue res =>
Expr n
-> Expr m
-> ((n : m : inp) :-> (res : inp))
-> IndigoState inp (res : inp)
binaryOp Expr n
e1 Expr m
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 :: Expr n
e1 e2 :: Expr m
e2) = Expr n
-> Expr m
-> ((n : m : inp) :-> (a : inp))
-> IndigoState inp (a : inp)
forall res n m (inp :: [*]).
KnownValue res =>
Expr n
-> Expr m
-> ((n : m : inp) :-> (res : inp))
-> IndigoState inp (res : inp)
binaryOp Expr n
e1 Expr m
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 :: Expr n
e1 e2 :: Expr m
e2) = Expr n
-> Expr m
-> ((n : m : inp) :-> (a : inp))
-> IndigoState inp (a : inp)
forall res n m (inp :: [*]).
KnownValue res =>
Expr n
-> Expr m
-> ((n : m : inp) :-> (res : inp))
-> IndigoState inp (res : inp)
binaryOp Expr n
e1 Expr m
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 :: Expr n
e) = Expr n -> ((n : inp) :-> (a : inp)) -> IndigoState inp (a : inp)
forall res n (inp :: [*]).
KnownValue res =>
Expr n
-> ((n : inp) :-> (res : inp)) -> IndigoState inp (res : inp)
unaryOp Expr n
e (n : inp) :-> (a : inp)
forall n (s :: [*]).
UnaryArithOpHs Not n =>
(n : s) :-> (UnaryArithResHs Not n : s)
L.not

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

compileExpr (Some e :: Expr t
e) = Expr t
-> ((t : inp) :-> (Maybe t : inp))
-> IndigoState inp (Maybe t : inp)
forall res n (inp :: [*]).
KnownValue res =>
Expr n
-> ((n : inp) :-> (res : inp)) -> IndigoState inp (res : inp)
unaryOp Expr t
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 :: Expr x
e) = Expr x
-> ((x : inp) :-> (Either y x : inp))
-> IndigoState inp (Either y x : inp)
forall res n (inp :: [*]).
KnownValue res =>
Expr n
-> ((n : inp) :-> (res : inp)) -> IndigoState inp (res : inp)
unaryOp Expr x
e (x : inp) :-> (Either y x : inp)
forall a b (s :: [*]). KnownValue a => (b : s) :-> (Either a b : s)
L.right
compileExpr (Left' e :: Expr y
e) = Expr y
-> ((y : inp) :-> (Either y x : inp))
-> IndigoState inp (Either y x : inp)
forall res n (inp :: [*]).
KnownValue res =>
Expr n
-> ((n : inp) :-> (res : inp)) -> IndigoState inp (res : inp)
unaryOp Expr y
e (y : inp) :-> (Either y x : inp)
forall a b (s :: [*]). KnownValue b => (a : s) :-> (Either a b : s)
L.left
compileExpr (Pack e :: Expr a
e) = Expr a
-> ((a : inp) :-> (Packed a : inp))
-> IndigoState inp (Packed a : inp)
forall res n (inp :: [*]).
KnownValue res =>
Expr n
-> ((n : inp) :-> (res : inp)) -> IndigoState inp (res : inp)
unaryOp Expr a
e (a : inp) :-> (Packed a : inp)
forall a (s :: [*]).
NicePackedValue a =>
(a : s) :-> (Packed a : s)
L.pack
compileExpr (Unpack e :: Expr (Packed a)
e) = Expr (Packed a)
-> ((Packed a : inp) :-> (Maybe a : inp))
-> IndigoState inp (Maybe a : inp)
forall res n (inp :: [*]).
KnownValue res =>
Expr n
-> ((n : inp) :-> (res : inp)) -> IndigoState inp (res : inp)
unaryOp Expr (Packed a)
e (Packed a : inp) :-> (Maybe a : inp)
forall a (s :: [*]).
NiceUnpackedValue a =>
(Packed a : s) :-> (Maybe a : s)
L.unpack
compileExpr (PackRaw e :: Expr a
e) = Expr a
-> ((a : inp) :-> (ByteString : inp))
-> IndigoState inp (ByteString : inp)
forall res n (inp :: [*]).
KnownValue res =>
Expr n
-> ((n : inp) :-> (res : inp)) -> IndigoState inp (res : inp)
unaryOp Expr a
e (a : inp) :-> (ByteString : inp)
forall a (s :: [*]).
NicePackedValue a =>
(a : s) :-> (ByteString : s)
L.packRaw
compileExpr (UnpackRaw e :: Expr ByteString
e) = Expr ByteString
-> ((ByteString : inp) :-> (Maybe a : inp))
-> IndigoState inp (Maybe a : inp)
forall res n (inp :: [*]).
KnownValue res =>
Expr n
-> ((n : inp) :-> (res : inp)) -> IndigoState inp (res : inp)
unaryOp Expr ByteString
e (ByteString : inp) :-> (Maybe a : inp)
forall a (s :: [*]).
NiceUnpackedValue a =>
(ByteString : s) :-> (Maybe a : s)
L.unpackRaw
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 :: Expr a
e1 e2 :: Expr (List a)
e2) = Expr a
-> Expr (List a)
-> ((a : List a : inp) :-> (List a : inp))
-> IndigoState inp (List a : inp)
forall res n m (inp :: [*]).
KnownValue res =>
Expr n
-> Expr m
-> ((n : m : inp) :-> (res : inp))
-> IndigoState inp (res : inp)
binaryOp Expr a
e1 Expr (List a)
e2 (a : List a : inp) :-> (List a : inp)
forall a (s :: [*]). (a : List a : s) :-> (List a : s)
L.cons
compileExpr (Contract e :: Expr addr
e) = Expr addr
-> ((addr : inp) :-> (Maybe (ContractRef p) : inp))
-> IndigoState inp (Maybe (ContractRef p) : inp)
forall res n (inp :: [*]).
KnownValue res =>
Expr n
-> ((n : inp) :-> (res : inp)) -> IndigoState inp (res : inp)
unaryOp Expr addr
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 :: Expr (ContractRef p)
ec) = Expr (ContractRef p)
-> ((ContractRef p : inp) :-> (Address : inp))
-> IndigoState inp (Address : inp)
forall res n (inp :: [*]).
KnownValue res =>
Expr n
-> ((n : inp) :-> (res : inp)) -> IndigoState inp (res : inp)
unaryOp Expr (ContractRef p)
ec (ContractRef p : inp) :-> (Address : inp)
forall a (s :: [*]). (ContractRef a : s) :-> (Address : s)
L.address
compileExpr (ContractCallingUnsafe epName :: EpName
epName addr :: Expr Address
addr) = Expr Address
-> ((Address : inp) :-> (Maybe (ContractRef arg) : inp))
-> IndigoState inp (Maybe (ContractRef arg) : inp)
forall res n (inp :: [*]).
KnownValue res =>
Expr n
-> ((n : inp) :-> (res : inp)) -> IndigoState inp (res : inp)
unaryOp Expr Address
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 :: Expr (FutureContract p)
con) = Expr (FutureContract p)
-> ((FutureContract p : inp) :-> (Maybe (ContractRef p) : inp))
-> IndigoState inp (Maybe (ContractRef p) : inp)
forall res n (inp :: [*]).
KnownValue res =>
Expr n
-> ((n : inp) :-> (res : inp)) -> IndigoState inp (res : inp)
unaryOp Expr (FutureContract p)
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 :: Expr EpAddress
epAddr) = Expr EpAddress
-> ((EpAddress : inp) :-> (Maybe (ContractRef p) : inp))
-> IndigoState inp (Maybe (ContractRef p) : inp)
forall res n (inp :: [*]).
KnownValue res =>
Expr n
-> ((n : inp) :-> (res : inp)) -> IndigoState inp (res : inp)
unaryOp Expr EpAddress
epAddr (EpAddress : inp) :-> (Maybe (ContractRef p) : inp)
forall p (s :: [*]).
NiceParameter p =>
(EpAddress : s) :-> (Maybe (ContractRef p) : s)
L.epAddressToContract
compileExpr (MakeView e1 :: Expr a
e1 e2 :: Expr (ContractRef r)
e2) = Expr a
-> Expr (ContractRef r)
-> ((a : ContractRef r : inp) :-> (View a r : inp))
-> IndigoState inp (View a r : inp)
forall res n m (inp :: [*]).
KnownValue res =>
Expr n
-> Expr m
-> ((n : m : inp) :-> (res : inp))
-> IndigoState inp (res : inp)
binaryOp Expr a
e1 Expr (ContractRef r)
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 :: Expr a
e1 e2 :: Expr (Lambda b b)
e2) = Expr a
-> Expr (Lambda b b)
-> ((a : Lambda b b : inp) :-> (Void_ a b : inp))
-> IndigoState inp (Void_ a b : inp)
forall res n m (inp :: [*]).
KnownValue res =>
Expr n
-> Expr m
-> ((n : m : inp) :-> (res : inp))
-> IndigoState inp (res : inp)
binaryOp Expr a
e1 Expr (Lambda b b)
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 :: Expr (MemOpKeyHs c)
k c :: Expr c
c) = Expr (MemOpKeyHs c)
-> Expr c
-> ((MemOpKeyHs c : c : inp) :-> (Bool : inp))
-> IndigoState inp (Bool : inp)
forall res n m (inp :: [*]).
KnownValue res =>
Expr n
-> Expr m
-> ((n : m : inp) :-> (res : inp))
-> IndigoState inp (res : inp)
binaryOp Expr (MemOpKeyHs c)
k Expr c
c (MemOpKeyHs c : c : inp) :-> (Bool : inp)
forall c (s :: [*]).
MemOpHs c =>
(MemOpKeyHs c : c : s) :-> (Bool : s)
L.mem
compileExpr (Size s :: Expr c
s) = Expr c
-> ((c : inp) :-> (Natural : inp))
-> IndigoState inp (Natural : inp)
forall res n (inp :: [*]).
KnownValue res =>
Expr n
-> ((n : inp) :-> (res : inp)) -> IndigoState inp (res : inp)
unaryOp Expr c
s (c : inp) :-> (Natural : inp)
forall c (s :: [*]). SizeOpHs c => (c : s) :-> (Natural : s)
L.size

compileExpr (StInsertNew l :: Label name
l err :: err
err k :: Expr key
k v :: Expr value
v store :: Expr a
store) =
  Expr key
-> Expr value
-> Expr a
-> ((key : value : a : inp) :-> (a : inp))
-> IndigoState inp (a : inp)
forall res n m l (inp :: [*]).
KnownValue res =>
Expr n
-> Expr m
-> Expr l
-> ((n : m : l : inp) :-> (res : inp))
-> IndigoState inp (res : inp)
ternaryOp Expr key
k Expr value
v Expr a
store (((key : value : a : inp) :-> (a : inp))
 -> IndigoState inp (a : inp))
-> ((key : value : a : inp) :-> (a : inp))
-> IndigoState inp (a : inp)
forall a b. (a -> b) -> a -> b
$ Label name
-> (forall (s0 :: [*]) (any :: [*]). (key : s0) :-> any)
-> (key : value : a : inp) :-> (a : inp)
forall store (mname :: Symbol) key value (s :: [*]).
StoreHasSubmap store mname key value =>
Label mname
-> (forall (s0 :: [*]) (any :: [*]). (key : s0) :-> any)
-> (key : value : store : s) :-> (store : s)
L.stInsertNew Label name
l (err -> (key : s0) :-> any
forall e (s :: [*]) (t :: [*]). IsError e => e -> s :-> t
failUsing err
err)
compileExpr (StInsert l :: Label name
l k :: Expr key
k v :: Expr value
v store :: Expr a
store) =
  Expr key
-> Expr value
-> Expr a
-> ((key : value : a : inp) :-> (a : inp))
-> IndigoState inp (a : inp)
forall res n m l (inp :: [*]).
KnownValue res =>
Expr n
-> Expr m
-> Expr l
-> ((n : m : l : inp) :-> (res : inp))
-> IndigoState inp (res : inp)
ternaryOp Expr key
k Expr value
v Expr a
store (((key : value : a : inp) :-> (a : inp))
 -> IndigoState inp (a : inp))
-> ((key : value : a : inp) :-> (a : inp))
-> IndigoState inp (a : inp)
forall a b. (a -> b) -> a -> b
$ Label name -> (key : value : a : inp) :-> (a : inp)
forall store (mname :: Symbol) key value (s :: [*]).
StoreHasSubmap store mname key value =>
Label mname -> (key : value : store : s) :-> (store : s)
L.stInsert Label name
l
compileExpr (StGet l :: Label name
l ekey :: Expr key
ekey estore :: Expr store
estore) = Expr key
-> Expr store
-> ((key : store : inp) :-> (Maybe value : inp))
-> IndigoState inp (Maybe value : inp)
forall res n m (inp :: [*]).
KnownValue res =>
Expr n
-> Expr m
-> ((n : m : inp) :-> (res : inp))
-> IndigoState inp (res : inp)
binaryOp Expr key
ekey Expr store
estore (Label name -> (key : store : inp) :-> (Maybe value : inp)
forall store (mname :: Symbol) key value (s :: [*]).
(StoreHasSubmap store mname key value, KnownValue value) =>
Label mname -> (key : store : s) :-> (Maybe value : s)
L.stGet Label name
l)
compileExpr (StMem l :: Label name
l ekey :: Expr key
ekey estore :: Expr store
estore) = Expr key
-> Expr store
-> ((key : store : inp) :-> (Bool : inp))
-> IndigoState inp (Bool : inp)
forall res n m (inp :: [*]).
KnownValue res =>
Expr n
-> Expr m
-> ((n : m : inp) :-> (res : inp))
-> IndigoState inp (res : inp)
binaryOp Expr key
ekey Expr store
estore (Label name -> (key : store : inp) :-> (Bool : inp)
forall store (mname :: Symbol) key value (s :: [*]).
StoreHasSubmap store mname key value =>
Label mname -> (key : store : s) :-> (Bool : s)
L.stMem Label name
l)
compileExpr (StUpdate l :: Label name
l ekey :: Expr key
ekey evalue :: Expr (Maybe val)
evalue estore :: Expr a
estore) = Expr key
-> Expr (Maybe val)
-> Expr a
-> ((key : Maybe val : a : inp) :-> (a : inp))
-> IndigoState inp (a : inp)
forall res n m l (inp :: [*]).
KnownValue res =>
Expr n
-> Expr m
-> Expr l
-> ((n : m : l : inp) :-> (res : inp))
-> IndigoState inp (res : inp)
ternaryOp Expr key
ekey Expr (Maybe val)
evalue Expr a
estore (Label name -> (key : Maybe val : a : inp) :-> (a : inp)
forall store (mname :: Symbol) key value (s :: [*]).
StoreHasSubmap store mname key value =>
Label mname -> (key : Maybe value : store : s) :-> (store : s)
L.stUpdate Label name
l)
compileExpr (StDelete l :: Label name
l ekey :: Expr key
ekey estore :: Expr a
estore) = Expr key
-> Expr a
-> ((key : a : inp) :-> (a : inp))
-> IndigoState inp (a : inp)
forall res n m (inp :: [*]).
KnownValue res =>
Expr n
-> Expr m
-> ((n : m : inp) :-> (res : inp))
-> IndigoState inp (res : inp)
binaryOp Expr key
ekey Expr a
estore (Label name -> (key : a : inp) :-> (a : inp)
forall store (mname :: Symbol) key value (s :: [*]).
StoreHasSubmap store mname key value =>
Label mname -> (key : store : s) :-> (store : s)
L.stDelete Label name
l)

compileExpr (Wrap l :: Label name
l exFld :: Expr (CtorOnlyField name a)
exFld) = Expr (CtorOnlyField name a)
-> ((CtorOnlyField name a : inp) :-> (a : inp))
-> IndigoState inp (a : inp)
forall res n (inp :: [*]).
KnownValue res =>
Expr n
-> ((n : inp) :-> (res : inp)) -> IndigoState inp (res : inp)
unaryOp Expr (CtorOnlyField name a)
exFld (((CtorOnlyField name a : inp) :-> (a : inp))
 -> IndigoState inp (a : inp))
-> ((CtorOnlyField name a : inp) :-> (a : inp))
-> IndigoState inp (a : inp)
forall a b. (a -> b) -> a -> b
$ Label name -> (CtorOnlyField name a : inp) :-> (a : inp)
forall dt (name :: Symbol) (st :: [*]).
InstrWrapOneC dt name =>
Label name -> (CtorOnlyField name dt : st) :-> (dt : st)
L.wrapOne Label name
l
compileExpr (Unwrap l :: Label name
l exDt :: Expr dt
exDt) = Expr dt -> ((dt : inp) :-> (a : inp)) -> IndigoState inp (a : inp)
forall res n (inp :: [*]).
KnownValue res =>
Expr n
-> ((n : inp) :-> (res : inp)) -> IndigoState inp (res : inp)
unaryOp Expr dt
exDt (((dt : inp) :-> (a : inp)) -> IndigoState inp (a : inp))
-> ((dt : inp) :-> (a : inp)) -> IndigoState inp (a : inp)
forall a b. (a -> b) -> a -> b
$ Label name -> (dt : inp) :-> (CtorOnlyField name dt : inp)
forall dt (name :: Symbol) (st :: [*]).
InstrUnwrapC dt name =>
Label name -> (dt : st) :-> (CtorOnlyField name dt : st)
L.unwrapUnsafe_ 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 :: [*]).
(MetaData inp -> GenCode inp out) -> IndigoState inp out
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 :: [*]). GenCode inp out -> 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 :: [*]).
IndigoState inp out -> MetaData inp -> GenCode inp out
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
  StackVars (a : inp)
-> (inp :-> (a : inp))
-> ((a : inp) :-> inp)
-> GenCode inp (a : inp)
forall (inp :: [*]) (out :: [*]).
StackVars out -> (inp :-> out) -> (out :-> inp) -> GenCode inp out
GenCode (StackVars inp -> StackVars (a : inp)
forall a (inp :: [*]).
KnownValue a =>
StackVars inp -> StackVars (a : inp)
pushNoRef (StackVars inp -> StackVars (a : inp))
-> StackVars inp -> StackVars (a : inp)
forall a b. (a -> b) -> a -> b
$ MetaData inp -> StackVars inp
forall (inp :: [*]). MetaData inp -> StackVars inp
mdStack 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 :: [*]).
(MetaData inp -> GenCode inp out) -> IndigoState inp out
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 :: [*]). GenCode inp out -> 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 :: [*]).
MetaData inp -> IndigoState inp out -> GenCode inp out
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 StackVars (a : inp)
-> (inp :-> (a : inp))
-> ((a : inp) :-> inp)
-> GenCode inp (a : inp)
forall (inp :: [*]) (out :: [*]).
StackVars out -> (inp :-> out) -> (out :-> inp) -> GenCode inp out
GenCode (StackVars inp -> StackVars (a : inp)
forall a (inp :: [*]).
KnownValue a =>
StackVars inp -> StackVars (a : inp)
pushNoRef (StackVars inp -> StackVars (a : inp))
-> StackVars inp -> StackVars (a : inp)
forall a b. (a -> b) -> a -> b
$ MetaData inp -> StackVars inp
forall (inp :: [*]). MetaData inp -> StackVars inp
mdStack 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 l :: Label name
l e :: Expr t
e) = Expr t
-> ((t : inp) :-> (NamedF Identity t name : inp))
-> IndigoState inp (NamedF Identity t name : inp)
forall res n (inp :: [*]).
KnownValue res =>
Expr n
-> ((n : inp) :-> (res : inp)) -> IndigoState inp (res : inp)
unaryOp Expr t
e (Label name -> (t : inp) :-> (NamedF Identity t name : inp)
forall (name :: Symbol) a (s :: [*]).
Label name -> (a : s) :-> (NamedF Identity a name : s)
toNamed Label name
l)
compileExpr (UnName l :: Label name
l e :: Expr (name :! a)
e) = Expr (name :! a)
-> (((name :! a) : inp) :-> (a : inp)) -> IndigoState inp (a : inp)
forall res n (inp :: [*]).
KnownValue res =>
Expr n
-> ((n : inp) :-> (res : inp)) -> IndigoState inp (res : inp)
unaryOp Expr (name :! a)
e (Label name -> ((name :! a) : inp) :-> (a : inp)
forall (name :: Symbol) a (s :: [*]).
Label name -> (NamedF Identity a name : s) :-> (a : s)
fromNamed Label name
l)

compileExpr (Slice ex1 :: Expr Natural
ex1 ex2 :: Expr Natural
ex2 ex3 :: Expr c
ex3) = Expr Natural
-> Expr Natural
-> Expr c
-> ((Natural : Natural : c : inp) :-> (Maybe c : inp))
-> IndigoState inp (Maybe c : inp)
forall res n m l (inp :: [*]).
KnownValue res =>
Expr n
-> Expr m
-> Expr l
-> ((n : m : l : inp) :-> (res : inp))
-> IndigoState inp (res : inp)
ternaryOp Expr Natural
ex1 Expr Natural
ex2 Expr c
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 :: Expr a
ex) = Expr a -> ((a : inp) :-> (a : inp)) -> IndigoState inp (a : inp)
forall res n (inp :: [*]).
KnownValue res =>
Expr n
-> ((n : inp) :-> (res : inp)) -> IndigoState inp (res : inp)
unaryOp Expr a
ex (a : inp) :-> (a : inp)
forall a (s :: [*]). KnownValue a => (a : s) :-> (a : s)
L.cast
compileExpr (Concat ex1 :: Expr a
ex1 ex2 :: Expr a
ex2) = Expr a
-> Expr a
-> ((a : a : inp) :-> (a : inp))
-> IndigoState inp (a : inp)
forall res n m (inp :: [*]).
KnownValue res =>
Expr n
-> Expr m
-> ((n : m : inp) :-> (res : inp))
-> IndigoState inp (res : inp)
binaryOp Expr a
ex1 Expr a
ex2 (a : a : inp) :-> (a : inp)
forall c (s :: [*]). ConcatOpHs c => (c : c : s) :-> (c : s)
L.concat
compileExpr (Concat' ex :: Expr (List a)
ex) = Expr (List a)
-> ((List a : inp) :-> (a : inp)) -> IndigoState inp (a : inp)
forall res n (inp :: [*]).
KnownValue res =>
Expr n
-> ((n : inp) :-> (res : inp)) -> IndigoState inp (res : inp)
unaryOp Expr (List a)
ex (List a : inp) :-> (a : inp)
forall c (s :: [*]). ConcatOpHs c => (List c : s) :-> (c : s)
L.concat'

compileExpr (ImplicitAccount kh :: Expr KeyHash
kh) = Expr KeyHash
-> ((KeyHash : inp) :-> (ContractRef () : inp))
-> IndigoState inp (ContractRef () : inp)
forall res n (inp :: [*]).
KnownValue res =>
Expr n
-> ((n : inp) :-> (res : inp)) -> IndigoState inp (res : inp)
unaryOp Expr KeyHash
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 :: Expr PublicKey
pk sig :: Expr (TSignature bs)
sig bs :: Expr bs
bs) = Expr PublicKey
-> Expr (TSignature bs)
-> Expr bs
-> ((PublicKey : TSignature bs : bs : inp) :-> (Bool : inp))
-> IndigoState inp (Bool : inp)
forall res n m l (inp :: [*]).
KnownValue res =>
Expr n
-> Expr m
-> Expr l
-> ((n : m : l : inp) :-> (res : inp))
-> IndigoState inp (res : inp)
ternaryOp Expr PublicKey
pk Expr (TSignature bs)
sig Expr bs
bs (PublicKey : TSignature bs : bs : inp) :-> (Bool : inp)
forall bs (s :: [*]).
BytesLike bs =>
(PublicKey : TSignature bs : bs : s) :-> (Bool : s)
L.checkSignature
compileExpr (Sha256 c :: Expr bs
c) = Expr bs
-> ((bs : inp) :-> (Hash Sha256 bs : inp))
-> IndigoState inp (Hash Sha256 bs : inp)
forall res n (inp :: [*]).
KnownValue res =>
Expr n
-> ((n : inp) :-> (res : inp)) -> IndigoState inp (res : inp)
unaryOp Expr bs
c (bs : inp) :-> (Hash Sha256 bs : inp)
forall bs (s :: [*]).
BytesLike bs =>
(bs : s) :-> (Hash Sha256 bs : s)
L.sha256
compileExpr (Sha512 c :: Expr bs
c) = Expr bs
-> ((bs : inp) :-> (Hash Sha512 bs : inp))
-> IndigoState inp (Hash Sha512 bs : inp)
forall res n (inp :: [*]).
KnownValue res =>
Expr n
-> ((n : inp) :-> (res : inp)) -> IndigoState inp (res : inp)
unaryOp Expr bs
c (bs : inp) :-> (Hash Sha512 bs : inp)
forall bs (s :: [*]).
BytesLike bs =>
(bs : s) :-> (Hash Sha512 bs : s)
L.sha512
compileExpr (Blake2b c :: Expr bs
c) = Expr bs
-> ((bs : inp) :-> (Hash Blake2b bs : inp))
-> IndigoState inp (Hash Blake2b bs : inp)
forall res n (inp :: [*]).
KnownValue res =>
Expr n
-> ((n : inp) :-> (res : inp)) -> IndigoState inp (res : inp)
unaryOp Expr bs
c (bs : inp) :-> (Hash Blake2b bs : inp)
forall bs (s :: [*]).
BytesLike bs =>
(bs : s) :-> (Hash Blake2b bs : s)
L.blake2B
compileExpr (HashKey hk :: Expr PublicKey
hk) = Expr PublicKey
-> ((PublicKey : inp) :-> (KeyHash : inp))
-> IndigoState inp (KeyHash : inp)
forall res n (inp :: [*]).
KnownValue res =>
Expr n
-> ((n : inp) :-> (res : inp)) -> IndigoState inp (res : inp)
unaryOp Expr PublicKey
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 :: Expr (GetOpKeyHs c)
k m :: Expr c
m) = Expr (GetOpKeyHs c)
-> Expr c
-> ((GetOpKeyHs c : c : inp) :-> (a : inp))
-> IndigoState inp (a : inp)
forall res n m (inp :: [*]).
KnownValue res =>
Expr n
-> Expr m
-> ((n : m : inp) :-> (res : inp))
-> IndigoState inp (res : inp)
binaryOp Expr (GetOpKeyHs c)
k Expr c
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 :: Expr a
inp lambda :: Expr (Lambda a a)
lambda) = Expr a
-> Expr (Lambda a a)
-> ((a : Lambda a a : inp) :-> (a : inp))
-> IndigoState inp (a : inp)
forall res n m (inp :: [*]).
KnownValue res =>
Expr n
-> Expr m
-> ((n : m : inp) :-> (res : inp))
-> IndigoState inp (res : inp)
binaryOp Expr a
inp Expr (Lambda a a)
lambda (a : Lambda a a : inp) :-> (a : inp)
forall a b (s :: [*]). (a : Lambda a b : s) :-> (b : s)
L.exec
compileExpr (NonZero e :: Expr n
e) = Expr n
-> ((n : inp) :-> (Maybe n : inp))
-> IndigoState inp (Maybe n : inp)
forall res n (inp :: [*]).
KnownValue res =>
Expr n
-> ((n : inp) :-> (res : inp)) -> IndigoState inp (res : inp)
unaryOp Expr n
e (n : inp) :-> (Maybe n : inp)
forall t (s :: [*]). NonZero t => (t : s) :-> (Maybe t : s)
L.nonZero

--------------------------------------------
-- Object manipulation: set, get fields
--------------------------------------------

-- | Compile 'ObjectManipulation' datatype to a cell on the stack.
-- This function leverages 'ObjManipulationRes' to put off actual field compilation.
compileObjectManipulation :: ObjectManipulation a -> IndigoState inp (a : inp)
compileObjectManipulation :: ObjectManipulation a -> IndigoState inp (a : inp)
compileObjectManipulation fa :: ObjectManipulation a
fa = (MetaData inp -> GenCode inp (a : inp))
-> IndigoState inp (a : inp)
forall (inp :: [*]) (out :: [*]).
(MetaData inp -> GenCode inp out) -> IndigoState inp out
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 -> case DecomposedObjects
-> ObjectManipulation a -> ObjManipulationRes inp a
forall x (inp :: [*]).
DecomposedObjects
-> ObjectManipulation x -> ObjManipulationRes inp x
runObjectManipulation (MetaData inp -> DecomposedObjects
forall (inp :: [*]). MetaData inp -> DecomposedObjects
mdObjects MetaData inp
md) ObjectManipulation a
fa of
  StillObject composite :: ObjectExpr a
composite -> MetaData inp -> IndigoState inp (a : inp) -> GenCode inp (a : inp)
forall (inp :: [*]) (out :: [*]).
MetaData inp -> IndigoState inp out -> GenCode inp out
usingIndigoState MetaData inp
md (IndigoState inp (a : inp) -> GenCode inp (a : inp))
-> IndigoState inp (a : inp) -> GenCode inp (a : inp)
forall a b. (a -> b) -> a -> b
$ (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 computation :: IndigoState inp (a : inp)
computation   -> MetaData inp -> IndigoState inp (a : inp) -> GenCode inp (a : inp)
forall (inp :: [*]) (out :: [*]).
MetaData inp -> IndigoState inp out -> GenCode inp out
usingIndigoState MetaData inp
md IndigoState inp (a : inp)
computation

namedToExpr :: NamedFieldObj x name -> Expr (GetFieldType x name)
namedToExpr :: NamedFieldObj x name -> Expr (GetFieldType x name)
namedToExpr (NamedFieldObj flObj :: Object (GetFieldType x name)
flObj) = (forall (name :: Symbol).
 NamedFieldObj (GetFieldType x name) name
 -> Expr (GetFieldType (GetFieldType x name) name))
-> Object (GetFieldType x name) -> Expr (GetFieldType x name)
forall a (f :: Symbol -> *).
(forall (name :: Symbol). f name -> Expr (GetFieldType a name))
-> IndigoObjectF f a -> Expr a
objToExpr forall x (name :: Symbol).
NamedFieldObj x name -> Expr (GetFieldType x name)
forall (name :: Symbol).
NamedFieldObj (GetFieldType x name) name
-> Expr (GetFieldType (GetFieldType x name) name)
namedToExpr Object (GetFieldType x name)
flObj

-- | Convert arbitrary 'IndigoObjectF' into 'Expr'
-- with respect to given 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 k (a :: k). RefId -> Var a
Var @a RefId
refId)
objToExpr convExpr :: forall (name :: Symbol). f name -> Expr (GetFieldType a name)
convExpr (Decomposed fields :: Rec f (ConstructorFieldNames a)
fields) =
  Proxy a -> Rec Expr (FieldTypes a) -> Expr a
forall dt.
ComplexObjectC dt =>
Proxy dt -> Rec Expr (FieldTypes dt) -> Expr dt
ConstructWithoutNamed (Proxy a
forall k (t :: k). Proxy t
Proxy @a) ((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,
-- with respect to given function that 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) = (MetaData inp -> GenCode inp (a : inp))
-> IndigoState inp (a : inp)
forall (inp :: [*]) (out :: [*]).
(MetaData inp -> GenCode inp out) -> IndigoState inp out
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
$ \(MetaData inp -> StackVars inp
forall (inp :: [*]). MetaData inp -> StackVars inp
mdStack -> StackVars inp
s) ->
  StackVars (a : inp)
-> (inp :-> (a : inp))
-> ((a : inp) :-> inp)
-> GenCode inp (a : inp)
forall (inp :: [*]) (out :: [*]).
StackVars out -> (inp :-> out) -> (out :-> inp) -> GenCode inp out
GenCode (StackVars inp -> StackVars (a : inp)
forall a (inp :: [*]).
KnownValue a =>
StackVars inp -> StackVars (a : inp)
pushNoRef StackVars inp
s) (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

-- | '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 basically it either goes deeper to an inner field or generates Lorentz code.
runObjectManipulation :: DecomposedObjects -> ObjectManipulation x -> ObjManipulationRes inp x
runObjectManipulation :: DecomposedObjects
-> ObjectManipulation x -> ObjManipulationRes inp x
runObjectManipulation objs :: DecomposedObjects
objs (Object e :: Expr x
e) = DecomposedObjects -> Expr x -> ObjManipulationRes inp x
forall x (inp :: [*]).
DecomposedObjects -> Expr x -> ObjManipulationRes inp x
exprToManRes DecomposedObjects
objs Expr x
e

runObjectManipulation objs :: DecomposedObjects
objs (ToField (ObjectManipulation dt
v :: ObjectManipulation dt) (Label fname
targetLb :: Label fname)) =
  case DecomposedObjects
-> ObjectManipulation dt -> ObjManipulationRes inp dt
forall x (inp :: [*]).
DecomposedObjects
-> ObjectManipulation x -> ObjManipulationRes inp x
runObjectManipulation DecomposedObjects
objs 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 _ -> DecomposedObjects -> Expr x -> ObjManipulationRes inp x
forall x (inp :: [*]).
DecomposedObjects -> Expr x -> ObjManipulationRes inp x
exprToManRes DecomposedObjects
objs (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
          DecomposedObjects
-> ObjectManipulation x -> ObjManipulationRes inp x
forall x (inp :: [*]).
DecomposedObjects
-> ObjectManipulation x -> ObjManipulationRes inp x
runObjectManipulation DecomposedObjects
objs (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 res n (inp :: [*]).
KnownValue res =>
Expr n
-> ((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 k (a :: k). RefId -> Var a
Var 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 :: [*]).
(MetaData inp -> GenCode inp out) -> IndigoState inp out
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
$ \mdI :: MetaData inp
mdI ->
      let cd :: inp :-> (dt : inp)
cd = GenCode inp (dt : inp) -> inp :-> (dt : inp)
forall (inp :: [*]) (out :: [*]). GenCode inp out -> inp :-> out
gcCode (GenCode inp (dt : inp) -> inp :-> (dt : inp))
-> GenCode inp (dt : inp) -> inp :-> (dt : inp)
forall a b. (a -> b) -> a -> b
$ MetaData inp
-> IndigoState inp (dt : inp) -> GenCode inp (dt : inp)
forall (inp :: [*]) (out :: [*]).
MetaData inp -> IndigoState inp out -> GenCode inp out
usingIndigoState MetaData inp
mdI IndigoState inp (dt : inp)
compLHS in
      StackVars (x : inp)
-> (inp :-> (x : inp))
-> ((x : inp) :-> inp)
-> GenCode inp (x : inp)
forall (inp :: [*]) (out :: [*]).
StackVars out -> (inp :-> out) -> (out :-> inp) -> GenCode inp out
GenCode (StackVars inp -> StackVars (x : inp)
forall a (inp :: [*]).
KnownValue a =>
StackVars inp -> StackVars (a : inp)
pushNoRef (StackVars inp -> StackVars (x : inp))
-> StackVars inp -> StackVars (x : inp)
forall a b. (a -> b) -> a -> b
$ MetaData inp -> StackVars inp
forall (inp :: [*]). MetaData inp -> StackVars inp
mdStack MetaData inp
mdI) (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 objs :: DecomposedObjects
objs (SetField (ObjectManipulation x
ev :: ObjectManipulation dt) (Label fname
targetLb :: Label fname) ef :: Expr ftype
ef) =
  case DecomposedObjects
-> ObjectManipulation x -> ObjManipulationRes inp x
forall x (inp :: [*]).
DecomposedObjects
-> ObjectManipulation x -> ObjManipulationRes inp x
runObjectManipulation DecomposedObjects
objs 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 DecomposedObjects
-> ObjectManipulation (GetFieldType x fname)
-> ObjManipulationRes (x : inp) (GetFieldType x fname)
forall x (inp :: [*]).
DecomposedObjects
-> ObjectManipulation x -> ObjManipulationRes inp x
runObjectManipulation DecomposedObjects
objs (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 an 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 res n m (inp :: [*]).
KnownValue res =>
Expr n
-> Expr m
-> ((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 k (a :: k). RefId -> Var a
Var 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 :: [*]).
(MetaData inp -> GenCode inp out) -> IndigoState inp out
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
$ \mdI :: MetaData inp
mdI ->
      let GenCode st1 :: StackVars (x : inp)
st1 cdObj :: inp :-> (x : inp)
cdObj _cl1 :: (x : inp) :-> inp
_cl1 = IndigoState inp (x : inp) -> MetaData inp -> GenCode inp (x : inp)
forall (inp :: [*]) (out :: [*]).
IndigoState inp out -> MetaData inp -> GenCode inp out
runIndigoState IndigoState inp (x : inp)
lhs MetaData inp
mdI in
      let GenCode _st2 :: StackVars (fld : x : inp)
_st2 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 :: [*]).
IndigoState inp out -> MetaData inp -> GenCode inp out
runIndigoState IndigoState (x : inp) (fld : x : inp)
rhs (MetaData inp -> StackVars (x : inp) -> MetaData (x : inp)
forall (inp :: [*]) (inp1 :: [*]).
MetaData inp -> StackVars inp1 -> MetaData inp1
replStkMd MetaData inp
mdI StackVars (x : inp)
st1) in
      StackVars (x : inp)
-> (inp :-> (x : inp))
-> ((x : inp) :-> inp)
-> GenCode inp (x : inp)
forall (inp :: [*]) (out :: [*]).
StackVars out -> (inp :-> out) -> (out :-> inp) -> GenCode inp out
GenCode (StackVars inp -> StackVars (x : inp)
forall a (inp :: [*]).
KnownValue a =>
StackVars inp -> StackVars (a : inp)
pushNoRef (StackVars inp -> StackVars (x : inp))
-> StackVars inp -> StackVars (x : inp)
forall a b. (a -> b) -> a -> b
$ MetaData inp -> StackVars inp
forall (inp :: [*]). MetaData inp -> StackVars inp
mdStack MetaData inp
mdI) (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 . DecomposedObjects -> Expr x -> ObjManipulationRes inp x
exprToManRes :: DecomposedObjects -> Expr x -> ObjManipulationRes inp x
exprToManRes objs :: DecomposedObjects
objs (ObjMan objMan :: ObjectManipulation x
objMan) = DecomposedObjects
-> ObjectManipulation x -> ObjManipulationRes inp x
forall x (inp :: [*]).
DecomposedObjects
-> ObjectManipulation x -> ObjManipulationRes inp x
runObjectManipulation DecomposedObjects
objs 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 objs :: DecomposedObjects
objs (V var :: Var x
var) = DecomposedObjects
-> Var x
-> (Object x -> ObjManipulationRes inp x)
-> ObjManipulationRes inp x
forall a r.
KnownValue a =>
DecomposedObjects -> Var a -> (Object a -> r) -> r
withObject DecomposedObjects
objs Var x
var ((Object x -> ObjManipulationRes inp x)
 -> ObjManipulationRes inp x)
-> (Object x -> ObjManipulationRes inp x)
-> ObjManipulationRes inp x
forall a b. (a -> b) -> a -> b
$ \case
  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
  Decomposed fields :: Rec (NamedFieldObj 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). NamedFieldObj x x -> NamedFieldExpr x x)
-> Rec (NamedFieldObj 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 (Expr (LnrFieldType (LNRequireFound x x (GLookupNamed x (Rep x))))
-> NamedFieldExpr x x
forall a (name :: Symbol).
Expr (GetFieldType a name) -> NamedFieldExpr a name
NamedFieldExpr (Expr (LnrFieldType (LNRequireFound x x (GLookupNamed x (Rep x))))
 -> NamedFieldExpr x x)
-> (NamedFieldObj x x
    -> Expr
         (LnrFieldType (LNRequireFound x x (GLookupNamed x (Rep x)))))
-> NamedFieldObj x x
-> NamedFieldExpr x x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NamedFieldObj x x
-> Expr
     (LnrFieldType (LNRequireFound x x (GLookupNamed x (Rep x))))
forall x (name :: Symbol).
NamedFieldObj x name -> Expr (GetFieldType x name)
namedToExpr) Rec (NamedFieldObj x) (ConstructorFieldNames x)
fields
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

---------------------------------------------------
-- Convenient helpers for operators compilation
---------------------------------------------------

ternaryOp
  :: KnownValue res
  => Expr n
  -> Expr m
  -> Expr l
  -> n : m : l : inp :-> res : inp
  -> IndigoState inp (res : inp)
ternaryOp :: Expr n
-> Expr m
-> Expr l
-> ((n : m : l : inp) :-> (res : inp))
-> IndigoState inp (res : inp)
ternaryOp e1 :: Expr n
e1 e2 :: Expr m
e2 e3 :: Expr l
e3 opCode :: (n : m : l : inp) :-> (res : inp)
opCode = (MetaData inp -> GenCode inp (res : inp))
-> IndigoState inp (res : inp)
forall (inp :: [*]) (out :: [*]).
(MetaData inp -> GenCode inp out) -> IndigoState inp out
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 st3 :: StackVars (l : inp)
st3 cd3 :: inp :-> (l : inp)
cd3 _cl3 :: (l : inp) :-> inp
_cl3  = IndigoState inp (l : inp) -> MetaData inp -> GenCode inp (l : inp)
forall (inp :: [*]) (out :: [*]).
IndigoState inp out -> MetaData inp -> GenCode inp out
runIndigoState (Expr l -> IndigoState inp (l : inp)
forall a (inp :: [*]). Expr a -> IndigoState inp (a : inp)
compileExpr Expr l
e3) MetaData inp
md in
  let GenCode st2 :: StackVars (m : l : inp)
st2 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 :: [*]).
IndigoState inp out -> MetaData inp -> GenCode inp out
runIndigoState (Expr m -> IndigoState (l : inp) (m : l : inp)
forall a (inp :: [*]). Expr a -> IndigoState inp (a : inp)
compileExpr Expr m
e2) (MetaData inp -> StackVars (l : inp) -> MetaData (l : inp)
forall (inp :: [*]) (inp1 :: [*]).
MetaData inp -> StackVars inp1 -> MetaData inp1
replStkMd MetaData inp
md StackVars (l : inp)
st3) in
  let GenCode _st1 :: StackVars (n : m : l : inp)
_st1 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 :: [*]).
IndigoState inp out -> MetaData inp -> GenCode inp out
runIndigoState (Expr n -> IndigoState (m : l : inp) (n : m : l : inp)
forall a (inp :: [*]). Expr a -> IndigoState inp (a : inp)
compileExpr Expr n
e1) (MetaData inp -> StackVars (m : l : inp) -> MetaData (m : l : inp)
forall (inp :: [*]) (inp1 :: [*]).
MetaData inp -> StackVars inp1 -> MetaData inp1
replStkMd MetaData inp
md StackVars (m : l : inp)
st2) in
  StackVars (res : inp)
-> (inp :-> (res : inp))
-> ((res : inp) :-> inp)
-> GenCode inp (res : inp)
forall (inp :: [*]) (out :: [*]).
StackVars out -> (inp :-> out) -> (out :-> inp) -> GenCode inp out
GenCode (StackVars inp -> StackVars (res : inp)
forall a (inp :: [*]).
KnownValue a =>
StackVars inp -> StackVars (a : inp)
pushNoRef (StackVars inp -> StackVars (res : inp))
-> StackVars inp -> StackVars (res : inp)
forall a b. (a -> b) -> a -> b
$ MetaData inp -> StackVars inp
forall (inp :: [*]). MetaData inp -> StackVars inp
mdStack 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
  :: KnownValue res
  => Expr n -> Expr m
  -> n : m : inp :-> res : inp
  -> IndigoState inp (res : inp)
binaryOp :: Expr n
-> Expr m
-> ((n : m : inp) :-> (res : inp))
-> IndigoState inp (res : inp)
binaryOp e1 :: Expr n
e1 e2 :: Expr m
e2 opCode :: (n : m : inp) :-> (res : inp)
opCode = (MetaData inp -> GenCode inp (res : inp))
-> IndigoState inp (res : inp)
forall (inp :: [*]) (out :: [*]).
(MetaData inp -> GenCode inp out) -> IndigoState inp out
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 st2 :: StackVars (m : inp)
st2 cd2 :: inp :-> (m : inp)
cd2 _cl2 :: (m : inp) :-> inp
_cl2  = IndigoState inp (m : inp) -> MetaData inp -> GenCode inp (m : inp)
forall (inp :: [*]) (out :: [*]).
IndigoState inp out -> MetaData inp -> GenCode inp out
runIndigoState (Expr m -> IndigoState inp (m : inp)
forall a (inp :: [*]). Expr a -> IndigoState inp (a : inp)
compileExpr Expr m
e2) MetaData inp
md in
  let GenCode _st1 :: StackVars (n : m : inp)
_st1 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 :: [*]).
IndigoState inp out -> MetaData inp -> GenCode inp out
runIndigoState (Expr n -> IndigoState (m : inp) (n : m : inp)
forall a (inp :: [*]). Expr a -> IndigoState inp (a : inp)
compileExpr Expr n
e1) (MetaData inp -> StackVars (m : inp) -> MetaData (m : inp)
forall (inp :: [*]) (inp1 :: [*]).
MetaData inp -> StackVars inp1 -> MetaData inp1
replStkMd MetaData inp
md StackVars (m : inp)
st2) in
  StackVars (res : inp)
-> (inp :-> (res : inp))
-> ((res : inp) :-> inp)
-> GenCode inp (res : inp)
forall (inp :: [*]) (out :: [*]).
StackVars out -> (inp :-> out) -> (out :-> inp) -> GenCode inp out
GenCode (StackVars inp -> StackVars (res : inp)
forall a (inp :: [*]).
KnownValue a =>
StackVars inp -> StackVars (a : inp)
pushNoRef (StackVars inp -> StackVars (res : inp))
-> StackVars inp -> StackVars (res : inp)
forall a b. (a -> b) -> a -> b
$ MetaData inp -> StackVars inp
forall (inp :: [*]). MetaData inp -> StackVars inp
mdStack 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
  :: KnownValue res
  => Expr n
  -> n : inp :-> res : inp
  -> IndigoState inp (res : inp)
unaryOp :: Expr n
-> ((n : inp) :-> (res : inp)) -> IndigoState inp (res : inp)
unaryOp e :: Expr n
e opCode :: (n : inp) :-> (res : inp)
opCode = (MetaData inp -> GenCode inp (res : inp))
-> IndigoState inp (res : inp)
forall (inp :: [*]) (out :: [*]).
(MetaData inp -> GenCode inp out) -> IndigoState inp out
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 :: [*]). GenCode inp out -> 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 :: [*]).
IndigoState inp out -> MetaData inp -> GenCode inp out
runIndigoState (Expr n -> IndigoState inp (n : inp)
forall a (inp :: [*]). Expr a -> IndigoState inp (a : inp)
compileExpr Expr n
e) MetaData inp
md in
  StackVars (res : inp)
-> (inp :-> (res : inp))
-> ((res : inp) :-> inp)
-> GenCode inp (res : inp)
forall (inp :: [*]) (out :: [*]).
StackVars out -> (inp :-> out) -> (out :-> inp) -> GenCode inp out
GenCode (StackVars inp -> StackVars (res : inp)
forall a (inp :: [*]).
KnownValue a =>
StackVars inp -> StackVars (a : inp)
pushNoRef (StackVars inp -> StackVars (res : inp))
-> StackVars inp -> StackVars (res : inp)
forall a b. (a -> b) -> a -> b
$ MetaData inp -> StackVars inp
forall (inp :: [*]). MetaData inp -> StackVars inp
mdStack 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 :: [*]).
(MetaData inp -> GenCode inp out) -> IndigoState inp out
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 ->
  StackVars (res : inp)
-> (inp :-> (res : inp))
-> ((res : inp) :-> inp)
-> GenCode inp (res : inp)
forall (inp :: [*]) (out :: [*]).
StackVars out -> (inp :-> out) -> (out :-> inp) -> GenCode inp out
GenCode (StackVars inp -> StackVars (res : inp)
forall a (inp :: [*]).
KnownValue a =>
StackVars inp -> StackVars (a : inp)
pushNoRef (StackVars inp -> StackVars (res : inp))
-> StackVars inp -> StackVars (res : inp)
forall a b. (a -> b) -> a -> b
$ MetaData inp -> StackVars inp
forall (inp :: [*]). MetaData inp -> StackVars inp
mdStack MetaData inp
md) inp :-> (res : inp)
lorentzInstr (res : inp) :-> inp
forall a (s :: [*]). (a : s) :-> s
L.drop

ternaryOpFlat
  :: Expr n
  -> Expr m
  -> Expr l
  -> n : m : l : inp :-> inp
  -> IndigoState inp inp
ternaryOpFlat :: Expr n
-> Expr m
-> Expr l
-> ((n : m : l : inp) :-> inp)
-> IndigoState inp inp
ternaryOpFlat e1 :: Expr n
e1 e2 :: Expr m
e2 e3 :: Expr l
e3 opCode :: (n : m : l : inp) :-> inp
opCode = (MetaData inp -> GenCode inp inp) -> IndigoState inp inp
forall (inp :: [*]) (out :: [*]).
(MetaData inp -> GenCode inp out) -> IndigoState inp out
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 st3 :: StackVars (l : inp)
st3 cd3 :: inp :-> (l : inp)
cd3 _cl3 :: (l : inp) :-> inp
_cl3  = IndigoState inp (l : inp) -> MetaData inp -> GenCode inp (l : inp)
forall (inp :: [*]) (out :: [*]).
IndigoState inp out -> MetaData inp -> GenCode inp out
runIndigoState (Expr l -> IndigoState inp (l : inp)
forall a (inp :: [*]). Expr a -> IndigoState inp (a : inp)
compileExpr Expr l
e3) MetaData inp
md in
  let GenCode st2 :: StackVars (m : l : inp)
st2 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 :: [*]).
IndigoState inp out -> MetaData inp -> GenCode inp out
runIndigoState (Expr m -> IndigoState (l : inp) (m : l : inp)
forall a (inp :: [*]). Expr a -> IndigoState inp (a : inp)
compileExpr Expr m
e2) (MetaData inp -> StackVars (l : inp) -> MetaData (l : inp)
forall (inp :: [*]) (inp1 :: [*]).
MetaData inp -> StackVars inp1 -> MetaData inp1
replStkMd MetaData inp
md StackVars (l : inp)
st3) in
  let GenCode _st1 :: StackVars (n : m : l : inp)
_st1 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 :: [*]).
IndigoState inp out -> MetaData inp -> GenCode inp out
runIndigoState (Expr n -> IndigoState (m : l : inp) (n : m : l : inp)
forall a (inp :: [*]). Expr a -> IndigoState inp (a : inp)
compileExpr Expr n
e1) (MetaData inp -> StackVars (m : l : inp) -> MetaData (m : l : inp)
forall (inp :: [*]) (inp1 :: [*]).
MetaData inp -> StackVars inp1 -> MetaData inp1
replStkMd MetaData inp
md StackVars (m : l : inp)
st2) in
  StackVars inp -> (inp :-> inp) -> (inp :-> inp) -> GenCode inp inp
forall (inp :: [*]) (out :: [*]).
StackVars out -> (inp :-> out) -> (out :-> inp) -> GenCode inp out
GenCode (MetaData inp -> StackVars inp
forall (inp :: [*]). MetaData inp -> StackVars inp
mdStack 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
  :: Expr n -> Expr m
  -> n : m : inp :-> inp
  -> IndigoState inp inp
binaryOpFlat :: Expr n -> Expr m -> ((n : m : inp) :-> inp) -> IndigoState inp inp
binaryOpFlat e1 :: Expr n
e1 e2 :: Expr m
e2 opCode :: (n : m : inp) :-> inp
opCode = (MetaData inp -> GenCode inp inp) -> IndigoState inp inp
forall (inp :: [*]) (out :: [*]).
(MetaData inp -> GenCode inp out) -> IndigoState inp out
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 st2 :: StackVars (m : inp)
st2 cd2 :: inp :-> (m : inp)
cd2 _cl2 :: (m : inp) :-> inp
_cl2  = IndigoState inp (m : inp) -> MetaData inp -> GenCode inp (m : inp)
forall (inp :: [*]) (out :: [*]).
IndigoState inp out -> MetaData inp -> GenCode inp out
runIndigoState (Expr m -> IndigoState inp (m : inp)
forall a (inp :: [*]). Expr a -> IndigoState inp (a : inp)
compileExpr Expr m
e2) MetaData inp
md in
  let GenCode _st1 :: StackVars (n : m : inp)
_st1 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 :: [*]).
IndigoState inp out -> MetaData inp -> GenCode inp out
runIndigoState (Expr n -> IndigoState (m : inp) (n : m : inp)
forall a (inp :: [*]). Expr a -> IndigoState inp (a : inp)
compileExpr Expr n
e1) (MetaData inp -> StackVars (m : inp) -> MetaData (m : inp)
forall (inp :: [*]) (inp1 :: [*]).
MetaData inp -> StackVars inp1 -> MetaData inp1
replStkMd MetaData inp
md StackVars (m : inp)
st2) in
  StackVars inp -> (inp :-> inp) -> (inp :-> inp) -> GenCode inp inp
forall (inp :: [*]) (out :: [*]).
StackVars out -> (inp :-> out) -> (out :-> inp) -> GenCode inp out
GenCode (MetaData inp -> StackVars inp
forall (inp :: [*]). MetaData inp -> StackVars inp
mdStack 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
  :: Expr n
  -> n : inp :-> inp
  -> IndigoState inp inp
unaryOpFlat :: Expr n -> ((n : inp) :-> inp) -> IndigoState inp inp
unaryOpFlat e :: Expr n
e opCode :: (n : inp) :-> inp
opCode = (MetaData inp -> GenCode inp inp) -> IndigoState inp inp
forall (inp :: [*]) (out :: [*]).
(MetaData inp -> GenCode inp out) -> IndigoState inp out
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 :: [*]). GenCode inp out -> 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 :: [*]).
IndigoState inp out -> MetaData inp -> GenCode inp out
runIndigoState (Expr n -> IndigoState inp (n : inp)
forall a (inp :: [*]). Expr a -> IndigoState inp (a : inp)
compileExpr Expr n
e) MetaData inp
md in
  StackVars inp -> (inp :-> inp) -> (inp :-> inp) -> GenCode inp inp
forall (inp :: [*]) (out :: [*]).
StackVars out -> (inp :-> out) -> (out :-> inp) -> GenCode inp out
GenCode (MetaData inp -> StackVars inp
forall (inp :: [*]). MetaData inp -> StackVars inp
mdStack 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 :: [*]).
(MetaData inp -> GenCode inp out) -> IndigoState inp out
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 -> StackVars inp -> (inp :-> inp) -> (inp :-> inp) -> GenCode inp inp
forall (inp :: [*]) (out :: [*]).
StackVars out -> (inp :-> out) -> (out :-> inp) -> GenCode inp out
GenCode (MetaData inp -> StackVars inp
forall (inp :: [*]). MetaData inp -> StackVars inp
mdStack MetaData inp
md) inp :-> inp
lorentzInstr inp :-> inp
forall (s :: [*]). s :-> s
L.nop