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

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

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

import Fmt (pretty)

import Indigo.Backend.Prelude
import Indigo.Backend.Scope
import Indigo.Internal hiding ((+), (<>))
import Indigo.Lorentz
import qualified Lorentz.Instr as L
import Michelson.Typed.Haskell.Instr.Product (GetFieldType)
import 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 :: Var x -> Expr x -> IndigoState inp (x : inp)
assignVar var :: Var x
var e :: Expr x
e =
  Text -> IndigoState inp (x : inp) -> IndigoState inp (x : inp)
forall (inp :: [*]) (out :: [*]).
Text -> IndigoState inp out -> IndigoState inp out
stmtHookState (RetVars (Var x) -> Text -> Text
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 :: RefId -> Var a -> Expr a -> IndigoState inp inp
setVar nextRef :: RefId
nextRef v :: Var a
v ex :: Expr a
ex = Text -> IndigoState inp inp -> IndigoState inp inp
forall (inp :: [*]) (out :: [*]).
Text -> IndigoState inp out -> IndigoState inp out
stmtHookState (RetVars (Var a) -> Text -> Text
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 :: RefId -> Object a -> Expr a -> IndigoState inp inp
setVarImpl _ (Cell refId :: RefId
refId) ex :: 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 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 nextRef :: RefId
nextRef (Decomposed fields :: Rec (NamedFieldObj a) (ConstructorFieldNames a)
fields) ex :: 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{..} ->
  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 fieldsExpr :: 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 (FieldTypes a)
-> Rec Expr (FieldTypes a) -> IndigoState inp inp
forall (rs :: [*]).
Rec TypedFieldObj rs -> Rec Expr rs -> IndigoState inp inp
rmapZipM ((forall (name :: Symbol).
 NamedFieldObj a name -> TypedFieldObj (GetFieldType a name))
-> Rec (NamedFieldObj a) (ConstructorFieldNames a)
-> Rec TypedFieldObj (FieldTypes a)
forall a (f :: Symbol -> *) (g :: * -> *).
(forall (name :: Symbol). f name -> g (GetFieldType a name))
-> Rec f (ConstructorFieldNames a) -> Rec g (FieldTypes a)
namedToTypedRec @a forall a (name :: Symbol).
NamedFieldObj a name -> TypedFieldObj (GetFieldType a name)
forall (name :: Symbol).
NamedFieldObj a name -> TypedFieldObj (GetFieldType a name)
namedToTypedFieldObj Rec (NamedFieldObj a) (ConstructorFieldNames a)
fields) Rec Expr (FieldTypes a)
fieldsExpr
    Deconstructed comp :: IndigoState inp (FieldTypes a ++ inp)
comp ->
      let GenCode decomposeSt :: StackVars (FieldTypes a ++ inp)
decomposeSt decomposeExCd :: inp :-> (FieldTypes a ++ inp)
decomposeExCd _ = MetaData inp
-> IndigoState inp (FieldTypes a ++ inp)
-> GenCode inp (FieldTypes a ++ inp)
forall (inp :: [*]) (out :: [*]).
MetaData inp -> IndigoState inp out -> GenCode inp out
usingIndigoState MetaData inp
md IndigoState inp (FieldTypes a ++ inp)
comp
          setAllFieldsCd :: (FieldTypes a ++ inp) :-> inp
setAllFieldsCd =
            MetaData (FieldTypes a ++ inp)
-> Rec TypedFieldObj (FieldTypes a)
-> (FieldTypes a ++ inp) :-> inp
forall (rs :: [*]).
MetaData (rs ++ inp) -> Rec TypedFieldObj rs -> (rs ++ inp) :-> inp
setFieldsOnStack
              (StackVars (FieldTypes a ++ inp)
-> DecomposedObjects
-> GenCodeHooks
-> MetaData (FieldTypes a ++ inp)
forall (inp :: [*]).
StackVars inp -> DecomposedObjects -> GenCodeHooks -> MetaData inp
MetaData StackVars (FieldTypes a ++ inp)
decomposeSt DecomposedObjects
mdObjects GenCodeHooks
mdHooks)
              ((forall (name :: Symbol).
 NamedFieldObj a name -> TypedFieldObj (GetFieldType a name))
-> Rec (NamedFieldObj a) (ConstructorFieldNames a)
-> Rec TypedFieldObj (FieldTypes a)
forall a (f :: Symbol -> *) (g :: * -> *).
(forall (name :: Symbol). f name -> g (GetFieldType a name))
-> Rec f (ConstructorFieldNames a) -> Rec g (FieldTypes a)
namedToTypedRec @a forall a (name :: Symbol).
NamedFieldObj a name -> TypedFieldObj (GetFieldType a name)
forall (name :: Symbol).
NamedFieldObj a name -> TypedFieldObj (GetFieldType a name)
namedToTypedFieldObj Rec (NamedFieldObj a) (ConstructorFieldNames 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 :-> (FieldTypes a ++ inp)
decomposeExCd (inp :-> (FieldTypes a ++ inp))
-> ((FieldTypes a ++ inp) :-> inp) -> inp :-> inp
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# (FieldTypes 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 :: MetaData (rs ++ inp) -> Rec TypedFieldObj rs -> (rs ++ inp) :-> inp
setFieldsOnStack _ RNil = (rs ++ inp) :-> inp
forall (s :: [*]). s :-> s
L.nop
    setFieldsOnStack md :: MetaData (rs ++ inp)
md (TypedFieldObj f :: Object r
f :& vs :: 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
+ 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 :: Rec TypedFieldObj rs -> Rec Expr rs -> IndigoState inp inp
rmapZipM RNil RNil = IndigoState inp inp
forall (inp :: [*]). IndigoState inp inp
nopState
    rmapZipM (TypedFieldObj f :: Object r
f :& flds :: Rec TypedFieldObj rs
flds) (e :: Expr r
e :& exprs :: 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 :: RefId -> Var dt -> Label fname -> Expr ftype -> IndigoState inp inp
setField nextRef :: RefId
nextRef v :: Var dt
v targetLb :: Label fname
targetLb e :: Expr ftype
e =
  Text -> IndigoState inp inp -> IndigoState inp inp
forall (inp :: [*]) (out :: [*]).
Text -> IndigoState inp out -> IndigoState inp out
stmtHookState ("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
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
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 :: Object x -> IndigoState inp inp
setFieldImpl (Cell refId :: RefId
refId) = RefId
-> ('[ftype, x] :-> '[x])
-> Var x
-> Expr ftype
-> IndigoState inp inp
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 -> Label fname -> '[ftype, x] :-> '[x]
forall store (fname :: Symbol) ftype.
StoreFieldOps store fname ftype
-> forall (s :: [*]).
   Label fname -> (ftype : store : s) :-> (store : s)
sopSetField (FieldLens x fname ftype -> StoreFieldOps x fname ftype
forall dt (fname :: Symbol) ftype.
FieldLens dt fname ftype -> StoreFieldOps dt fname ftype
flSFO FieldLens x fname ftype
forall dt (fname :: Symbol) ftype.
HasField dt fname ftype =>
FieldLens dt fname ftype
fieldLens) Label fname
targetLb) (RefId -> Var x
forall k (a :: k). RefId -> Var a
Var RefId
refId) Expr ftype
e
    setFieldImpl (Decomposed fields :: Rec (NamedFieldObj x) (ConstructorFieldNames x)
fields) = case HasField x fname ftype => FieldLens x fname ftype
forall dt (fname :: Symbol) ftype.
HasField dt fname ftype =>
FieldLens dt fname ftype
fieldLens @x @fname @ftype of
      TargetField lb :: Label fname
lb _ ->
        case Label fname
-> Rec (NamedFieldObj x) (ConstructorFieldNames x)
-> NamedFieldObj x fname
forall a (name :: Symbol) (f :: Symbol -> *)
       (proxy :: Symbol -> *).
AccessFieldC a name =>
proxy name -> Rec f (ConstructorFieldNames a) -> f name
fetchField @x Label fname
lb Rec (NamedFieldObj x) (ConstructorFieldNames x)
fields of
          NamedFieldObj field :: Object (GetFieldType x fname)
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 fname)
field Expr ftype
e
      DeeperField (Label fname
lb :: Label fnameInterm) _ ->
        case Label fname
-> Rec (NamedFieldObj x) (ConstructorFieldNames x)
-> NamedFieldObj x fname
forall a (name :: Symbol) (f :: Symbol -> *)
       (proxy :: Symbol -> *).
AccessFieldC a name =>
proxy name -> Rec f (ConstructorFieldNames a) -> f name
fetchField @x Label fname
lb Rec (NamedFieldObj x) (ConstructorFieldNames x)
fields of
          NamedFieldObj vf :: Object (GetFieldType x fname)
vf ->
            Object (GetFieldType x fname) -> IndigoState inp inp
forall x.
(IsObject x, HasField x fname ftype) =>
Object x -> IndigoState inp inp
setFieldImpl @(GetFieldType x fnameInterm) Object (GetFieldType x fname)
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 :: RefId
-> ('[y, x] :-> '[x]) -> Var x -> Expr y -> IndigoState inp inp
updateVar nextRef :: RefId
nextRef action :: '[y, x] :-> '[x]
action vr :: Var x
vr e :: Expr y
e =
  Text -> IndigoState inp inp -> IndigoState inp inp
forall (inp :: [*]) (out :: [*]).
Text -> IndigoState inp out -> IndigoState inp out
stmtHookState ("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
<> " 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
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
$ \md :: 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 _) = (MetaData inp -> GenCode inp inp) -> IndigoState inp inp
forall (inp :: [*]) (out :: [*]).
(MetaData inp -> GenCode inp out) -> IndigoState inp out
IndigoState ((MetaData inp -> GenCode inp inp) -> IndigoState inp inp)
-> (MetaData inp -> GenCode inp inp) -> IndigoState inp inp
forall a b. (a -> b) -> a -> b
$ \md :: MetaData inp
md ->
      let 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
+ 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