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

-- | Backend statements for variable manipulation: assignment, replacement, update.

module Indigo.Backend.Var
  ( assignVar
  , setVar
  , setField
  , updateVar
  ) where

import Fmt (pretty)

import Indigo.Backend.Expr.Compilation (binaryOpFlat, compileExpr, unaryOpFlat)
import Indigo.Backend.Expr.Decompose (ExprDecomposition(Deconstructed, ExprFields), decomposeExpr)
import Indigo.Backend.Lookup (varActionSet, varActionUpdate)
import Indigo.Backend.Prelude
import Indigo.Backend.Scope
import Indigo.Common.Expr (Expr(V))
import Indigo.Common.Field (FieldLens(DeeperField, TargetField), HasField(..), fetchField, flSFO)
import Indigo.Common.Object
import Indigo.Common.State
import Indigo.Common.Var (RefId, Var(..))
import Indigo.Lorentz
import Lorentz.Instr qualified as L
import Morley.Michelson.Typed.Haskell.Instr.Product (GetFieldType)
import Morley.Util.Type (type (++))

-- | Assign the given variable to the value resulting from the given expression.
assignVar :: forall x inp . KnownValue x => Var x -> Expr x -> IndigoState inp (x : inp)
assignVar :: forall x (inp :: [*]).
KnownValue x =>
Var x -> Expr x -> IndigoState inp (x : inp)
assignVar Var x
var Expr x
e =
  Text -> IndigoState inp (x : inp) -> IndigoState inp (x : inp)
forall (inp :: [*]) (out :: [*]).
Text -> IndigoState inp out -> IndigoState inp out
stmtHookState (forall ret. ReturnableValue ret => RetVars ret -> Text -> Text
prettyAssign @(Var x) Var x
RetVars (Var x)
var (Expr x -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty Expr x
e)) (IndigoState inp (x : inp) -> IndigoState inp (x : inp))
-> IndigoState inp (x : inp) -> IndigoState inp (x : inp)
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
e IndigoState inp (x : inp)
-> IndigoState (x : inp) (x : inp) -> IndigoState inp (x : inp)
forall (inp :: [*]) (out :: [*]) (out1 :: [*]).
IndigoState inp out -> IndigoState out out1 -> IndigoState inp out1
>> Var x -> IndigoState (x : inp) (x : inp)
forall x (inp :: [*]).
KnownValue x =>
Var x -> IndigoState (x : inp) (x : inp)
assignTopVar Var x
var

-- | Set the variable to a new value.
--
-- If a variable is a cell on the stack,
-- we just compile passed expression and replace variable cell on stack.
-- If a variable is decomposed, we decompose passed expression
-- and call 'setVar' recursively from its fields.
--
-- Pay attention that this function takes a next RefId but it doesn't return RefId
-- because all allocated variables will be destroyed during execution of the function,
-- so allocated ones won't affect next allocated ones.
setVar :: forall a inp. KnownValue a => RefId -> Var a -> Expr a -> IndigoState inp inp
setVar :: forall a (inp :: [*]).
KnownValue a =>
RefId -> Var a -> Expr a -> IndigoState inp inp
setVar RefId
nextRef Var a
v Expr a
ex = Text -> IndigoState inp inp -> IndigoState inp inp
forall (inp :: [*]) (out :: [*]).
Text -> IndigoState inp out -> IndigoState inp out
stmtHookState (forall ret. ReturnableValue ret => RetVars ret -> Text -> Text
prettyAssign @(Var a) Var a
RetVars (Var a)
v (Expr a -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty Expr a
ex)) (IndigoState inp inp -> IndigoState inp inp)
-> IndigoState inp inp -> IndigoState inp inp
forall a b. (a -> b) -> a -> b
$
  Var a -> (Object a -> IndigoState inp inp) -> IndigoState inp 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 inp) -> IndigoState inp inp)
-> (Object a -> IndigoState inp inp) -> IndigoState inp inp
forall a b. (a -> b) -> a -> b
$ (Object a -> Expr a -> IndigoState inp inp)
-> Expr a -> Object a -> IndigoState inp inp
forall a b c. (a -> b -> c) -> b -> a -> c
flip (RefId -> Object a -> Expr a -> IndigoState inp inp
forall a (inp :: [*]).
RefId -> Object a -> Expr a -> IndigoState inp inp
setVarImpl RefId
nextRef) Expr a
ex

setVarImpl :: forall a inp . RefId -> Object a -> Expr a -> IndigoState inp inp
setVarImpl :: forall a (inp :: [*]).
RefId -> Object a -> Expr a -> IndigoState inp inp
setVarImpl RefId
_ (Cell RefId
refId) Expr a
ex = (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 -> MetaData inp -> IndigoState inp inp -> GenCode inp inp
forall (inp :: [*]) (out :: [*]).
MetaData inp -> IndigoState inp out -> GenCode inp out
usingIndigoState MetaData inp
md (IndigoState inp inp -> GenCode inp inp)
-> IndigoState inp inp -> GenCode inp inp
forall a b. (a -> b) -> a -> b
$
  Expr a -> ((a : inp) :-> inp) -> IndigoState inp inp
forall n (inp :: [*]).
Expr n -> ((n : inp) :-> inp) -> IndigoState inp inp
unaryOpFlat Expr a
ex (((a : inp) :-> inp) -> IndigoState inp inp)
-> ((a : inp) :-> inp) -> IndigoState inp inp
forall a b. (a -> b) -> a -> b
$ RefId -> StackVars inp -> (a : inp) :-> inp
forall a (stk :: [*]).
KnownValue a =>
RefId -> StackVars stk -> (a : stk) :-> stk
varActionSet RefId
refId (MetaData inp -> StackVars inp
forall (inp :: [*]). MetaData inp -> StackVars inp
mdStack MetaData inp
md)
setVarImpl RefId
nextRef (Decomposed Rec (NamedFieldObj a) (GFieldNames (Rep a))
fields) Expr a
ex = (MetaData inp -> GenCode inp inp) -> IndigoState inp inp
forall (inp :: [*]) (out :: [*]).
(MetaData inp -> GenCode inp out) -> IndigoState inp out
IndigoState ((MetaData inp -> GenCode inp inp) -> IndigoState inp inp)
-> (MetaData inp -> GenCode inp inp) -> IndigoState inp inp
forall a b. (a -> b) -> a -> b
$ \md :: MetaData inp
md@MetaData{DecomposedObjects
StackVars inp
GenCodeHooks
mdHooks :: forall (inp :: [*]). MetaData inp -> GenCodeHooks
mdObjects :: forall (inp :: [*]). MetaData inp -> DecomposedObjects
mdHooks :: GenCodeHooks
mdObjects :: DecomposedObjects
mdStack :: StackVars inp
mdStack :: forall (inp :: [*]). MetaData inp -> StackVars inp
..} ->
  case DecomposedObjects -> Expr a -> ExprDecomposition inp a
forall a (inp :: [*]).
ComplexObjectC a =>
DecomposedObjects -> Expr a -> ExprDecomposition inp a
decomposeExpr DecomposedObjects
mdObjects Expr a
ex of
    ExprFields Rec Expr (FieldTypes a)
fieldsExpr -> MetaData inp -> IndigoState inp inp -> GenCode inp inp
forall (inp :: [*]) (out :: [*]).
MetaData inp -> IndigoState inp out -> GenCode inp out
usingIndigoState MetaData inp
md (IndigoState inp inp -> GenCode inp inp)
-> IndigoState inp inp -> GenCode inp inp
forall a b. (a -> b) -> a -> b
$
      Rec TypedFieldObj (ConstructorFieldTypes a)
-> Rec Expr (ConstructorFieldTypes a) -> IndigoState inp inp
forall (rs :: [*]).
Rec TypedFieldObj rs -> Rec Expr rs -> IndigoState inp inp
rmapZipM (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 a (name :: Symbol).
NamedFieldObj a name -> TypedFieldObj (GetFieldType a name)
forall (name :: Symbol).
NamedFieldObj a name -> TypedFieldObj (GetFieldType a name)
namedToTypedFieldObj Rec (NamedFieldObj a) (GFieldNames (Rep a))
fields) Rec Expr (ConstructorFieldTypes a)
Rec Expr (FieldTypes a)
fieldsExpr
    Deconstructed IndigoState inp (FieldTypes a ++ inp)
comp ->
      let GenCode StackVars (ConstructorFieldTypes a ++ inp)
decomposeSt inp :-> (ConstructorFieldTypes a ++ inp)
decomposeExCd (ConstructorFieldTypes a ++ inp) :-> inp
_ = MetaData inp
-> IndigoState inp (ConstructorFieldTypes a ++ inp)
-> GenCode inp (ConstructorFieldTypes a ++ inp)
forall (inp :: [*]) (out :: [*]).
MetaData inp -> IndigoState inp out -> GenCode inp out
usingIndigoState MetaData inp
md IndigoState inp (ConstructorFieldTypes a ++ inp)
IndigoState inp (FieldTypes a ++ inp)
comp
          setAllFieldsCd :: (ConstructorFieldTypes a ++ inp) :-> inp
setAllFieldsCd =
            MetaData (ConstructorFieldTypes a ++ inp)
-> Rec TypedFieldObj (ConstructorFieldTypes a)
-> (ConstructorFieldTypes a ++ inp) :-> inp
forall (rs :: [*]).
MetaData (rs ++ inp) -> Rec TypedFieldObj rs -> (rs ++ inp) :-> inp
setFieldsOnStack
              (StackVars (ConstructorFieldTypes a ++ inp)
-> DecomposedObjects
-> GenCodeHooks
-> MetaData (ConstructorFieldTypes a ++ inp)
forall (inp :: [*]).
StackVars inp -> DecomposedObjects -> GenCodeHooks -> MetaData inp
MetaData StackVars (ConstructorFieldTypes a ++ inp)
decomposeSt DecomposedObjects
mdObjects GenCodeHooks
mdHooks)
              (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 a (name :: Symbol).
NamedFieldObj a name -> TypedFieldObj (GetFieldType a name)
forall (name :: Symbol).
NamedFieldObj a name -> TypedFieldObj (GetFieldType a name)
namedToTypedFieldObj Rec (NamedFieldObj a) (GFieldNames (Rep a))
fields) in
      StackVars inp -> (inp :-> inp) -> (inp :-> inp) -> GenCode inp inp
forall (inp :: [*]) (out :: [*]).
StackVars out -> (inp :-> out) -> (out :-> inp) -> GenCode inp out
GenCode StackVars inp
mdStack (inp :-> (ConstructorFieldTypes a ++ inp)
decomposeExCd (inp :-> (ConstructorFieldTypes a ++ inp))
-> ((ConstructorFieldTypes a ++ inp) :-> inp) -> inp :-> inp
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# (ConstructorFieldTypes a ++ inp) :-> inp
setAllFieldsCd) inp :-> inp
forall (s :: [*]). s :-> s
L.nop
  where
    -- Set fields, if they are decomposed on stack.
    setFieldsOnStack
      :: forall rs .
         MetaData (rs ++ inp)
      -> Rec TypedFieldObj rs
      -> (rs ++ inp) :-> inp
    setFieldsOnStack :: forall (rs :: [*]).
MetaData (rs ++ inp) -> Rec TypedFieldObj rs -> (rs ++ inp) :-> inp
setFieldsOnStack MetaData (rs ++ inp)
_ Rec TypedFieldObj rs
RNil = (rs ++ inp) :-> inp
forall (s :: [*]). s :-> s
L.nop
    setFieldsOnStack MetaData (rs ++ inp)
md (TypedFieldObj Object r
f :& Rec TypedFieldObj rs
vs) =
      let tmpFieldVar :: Var r
tmpFieldVar = RefId -> Var r
forall {k} (a :: k). RefId -> Var a
Var RefId
nextRef
          setVarMd :: MetaData (r : (rs ++ inp))
setVarMd = Var r -> MetaData (rs ++ inp) -> MetaData (r : (rs ++ inp))
forall a (inp :: [*]).
KnownValue a =>
Var a -> MetaData inp -> MetaData (a : inp)
pushRefMd Var r
tmpFieldVar (MetaData (r : (rs ++ inp)) -> MetaData (rs ++ inp)
forall a (inp :: [*]). MetaData (a : inp) -> MetaData inp
popNoRefMd MetaData (r : (rs ++ inp))
MetaData (rs ++ inp)
md) in
      (GenCode (r : (rs ++ inp)) (r : (rs ++ inp))
-> (r : (rs ++ inp)) :-> (r : (rs ++ inp))
forall (inp :: [*]) (out :: [*]). GenCode inp out -> inp :-> out
gcCode (GenCode (r : (rs ++ inp)) (r : (rs ++ inp))
 -> (r : (rs ++ inp)) :-> (r : (rs ++ inp)))
-> GenCode (r : (rs ++ inp)) (r : (rs ++ inp))
-> (r : (rs ++ inp)) :-> (r : (rs ++ inp))
forall a b. (a -> b) -> a -> b
$ MetaData (r : (rs ++ inp))
-> IndigoState (r : (rs ++ inp)) (r : (rs ++ inp))
-> GenCode (r : (rs ++ inp)) (r : (rs ++ inp))
forall (inp :: [*]) (out :: [*]).
MetaData inp -> IndigoState inp out -> GenCode inp out
usingIndigoState MetaData (r : (rs ++ inp))
setVarMd (IndigoState (r : (rs ++ inp)) (r : (rs ++ inp))
 -> GenCode (r : (rs ++ inp)) (r : (rs ++ inp)))
-> IndigoState (r : (rs ++ inp)) (r : (rs ++ inp))
-> GenCode (r : (rs ++ inp)) (r : (rs ++ inp))
forall a b. (a -> b) -> a -> b
$ RefId
-> Object r
-> Expr r
-> IndigoState (r : (rs ++ inp)) (r : (rs ++ inp))
forall a (inp :: [*]).
RefId -> Object a -> Expr a -> IndigoState inp inp
setVarImpl (RefId
nextRef RefId -> RefId -> RefId
forall a. Num a => a -> a -> a
+ RefId
1) Object r
f (Var r -> Expr r
forall a. KnownValue a => Var a -> Expr a
V Var r
tmpFieldVar)) ((r : (rs ++ inp)) :-> (r : (rs ++ inp)))
-> ((r : (rs ++ inp)) :-> (rs ++ inp))
-> (r : (rs ++ inp)) :-> (rs ++ inp)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#
      (r : (rs ++ inp)) :-> (rs ++ inp)
forall a (s :: [*]). (a : s) :-> s
L.drop ((r : (rs ++ inp)) :-> (rs ++ inp))
-> ((rs ++ inp) :-> inp) -> (r : (rs ++ inp)) :-> inp
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#
      MetaData (rs ++ inp) -> Rec TypedFieldObj rs -> (rs ++ inp) :-> inp
forall (rs :: [*]).
MetaData (rs ++ inp) -> Rec TypedFieldObj rs -> (rs ++ inp) :-> inp
setFieldsOnStack (MetaData (r : (rs ++ inp)) -> MetaData (rs ++ inp)
forall a (inp :: [*]). MetaData (a : inp) -> MetaData inp
popNoRefMd MetaData (r : (rs ++ inp))
MetaData (rs ++ inp)
md) Rec TypedFieldObj rs
vs

    -- Take list of fields (variables, referring to them)
    -- and list of corresponding expressions and call 'setVarImpl' recursively.
    rmapZipM :: Rec TypedFieldObj rs -> Rec Expr rs -> IndigoState inp inp
    rmapZipM :: forall (rs :: [*]).
Rec TypedFieldObj rs -> Rec Expr rs -> IndigoState inp inp
rmapZipM Rec TypedFieldObj rs
RNil Rec Expr rs
RNil = IndigoState inp inp
forall (inp :: [*]). IndigoState inp inp
nopState
    rmapZipM (TypedFieldObj Object r
f :& Rec TypedFieldObj rs
flds) (Expr r
e :& Rec Expr rs
exprs) =
      RefId -> Object r -> Expr r -> IndigoState inp inp
forall a (inp :: [*]).
RefId -> Object a -> Expr a -> IndigoState inp inp
setVarImpl RefId
nextRef Object r
f Expr r
Expr r
e IndigoState inp inp -> IndigoState inp inp -> IndigoState inp inp
forall (inp :: [*]) (out :: [*]) (out1 :: [*]).
IndigoState inp out -> IndigoState out out1 -> IndigoState inp out1
>>
      Rec TypedFieldObj rs -> Rec Expr rs -> IndigoState inp inp
forall (rs :: [*]).
Rec TypedFieldObj rs -> Rec Expr rs -> IndigoState inp inp
rmapZipM Rec TypedFieldObj rs
flds Rec Expr rs
Rec Expr rs
exprs

-- | Set the field (direct or indirect) of a complex object.
setField
  :: forall dt fname ftype inp .
     ( IsObject dt
     , IsObject ftype
     , HasField dt fname ftype
     )
  => RefId -> Var dt -> Label fname -> Expr ftype -> IndigoState inp inp
setField :: forall dt (fname :: Symbol) ftype (inp :: [*]).
(IsObject dt, IsObject ftype, HasField dt fname ftype) =>
RefId -> Var dt -> Label fname -> Expr ftype -> IndigoState inp inp
setField RefId
nextRef Var dt
v Label fname
targetLb Expr ftype
e =
  Text -> IndigoState inp inp -> IndigoState inp inp
forall (inp :: [*]) (out :: [*]).
Text -> IndigoState inp out -> IndigoState inp out
stmtHookState (Text
"setField " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Var dt -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty Var dt
v Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" #" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Label fname -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty Label fname
targetLb Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr ftype -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty Expr ftype
e) (IndigoState inp inp -> IndigoState inp inp)
-> IndigoState inp inp -> IndigoState inp inp
forall a b. (a -> b) -> a -> b
$
    Var dt -> (Object dt -> IndigoState inp inp) -> IndigoState inp inp
forall a (inp :: [*]) (out :: [*]).
KnownValue a =>
Var a -> (Object a -> IndigoState inp out) -> IndigoState inp out
withObjectState Var dt
v Object dt -> IndigoState inp inp
forall x.
(IsObject x, HasField x fname ftype) =>
Object x -> IndigoState inp inp
setFieldImpl
  where
    setFieldImpl :: forall x . (IsObject x, HasField x fname ftype) => Object x -> IndigoState inp inp
    setFieldImpl :: forall x.
(IsObject x, HasField x fname ftype) =>
Object x -> IndigoState inp inp
setFieldImpl (Cell RefId
refId) =
      forall x y (inp :: [*]).
(IsObject x, KnownValue y) =>
RefId
-> ('[y, x] :-> '[x]) -> Var x -> Expr y -> IndigoState inp inp
updateVar @x RefId
nextRef (StoreFieldOps x fname ftype
-> FieldRef fname -> '[ftype, x] :-> '[x]
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)) (RefId -> Var x
forall {k} (a :: k). RefId -> Var a
Var RefId
refId) Expr ftype
e
    setFieldImpl (Decomposed Rec (NamedFieldObj 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 @x @fname @ftype of
      TargetField Label fname1
lb StoreFieldOps x fname ftype
_ ->
        case forall a (name :: Symbol) (f :: Symbol -> *)
       (proxy :: Symbol -> *).
AccessFieldC a name =>
proxy name -> Rec f (ConstructorFieldNames a) -> f name
fetchField @x Label fname1
lb Rec (NamedFieldObj x) (GFieldNames (Rep x))
fields of
          NamedFieldObj Object (GetFieldType x fname1)
field ->
            RefId -> Object ftype -> Expr ftype -> IndigoState inp inp
forall a (inp :: [*]).
RefId -> Object a -> Expr a -> IndigoState inp inp
setVarImpl RefId
nextRef Object ftype
Object (GetFieldType x fname1)
field Expr ftype
e
      DeeperField (Label fname1
lb :: Label fnameInterm) StoreFieldOps x fname ftype
_ ->
        case forall a (name :: Symbol) (f :: Symbol -> *)
       (proxy :: Symbol -> *).
AccessFieldC a name =>
proxy name -> Rec f (ConstructorFieldNames a) -> f name
fetchField @x Label fname1
lb Rec (NamedFieldObj x) (GFieldNames (Rep x))
fields of
          NamedFieldObj Object (GetFieldType x fname1)
vf ->
            forall x.
(IsObject x, HasField x fname ftype) =>
Object x -> IndigoState inp inp
setFieldImpl @(GetFieldType x fnameInterm) Object (GetFieldType x fname1)
vf

-- | Call binary operator with constant argument to update a variable in-place.
updateVar
  :: forall x y inp . (IsObject x, KnownValue y)
  => RefId
  -> [y, x] :-> '[x]
  -> Var x
  -> Expr y
  -> IndigoState inp inp
updateVar :: forall x y (inp :: [*]).
(IsObject x, KnownValue y) =>
RefId
-> ('[y, x] :-> '[x]) -> Var x -> Expr y -> IndigoState inp inp
updateVar RefId
nextRef '[y, x] :-> '[x]
action Var x
vr Expr y
e =
  Text -> IndigoState inp inp -> IndigoState inp inp
forall (inp :: [*]) (out :: [*]).
Text -> IndigoState inp out -> IndigoState inp out
stmtHookState (Text
"updateVar " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Var x -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty Var x
vr Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" with expr " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr y -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty Expr y
e) (IndigoState inp inp -> IndigoState inp inp)
-> IndigoState inp inp -> IndigoState inp inp
forall a b. (a -> b) -> a -> b
$
    Var x -> (Object x -> IndigoState inp inp) -> IndigoState inp inp
forall a (inp :: [*]) (out :: [*]).
KnownValue a =>
Var a -> (Object a -> IndigoState inp out) -> IndigoState inp out
withObjectState Var x
vr Object x -> IndigoState inp inp
updateVarImpl
  where
    updateVarImpl :: Object x -> IndigoState inp inp
updateVarImpl (Cell RefId
refId) = (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 ->
      MetaData inp -> IndigoState inp inp -> GenCode inp inp
forall (inp :: [*]) (out :: [*]).
MetaData inp -> IndigoState inp out -> GenCode inp out
usingIndigoState MetaData inp
md (IndigoState inp inp -> GenCode inp inp)
-> IndigoState inp inp -> GenCode inp inp
forall a b. (a -> b) -> a -> b
$ Expr y -> ((y : inp) :-> inp) -> IndigoState inp inp
forall n (inp :: [*]).
Expr n -> ((n : inp) :-> inp) -> IndigoState inp inp
unaryOpFlat Expr y
e (((y : inp) :-> inp) -> IndigoState inp inp)
-> ((y : inp) :-> inp) -> IndigoState inp inp
forall a b. (a -> b) -> a -> b
$ RefId -> StackVars inp -> ('[y, x] :-> '[x]) -> (y : inp) :-> inp
forall a b (stk :: [*]).
(KnownValue a, KnownValue b) =>
RefId -> StackVars stk -> ('[b, a] :-> '[a]) -> (b : stk) :-> stk
varActionUpdate RefId
refId (MetaData inp -> StackVars inp
forall (inp :: [*]). MetaData inp -> StackVars inp
mdStack MetaData inp
md) '[y, x] :-> '[x]
action
    -- This function doesn't have to be called for complex data types,
    -- it's only supposed to be used for assign-like statements
    -- (+=), (-=), etc but implemented just in case.
    updateVarImpl obj :: Object x
obj@(Decomposed Rec (NamedFieldObj x) (ConstructorFieldNames x)
_) = (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 tmpVar :: Var x
tmpVar = RefId -> Var x
forall {k} (a :: k). RefId -> Var a
Var RefId
nextRef in
      let newMd :: MetaData (x : inp)
newMd = Var x -> MetaData inp -> MetaData (x : inp)
forall a (inp :: [*]).
KnownValue a =>
Var a -> MetaData inp -> MetaData (a : inp)
pushRefMd Var x
tmpVar MetaData inp
md in
      MetaData inp -> IndigoState inp inp -> GenCode inp inp
forall (inp :: [*]) (out :: [*]).
MetaData inp -> IndigoState inp out -> GenCode inp out
usingIndigoState MetaData inp
md (IndigoState inp inp -> GenCode inp inp)
-> IndigoState inp inp -> GenCode inp inp
forall a b. (a -> b) -> a -> b
$ Expr y -> Expr x -> ((y : x : inp) :-> inp) -> IndigoState inp inp
forall n m (inp :: [*]).
Expr n -> Expr m -> ((n : m : inp) :-> inp) -> IndigoState inp inp
binaryOpFlat Expr y
e (Var x -> Expr x
forall a. KnownValue a => Var a -> Expr a
V Var x
vr) (((y : x : inp) :-> inp) -> IndigoState inp inp)
-> ((y : x : inp) :-> inp) -> IndigoState inp inp
forall a b. (a -> b) -> a -> b
$
        ('[y, x] :-> '[x]) -> ('[y, x] ++ inp) :-> ('[x] ++ inp)
forall (s :: [*]) (i :: [*]) (o :: [*]).
(KnownList i, KnownList o) =>
(i :-> o) -> (i ++ s) :-> (o ++ s)
L.framed '[y, x] :-> '[x]
action ((y : x : inp) :-> (x : inp))
-> ((x : inp) :-> (x : inp)) -> (y : x : inp) :-> (x : inp)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#
        GenCode (x : inp) (x : inp) -> (x : inp) :-> (x : inp)
forall (inp :: [*]) (out :: [*]). GenCode inp out -> inp :-> out
gcCode (MetaData (x : inp)
-> IndigoState (x : inp) (x : inp) -> GenCode (x : inp) (x : inp)
forall (inp :: [*]) (out :: [*]).
MetaData inp -> IndigoState inp out -> GenCode inp out
usingIndigoState MetaData (x : inp)
newMd (RefId -> Object x -> Expr x -> IndigoState (x : inp) (x : inp)
forall a (inp :: [*]).
RefId -> Object a -> Expr a -> IndigoState inp inp
setVarImpl (RefId
nextRef RefId -> RefId -> RefId
forall a. Num a => a -> a -> a
+ RefId
1) Object x
obj (Var x -> Expr x
forall a. KnownValue a => Var a -> Expr a
V Var x
tmpVar))) ((y : x : inp) :-> (x : inp))
-> ((x : inp) :-> inp) -> (y : x : inp) :-> inp
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#
        (x : inp) :-> inp
forall a (s :: [*]). (a : s) :-> s
L.drop