-- SPDX-FileCopyrightText: 2021 Oxhead Alpha
-- SPDX-License-Identifier: LicenseRef-MIT-OA

-- | 'Expr' compilation

module Indigo.Backend.Expr.Compilation
  ( compileExpr

  , ObjManipulationRes (..)
  , runObjectManipulation
  , namedToExpr

  , nullaryOp
  , unaryOp
  , binaryOp
  , ternaryOp

  , nullaryOpFlat
  , unaryOpFlat
  , binaryOpFlat
  , ternaryOpFlat
  ) where

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

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

import Indigo.Backend.Lookup (varActionGet)
import Indigo.Backend.Prelude
import Indigo.Common.Expr
import Indigo.Common.Field
import Indigo.Common.Object
  (IndigoObjectF(..), NamedFieldObj(..), castFieldConstructors, namedToTypedRec, typedToNamedRec)
import Indigo.Common.State
  (DecomposedObjects, GenCode(..), IndigoState(..), MetaData(..), replStkMd, usingIndigoState,
  withObject, withObjectState)
import Indigo.Common.Var (Var(..), pushNoRef)
import Indigo.Lorentz

compileExpr :: forall a inp . Expr a -> IndigoState inp (a : inp)
compileExpr :: forall a (inp :: [*]). Expr a -> IndigoState inp (a : inp)
compileExpr (C 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
$ \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 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 Expr a
m Expr (UpdOpKeyHs a)
key 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 Expr n
e1 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 r (s :: [*]).
ArithOpHs Add n m r =>
(n : m : s) :-> (r : s)
L.add
compileExpr (Sub Expr n
e1 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 r (s :: [*]).
ArithOpHs Sub n m r =>
(n : m : s) :-> (r : s)
L.sub
compileExpr (Mul Expr n
e1 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 r (s :: [*]).
ArithOpHs Mul n m r =>
(n : m : s) :-> (r : s)
L.mul
compileExpr (Div (Expr n
e1 :: Expr e1) (Expr m
e2 :: Expr e2) (Proxy reminder
_ :: Proxy reminder)) =
  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 (forall n m r (s :: [*]).
ArithOpHs EDiv n m r =>
(n : m : s) :-> (r : s)
L.ediv @_ @_ @(Maybe (a, reminder)) ((n : m : inp) :-> (Maybe (a, reminder) : inp))
-> ((Maybe (a, reminder) : inp) :-> (a : inp))
-> (n : m : inp) :-> (a : inp)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# (((a, reminder) : inp) :-> (a : inp))
-> (inp :-> (a : inp)) -> (Maybe (a, reminder) : inp) :-> (a : inp)
forall a (s :: [*]) (s' :: [*]).
((a : s) :-> s') -> (s :-> s') -> (Maybe a : s) :-> s'
L.ifSome ((a, reminder) : inp) :-> (a : inp)
forall a b (s :: [*]). ((a, b) : s) :-> (a : s)
L.car (MText -> inp :-> (a : inp)
forall e (s :: [*]) (t :: [*]).
(IsError e, IsError e) =>
e -> s :-> t
failUsing [mt|division by zero|]))
compileExpr (Mod (Expr n
e1 :: Expr e1) (Expr m
e2 :: Expr e2) (Proxy ratio
_ :: Proxy ratio)) =
  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 (forall n m r (s :: [*]).
ArithOpHs EDiv n m r =>
(n : m : s) :-> (r : s)
L.ediv @_ @_ @(Maybe (ratio, a)) ((n : m : inp) :-> (Maybe (ratio, a) : inp))
-> ((Maybe (ratio, a) : inp) :-> (a : inp))
-> (n : m : inp) :-> (a : inp)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# (((ratio, a) : inp) :-> (a : inp))
-> (inp :-> (a : inp)) -> (Maybe (ratio, a) : inp) :-> (a : inp)
forall a (s :: [*]) (s' :: [*]).
((a : s) :-> s') -> (s :-> s') -> (Maybe a : s) :-> s'
L.ifSome ((ratio, 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, IsError e) =>
e -> s :-> t
failUsing [mt|division by zero|]))
compileExpr (Abs 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 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 Expr n
e1 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 r (s :: [*]).
ArithOpHs Lsl n m r =>
(n : m : s) :-> (r : s)
L.lsl
compileExpr (Lsr Expr n
e1 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 r (s :: [*]).
ArithOpHs Lsr n m r =>
(n : m : s) :-> (r : s)
L.lsr

compileExpr (Eq' Expr n
e1 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 Expr n
e1 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 Expr n
e1 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 Expr n
e1 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 Expr n
e1 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 Expr n
e1 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 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' 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 i (s :: [*]).
ToIntegerArithOpHs i =>
(i : s) :-> (Integer : s)
L.int
compileExpr (Coerce Expr a1
e) = Expr a1 -> ((a1 : 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 a1
e (a1 : inp) :-> (a : inp)
forall a b (s :: [*]). Castable_ a b => (a : s) :-> (b : s)
checkedCoerce_
compileExpr (ForcedCoerce Expr a1
e) = Expr a1 -> ((a1 : 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 a1
e (a1 : inp) :-> (a : inp)
forall a b (s :: [*]).
MichelsonCoercible a b =>
(a : s) :-> (b : s)
forcedCoerce_
compileExpr (And Expr n
e1 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 r (s :: [*]).
ArithOpHs And n m r =>
(n : m : s) :-> (r : s)
L.and
compileExpr (Or Expr n
e1 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 r (s :: [*]).
ArithOpHs Or n m r =>
(n : m : s) :-> (r : s)
L.or
compileExpr (Xor Expr n
e1 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 r (s :: [*]).
ArithOpHs Xor n m r =>
(n : m : s) :-> (r : s)
L.xor
compileExpr (Not 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 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 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 Expr n
e1 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 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 Expr a
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' 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' 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 Expr a1
e) = Expr a1
-> ((a1 : inp) :-> (Packed a1 : inp))
-> IndigoState inp (Packed a1 : inp)
forall res n (inp :: [*]).
KnownValue res =>
Expr n
-> ((n : inp) :-> (res : inp)) -> IndigoState inp (res : inp)
unaryOp Expr a1
e (a1 : inp) :-> (Packed a1 : inp)
forall a (s :: [*]).
NicePackedValue a =>
(a : s) :-> (Packed a : s)
L.pack
compileExpr (Unpack Expr (Packed a1)
e) = Expr (Packed a1)
-> ((Packed a1 : inp) :-> (Maybe a1 : inp))
-> IndigoState inp (Maybe a1 : inp)
forall res n (inp :: [*]).
KnownValue res =>
Expr n
-> ((n : inp) :-> (res : inp)) -> IndigoState inp (res : inp)
unaryOp Expr (Packed a1)
e (Packed a1 : inp) :-> (Maybe a1 : inp)
forall a (s :: [*]).
NiceUnpackedValue a =>
(Packed a : s) :-> (Maybe a : s)
L.unpack
compileExpr (PackRaw Expr a1
e) = Expr a1
-> ((a1 : 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 a1
e (a1 : inp) :-> (ByteString : inp)
forall a (s :: [*]).
NicePackedValue a =>
(a : s) :-> (ByteString : s)
L.packRaw
compileExpr (UnpackRaw Expr ByteString
e) = Expr ByteString
-> ((ByteString : inp) :-> (Maybe a1 : inp))
-> IndigoState inp (Maybe a1 : inp)
forall res n (inp :: [*]).
KnownValue res =>
Expr n
-> ((n : inp) :-> (res : inp)) -> IndigoState inp (res : inp)
unaryOp Expr ByteString
e (ByteString : inp) :-> (Maybe a1 : inp)
forall a (s :: [*]).
NiceUnpackedValue a =>
(ByteString : s) :-> (Maybe a : s)
L.unpackRaw
compileExpr Expr a
Nil = (inp :-> ([a1] : inp)) -> IndigoState inp ([a1] : inp)
forall res (inp :: [*]).
KnownValue res =>
(inp :-> (res : inp)) -> IndigoState inp (res : inp)
nullaryOp inp :-> ([a1] : inp)
forall p (s :: [*]). KnownValue p => s :-> (List p : s)
L.nil
compileExpr (Cons Expr a1
e1 Expr [a1]
e2) = Expr a1
-> Expr [a1]
-> ((a1 : [a1] : inp) :-> ([a1] : inp))
-> IndigoState inp ([a1] : inp)
forall res n m (inp :: [*]).
KnownValue res =>
Expr n
-> Expr m
-> ((n : m : inp) :-> (res : inp))
-> IndigoState inp (res : inp)
binaryOp Expr a1
e1 Expr [a1]
e2 (a1 : [a1] : inp) :-> ([a1] : inp)
forall a (s :: [*]). (a : List a : s) :-> (List a : s)
L.cons
compileExpr (Contract (Proxy vd
Proxy :: Proxy vd) 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 (forall p vd addr (s :: [*]).
(NiceParameterFull p, ForbidExplicitDefaultEntrypoint p,
 ToTAddress_ p vd addr) =>
(addr : s) :-> (Maybe (ContractRef p) : s)
L.contract @_ @vd)
compileExpr Expr a
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,
 IsNotInView) =>
s :-> (ContractRef p : s)
L.self
compileExpr Expr a
SelfAddress = (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.selfAddress
compileExpr (ContractAddress 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 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.unsafeContractCalling EpName
epName)
compileExpr (RunFutureContract 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 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 Expr a1
e1 Expr (ContractRef r)
e2) = Expr a1
-> Expr (ContractRef r)
-> ((a1 : ContractRef r : inp) :-> (View_ a1 r : inp))
-> IndigoState inp (View_ a1 r : inp)
forall res n m (inp :: [*]).
KnownValue res =>
Expr n
-> Expr m
-> ((n : m : inp) :-> (res : inp))
-> IndigoState inp (res : inp)
binaryOp Expr a1
e1 Expr (ContractRef r)
e2 ((a1 : ContractRef r : inp) :-> ((a1, ContractRef r) : inp)
forall a b (s :: [*]). (a : b : s) :-> ((a, b) : s)
L.pair ((a1 : ContractRef r : inp) :-> ((a1, ContractRef r) : inp))
-> (((a1, ContractRef r) : inp) :-> (View_ a1 r : inp))
-> (a1 : ContractRef r : inp) :-> (View_ a1 r : inp)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# ((a1, ContractRef r) : inp) :-> (View_ a1 r : inp)
forall a r (s :: [*]). ((a, ContractRef r) : s) :-> (View_ a r : s)
L.wrapView_)
compileExpr (MakeVoid Expr a1
e1 Expr (Lambda b b)
e2) = Expr a1
-> Expr (Lambda b b)
-> ((a1 : Lambda b b : inp) :-> (Void_ a1 b : inp))
-> IndigoState inp (Void_ a1 b : inp)
forall res n m (inp :: [*]).
KnownValue res =>
Expr n
-> Expr m
-> ((n : m : inp) :-> (res : inp))
-> IndigoState inp (res : inp)
binaryOp Expr a1
e1 Expr (Lambda b b)
e2 ((a1 : Lambda b b : inp) :-> ((a1, Lambda b b) : inp)
forall a b (s :: [*]). (a : b : s) :-> ((a, b) : s)
L.pair ((a1 : Lambda b b : inp) :-> ((a1, Lambda b b) : inp))
-> (((a1, Lambda b b) : inp) :-> (Void_ a1 b : inp))
-> (a1 : Lambda b b : inp) :-> (Void_ a1 b : inp)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# ((a1, Lambda b b) : inp) :-> (Void_ a1 b : inp)
forall a b (s :: [*]). ((a, Lambda b b) : s) :-> (Void_ a b : s)
L.wrapVoid)

compileExpr (Mem Expr (MemOpKeyHs c)
k 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 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 Label name
l err
err Expr key
k Expr value
v 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
$ FieldRef name
-> (forall (s0 :: [*]) (any :: [*]). (key : s0) :-> any)
-> (key : value : a : inp) :-> (a : inp)
forall {k} store (mname :: k) key value (s :: [*]).
(StoreHasSubmap store mname key value, Dupable key) =>
FieldRef mname
-> (forall (s0 :: [*]) (any :: [*]). (key : s0) :-> any)
-> (key : value : store : s) :-> (store : s)
L.stInsertNew (Label name -> FieldRef name
forall (n :: Symbol). Label n -> FieldSymRef n
fieldNameFromLabel Label name
l) (err -> (key : s0) :-> any
forall e (s :: [*]) (t :: [*]).
(IsError e, IsError e) =>
e -> s :-> t
failUsing err
err)
compileExpr (StInsert Label name
l Expr key
k Expr value
v 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
$ FieldRef name -> (key : value : a : inp) :-> (a : inp)
forall {k} store (mname :: k) key value (s :: [*]).
StoreHasSubmap store mname key value =>
FieldRef mname -> (key : value : store : s) :-> (store : s)
L.stInsert (Label name -> FieldRef name
forall (n :: Symbol). Label n -> FieldSymRef n
fieldNameFromLabel Label name
l)
compileExpr (StGet Label name
l Expr key
ekey 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 (FieldRef name -> (key : store : inp) :-> (Maybe value : inp)
forall {k} store (mname :: k) key value (s :: [*]).
(StoreHasSubmap store mname key value, KnownValue value) =>
FieldRef mname -> (key : store : s) :-> (Maybe value : s)
L.stGet (Label name -> FieldRef name
forall (n :: Symbol). Label n -> FieldSymRef n
fieldNameFromLabel Label name
l))
compileExpr (StMem Label name
l Expr key
ekey 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 (FieldRef name -> (key : store : inp) :-> (Bool : inp)
forall {k} store (mname :: k) key value (s :: [*]).
StoreHasSubmap store mname key value =>
FieldRef mname -> (key : store : s) :-> (Bool : s)
L.stMem (Label name -> FieldRef name
forall (n :: Symbol). Label n -> FieldSymRef n
fieldNameFromLabel Label name
l))
compileExpr (StUpdate Label name
l Expr key
ekey Expr (Maybe val)
evalue 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 (FieldRef name -> (key : Maybe val : a : inp) :-> (a : inp)
forall {k} store (mname :: k) key value (s :: [*]).
StoreHasSubmap store mname key value =>
FieldRef mname -> (key : Maybe value : store : s) :-> (store : s)
L.stUpdate (Label name -> FieldRef name
forall (n :: Symbol). Label n -> FieldSymRef n
fieldNameFromLabel Label name
l))
compileExpr (StDelete Label name
l Expr key
ekey 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 (FieldRef name -> (key : a : inp) :-> (a : inp)
forall {k} store (mname :: k) key value (s :: [*]).
StoreHasSubmap store mname key value =>
FieldRef mname -> (key : store : s) :-> (store : s)
L.stDelete (Label name -> FieldRef name
forall (n :: Symbol). Label n -> FieldSymRef n
fieldNameFromLabel Label name
l))

compileExpr (Wrap Label name
l 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 Label name
l 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)
   :-> (RequireOneField name (GetCtorField dt name) : inp)
forall dt (name :: Symbol) (st :: [*]).
InstrUnwrapC dt name =>
Label name -> (dt : st) :-> (CtorOnlyField name dt : st)
L.unsafeUnwrap_ Label name
l

compileExpr (ObjMan ObjectManipulation a
fldAcc) = ObjectManipulation a -> IndigoState inp (a : inp)
forall a (inp :: [*]).
ObjectManipulation a -> IndigoState inp (a : inp)
compileObjectManipulation ObjectManipulation a
fldAcc
compileExpr (Construct Proxy a
_ 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
$ \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 (\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 Proxy a
_ 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
$ \MetaData inp
md ->
  let fieldCtrs :: Rec (FieldConstructor inp) (ConstructorFieldTypes a)
fieldCtrs =
          forall a (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 (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 ((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 (ConstructorFieldTypes a)
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) (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 Label name
l 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) :-> ((name :! a) : s)
toNamed Label name
l)
compileExpr (UnName Label name
l 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 -> ((name :! a) : s) :-> (a : s)
fromNamed Label name
l)

compileExpr (Slice Expr Natural
ex1 Expr Natural
ex2 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 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 Expr a
ex1 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' 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 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 Expr a
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 Expr a
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 Expr a
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 Expr PublicKey
pk Expr (TSignature bs)
sig 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 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 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 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 (Sha3 Expr bs
c) = Expr bs
-> ((bs : inp) :-> (Hash Sha3 bs : inp))
-> IndigoState inp (Hash Sha3 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 Sha3 bs : inp)
forall bs (s :: [*]).
BytesLike bs =>
(bs : s) :-> (Hash Sha3 bs : s)
L.sha3
compileExpr (Keccak Expr bs
c) = Expr bs
-> ((bs : inp) :-> (Hash Keccak bs : inp))
-> IndigoState inp (Hash Keccak 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 Keccak bs : inp)
forall bs (s :: [*]).
BytesLike bs =>
(bs : s) :-> (Hash Keccak bs : s)
L.keccak
compileExpr (HashKey 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 Expr a
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 Expr a
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 Expr a
Level = (inp :-> (Natural : inp)) -> IndigoState inp (Natural : inp)
forall res (inp :: [*]).
KnownValue res =>
(inp :-> (res : inp)) -> IndigoState inp (res : inp)
nullaryOp inp :-> (Natural : inp)
forall (s :: [*]). s :-> (Natural : s)
L.level
compileExpr (VotingPower Expr KeyHash
ex) = Expr KeyHash
-> ((KeyHash : 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 KeyHash
ex (KeyHash : inp) :-> (Natural : inp)
forall (s :: [*]). (KeyHash : s) :-> (Natural : s)
L.votingPower
compileExpr Expr a
TotalVotingPower = (inp :-> (Natural : inp)) -> IndigoState inp (Natural : inp)
forall res (inp :: [*]).
KnownValue res =>
(inp :-> (res : inp)) -> IndigoState inp (res : inp)
nullaryOp inp :-> (Natural : inp)
forall (s :: [*]). s :-> (Natural : s)
L.totalVotingPower

compileExpr Expr a
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 Expr (GetOpKeyHs c)
k 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 Expr a
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 Expr a
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, NiceNoBigMap v) =>
s :-> (BigMap k v : s)
L.emptyBigMap

compileExpr (Exec Expr a1
inp Expr (Lambda a1 a)
lambda) = Expr a1
-> Expr (Lambda a1 a)
-> ((a1 : Lambda a1 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 a1
inp Expr (Lambda a1 a)
lambda (a1 : Lambda a1 a : inp) :-> (a : inp)
forall a b (s :: [*]). (a : Lambda a b : s) :-> (b : s)
L.exec
compileExpr (NonZero 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 :: forall a (inp :: [*]).
ObjectManipulation a -> IndigoState inp (a : inp)
compileObjectManipulation 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
$ \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 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 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 :: forall x (name :: Symbol).
NamedFieldObj x name -> Expr (GetFieldType x name)
namedToExpr (NamedFieldObj 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 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)
_ (Cell RefId
refId) = Var a -> Expr a
forall a. KnownValue a => Var a -> Expr a
V (forall {a}. RefId -> Var a
forall {k} (a :: k). RefId -> Var a
Var @a RefId
refId)
objToExpr forall (name :: Symbol). f name -> Expr (GetFieldType a name)
convExpr (Decomposed Rec f (GFieldNames (Rep a))
fields) =
  Proxy a -> Rec Expr (FieldTypes a) -> Expr a
forall a.
ComplexObjectC a =>
Proxy a -> Rec Expr (FieldTypes a) -> Expr a
ConstructWithoutNamed (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @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 (GFieldNames (Rep 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 a (inp :: [*]) (f :: Symbol -> *).
(forall (name :: Symbol). f name -> Expr (GetFieldType a name))
-> IndigoObjectF f a -> IndigoState inp (a : inp)
compileObjectF forall (name :: Symbol). f name -> Expr (GetFieldType a name)
_ (Cell 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) (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 forall (name :: Symbol). f name -> Expr (GetFieldType a name)
conv 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 :: forall x (inp :: [*]).
DecomposedObjects
-> ObjectManipulation x -> ObjManipulationRes inp x
runObjectManipulation DecomposedObjects
objs (Object 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 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 Rec (NamedFieldExpr dt) (GFieldNames (Rep dt))
fields) ->
      case forall {k} dt (fname :: k) 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 Label fname1
lb StoreFieldOps dt fname x
_ -> 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 fname1 -> Expr (GetFieldType dt fname1)
forall a (name :: Symbol).
NamedFieldExpr a name -> Expr (GetFieldType a name)
unNamedFieldExpr (forall a (name :: Symbol) (f :: Symbol -> *)
       (proxy :: Symbol -> *).
AccessFieldC a name =>
proxy name -> Rec f (ConstructorFieldNames a) -> f name
fetchField @dt Label fname1
lb Rec (NamedFieldExpr dt) (GFieldNames (Rep dt))
fields)
        -- If we access deeper field, we fetch direct field and goes to the deeper field
        DeeperField Label fname1
lb StoreFieldOps dt fname x
_ ->
          let fe :: Expr (GetFieldType dt fname1)
fe = NamedFieldExpr dt fname1 -> Expr (GetFieldType dt fname1)
forall a (name :: Symbol).
NamedFieldExpr a name -> Expr (GetFieldType a name)
unNamedFieldExpr (NamedFieldExpr dt fname1 -> Expr (GetFieldType dt fname1))
-> NamedFieldExpr dt fname1 -> Expr (GetFieldType dt fname1)
forall a b. (a -> b) -> a -> b
$ forall a (name :: Symbol) (f :: Symbol -> *)
       (proxy :: Symbol -> *).
AccessFieldC a name =>
proxy name -> Rec f (ConstructorFieldNames a) -> f name
fetchField @dt Label fname1
lb Rec (NamedFieldExpr dt) (GFieldNames (Rep dt))
fields in
          DecomposedObjects
-> ObjectManipulation x -> ObjManipulationRes inp x
forall x (inp :: [*]).
DecomposedObjects
-> ObjectManipulation x -> ObjManipulationRes inp x
runObjectManipulation DecomposedObjects
objs (ObjectManipulation (GetFieldType dt fname1)
-> Label fname -> ObjectManipulation x
forall dt (fname :: Symbol) a.
HasField dt fname a =>
ObjectManipulation dt -> Label fname -> ObjectManipulation a
ToField (Expr (GetFieldType dt fname1)
-> ObjectManipulation (GetFieldType dt fname1)
forall a. Expr a -> ObjectManipulation a
Object Expr (GetFieldType dt fname1)
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) ->
      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) (forall {k} store (fname :: k) ftype.
StoreFieldOps store fname ftype
-> forall (s :: [*]). FieldRef fname -> (store : s) :-> (ftype : s)
forall store (fname :: Symbol) ftype.
StoreFieldOps store fname ftype
-> forall (s :: [*]). FieldRef fname -> (store : s) :-> (ftype : s)
sopToField @dt (FieldLens dt fname x -> StoreFieldOps dt fname x
forall {k} dt (fname :: k) ftype.
FieldLens dt fname ftype -> StoreFieldOps dt fname ftype
flSFO FieldLens dt fname x
forall {k} dt (fname :: k) ftype.
HasField dt fname ftype =>
FieldLens dt fname ftype
fieldLens) (Label fname -> FieldRef fname
forall (n :: Symbol). Label n -> FieldSymRef n
fieldNameFromLabel Label fname
targetLb))
    -- If we already got into computation, we use 'sopToField' to fetch field.
    OnStack 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
$ \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
-> forall (s :: [*]). FieldRef fname -> (dt : s) :-> (x : s)
forall {k} store (fname :: k) ftype.
StoreFieldOps store fname ftype
-> forall (s :: [*]). FieldRef fname -> (store : s) :-> (ftype : s)
sopToField (FieldLens dt fname x -> StoreFieldOps dt fname x
forall {k} dt (fname :: k) ftype.
FieldLens dt fname ftype -> StoreFieldOps dt fname ftype
flSFO FieldLens dt fname x
forall {k} dt (fname :: k) ftype.
HasField dt fname ftype =>
FieldLens dt fname ftype
fieldLens) (Label fname -> FieldRef fname
forall (n :: Symbol). Label n -> FieldSymRef n
fieldNameFromLabel Label fname
targetLb)) (x : inp) :-> inp
forall a (s :: [*]). (a : s) :-> s
L.drop

runObjectManipulation DecomposedObjects
objs (SetField (ObjectManipulation x
ev :: ObjectManipulation dt) (Label fname
targetLb :: Label fname) 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 Rec (NamedFieldExpr x) (GFieldNames (Rep x))
fields) ->
      case forall {k} dt (fname :: k) 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 set direct field, we just reassign its value with new one.
        TargetField Label fname1
lb StoreFieldOps x fname ftype
_ ->
          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) (GFieldNames (Rep x)) -> ObjectExpr x
forall a (f :: Symbol -> *).
ComplexObjectC a =>
Rec f (ConstructorFieldNames a) -> IndigoObjectF f a
Decomposed (Rec (NamedFieldExpr x) (GFieldNames (Rep x)) -> ObjectExpr x)
-> Rec (NamedFieldExpr x) (GFieldNames (Rep x)) -> ObjectExpr x
forall a b. (a -> b) -> a -> b
$ 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 fname1
lb (Expr (GetFieldType x fname1) -> NamedFieldExpr x fname1
forall a (name :: Symbol).
Expr (GetFieldType a name) -> NamedFieldExpr a name
NamedFieldExpr Expr ftype
Expr (GetFieldType x fname1)
ef) Rec (NamedFieldExpr x) (GFieldNames (Rep 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 fname1
lb :: Label interm) StoreFieldOps x fname ftype
_ ->
          let fe :: Expr (GetFieldType x fname1)
fe = NamedFieldExpr x fname1 -> Expr (GetFieldType x fname1)
forall a (name :: Symbol).
NamedFieldExpr a name -> Expr (GetFieldType a name)
unNamedFieldExpr (forall a (name :: Symbol) (f :: Symbol -> *)
       (proxy :: Symbol -> *).
AccessFieldC a name =>
proxy name -> Rec f (ConstructorFieldNames a) -> f name
fetchField @dt Label fname1
lb Rec (NamedFieldExpr x) (GFieldNames (Rep x))
fields) in
          -- Computing new value of direct field
          case DecomposedObjects
-> ObjectManipulation (GetFieldType x fname1)
-> ObjManipulationRes (x : inp) (GetFieldType x fname1)
forall x (inp :: [*]).
DecomposedObjects
-> ObjectManipulation x -> ObjManipulationRes inp x
runObjectManipulation DecomposedObjects
objs (ObjectManipulation (GetFieldType x fname1)
-> Label fname
-> Expr ftype
-> ObjectManipulation (GetFieldType x fname1)
forall a (fname :: Symbol) ftype.
HasField a fname ftype =>
ObjectManipulation a
-> Label fname -> Expr ftype -> ObjectManipulation a
SetField (Expr (GetFieldType x fname1)
-> ObjectManipulation (GetFieldType x fname1)
forall a. Expr a -> ObjectManipulation a
Object Expr (GetFieldType x fname1)
fe) Label fname
targetLb Expr ftype
ef) of
            -- If it's still an object, we just reassign direct field with it.
            StillObject ObjectExpr (GetFieldType x fname1)
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) (GFieldNames (Rep x)) -> ObjectExpr x
forall a (f :: Symbol -> *).
ComplexObjectC a =>
Rec f (ConstructorFieldNames a) -> IndigoObjectF f a
Decomposed (Rec (NamedFieldExpr x) (GFieldNames (Rep x)) -> ObjectExpr x)
-> Rec (NamedFieldExpr x) (GFieldNames (Rep x)) -> ObjectExpr x
forall a b. (a -> b) -> a -> b
$
              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 fname1
lb (Expr (GetFieldType x fname1) -> NamedFieldExpr x fname1
forall a (name :: Symbol).
Expr (GetFieldType a name) -> NamedFieldExpr a name
NamedFieldExpr (Expr (GetFieldType x fname1) -> NamedFieldExpr x fname1)
-> Expr (GetFieldType x fname1) -> NamedFieldExpr x fname1
forall a b. (a -> b) -> a -> b
$ (forall (name :: Symbol).
 NamedFieldExpr (GetFieldType x fname1) name
 -> Expr (GetFieldType (GetFieldType x fname1) name))
-> ObjectExpr (GetFieldType x fname1)
-> Expr (GetFieldType x fname1)
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 fname1) name
-> Expr (GetFieldType (GetFieldType x fname1) name)
unNamedFieldExpr ObjectExpr (GetFieldType x fname1)
updField) Rec (NamedFieldExpr x) (GFieldNames (Rep x))
fields
            -- Otherwise, we use power of 'L.setField' to set a new value.
            OnStack IndigoState (x : inp) (GetFieldType x fname1 : x : inp)
rhs ->
              IndigoState inp (x : inp)
-> IndigoState (x : inp) (GetFieldType x fname1 : x : inp)
-> ((GetFieldType x fname1 : 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 fname1 : x : inp)
rhs (forall dt (name :: Symbol) (st :: [*]).
InstrSetFieldC dt name =>
Label name -> (GetFieldType dt name : dt : st) :-> (dt : st)
L.setField @dt @interm Label fname1
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) ->
      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
-> FieldRef fname -> (ftype : x : inp) :-> (x : inp)
forall {k} store (fname :: k) ftype (s :: [*]).
StoreFieldOps store fname ftype
-> FieldRef fname -> (ftype : store : s) :-> (store : s)
sopSetField (FieldLens x fname ftype -> StoreFieldOps x fname ftype
forall {k} dt (fname :: k) ftype.
FieldLens dt fname ftype -> StoreFieldOps dt fname ftype
flSFO FieldLens x fname ftype
forall {k} dt (fname :: k) ftype.
HasField dt fname ftype =>
FieldLens dt fname ftype
fieldLens) (Label fname -> FieldRef fname
forall (n :: Symbol). Label n -> FieldSymRef n
fieldNameFromLabel Label fname
targetLb)
    -- If we already got into computation, we use 'sopSetField' to set a field.
    OnStack 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
-> FieldRef fname -> (ftype : x : inp) :-> (x : inp)
forall {k} store (fname :: k) ftype (s :: [*]).
StoreFieldOps store fname ftype
-> FieldRef fname -> (ftype : store : s) :-> (store : s)
sopSetField (FieldLens x fname ftype -> StoreFieldOps x fname ftype
forall {k} dt (fname :: k) 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 {k} dt (fname :: k) ftype.
HasField dt fname ftype =>
FieldLens dt fname ftype
forall dt (fname :: Symbol) ftype.
HasField dt fname ftype =>
FieldLens dt fname ftype
fieldLens @dt) (Label fname -> FieldRef fname
forall (n :: Symbol). Label n -> FieldSymRef n
fieldNameFromLabel Label fname
targetLb))
  where
    setFieldOnStack
      :: IndigoState inp (dt : inp)
      -> IndigoState (dt : inp) (fld : dt : inp)
      -> fld : dt : inp :-> dt : inp
      -> ObjManipulationRes inp dt
    setFieldOnStack :: 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)
lhs IndigoState (x : inp) (fld : x : inp)
rhs (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
$ \MetaData inp
mdI ->
      let GenCode StackVars (x : inp)
st1 inp :-> (x : inp)
cdObj (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 StackVars (fld : x : inp)
_st2 (x : inp) :-> (fld : x : inp)
cdFld (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 :: forall x (inp :: [*]).
DecomposedObjects -> Expr x -> ObjManipulationRes inp x
exprToManRes DecomposedObjects
objs (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 DecomposedObjects
_ (ConstructWithoutNamed Proxy x
_ 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 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 DecomposedObjects
objs (V 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 ->
    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 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 DecomposedObjects
_ 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 :: 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 n
e1 Expr m
e2 Expr l
e3 (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
$ \MetaData inp
md ->
  let GenCode StackVars (l : inp)
st3 inp :-> (l : inp)
cd3 (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 StackVars (m : l : inp)
st2 (l : inp) :-> (m : l : inp)
cd2 (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 StackVars (n : m : l : inp)
_st1 (m : l : inp) :-> (n : m : l : inp)
cd1 (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 :: 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) :-> (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
$ \MetaData inp
md ->
  let GenCode StackVars (m : inp)
st2 inp :-> (m : inp)
cd2 (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 StackVars (n : m : inp)
_st1 (m : inp) :-> (n : m : inp)
cd1 (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 :: forall res n (inp :: [*]).
KnownValue res =>
Expr n
-> ((n : inp) :-> (res : inp)) -> IndigoState inp (res : inp)
unaryOp Expr n
e (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
$ \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 :: forall res (inp :: [*]).
KnownValue res =>
(inp :-> (res : inp)) -> IndigoState inp (res : inp)
nullaryOp 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
$ \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 :: forall n m l (inp :: [*]).
Expr n
-> Expr m
-> Expr l
-> ((n : m : l : inp) :-> inp)
-> IndigoState inp inp
ternaryOpFlat Expr n
e1 Expr m
e2 Expr l
e3 (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
$ \MetaData inp
md ->
  let GenCode StackVars (l : inp)
st3 inp :-> (l : inp)
cd3 (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 StackVars (m : l : inp)
st2 (l : inp) :-> (m : l : inp)
cd2 (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 StackVars (n : m : l : inp)
_st1 (m : l : inp) :-> (n : m : l : inp)
cd1 (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 :: forall n m (inp :: [*]).
Expr n -> Expr m -> ((n : m : inp) :-> inp) -> IndigoState inp inp
binaryOpFlat Expr n
e1 Expr m
e2 (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
$ \MetaData inp
md ->
  let GenCode StackVars (m : inp)
st2 inp :-> (m : inp)
cd2 (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 StackVars (n : m : inp)
_st1 (m : inp) :-> (n : m : inp)
cd1 (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 :: forall n (inp :: [*]).
Expr n -> ((n : inp) :-> inp) -> IndigoState inp inp
unaryOpFlat Expr n
e (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
$ \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 :: forall (inp :: [*]). (inp :-> inp) -> IndigoState inp inp
nullaryOpFlat 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
$ \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