Var.hs

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

-- | Backend of the statements to create and modify variables
module Indigo.Backend.Var
  ( newVar
  , setVar
  , setField
  , updateVar
  ) where

import Indigo.Backend.Prelude
import Indigo.Internal
import Indigo.Lorentz
import qualified Lorentz.Instr as L
import Michelson.Typed.Haskell.Instr.Product (GetFieldType)
import Util.Type (type (++))

-- | Create a new variable with passed expression as an initial value.
newVar :: IsExpr ex x => ex -> IndigoState inp (x & inp) (Var x)
newVar e = compileToExpr e >> makeTopVar

-- | 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.
setVar
  :: forall a ex inp . ex :~> a
  => Var a -> ex -> IndigoState inp inp ()
setVar (Cell refId) e = do
  MetaData s _ <- iget
  unaryOpFlat e $ varActionSet refId s
setVar (Decomposed fields) ex = case decomposeExpr (toExpr ex) of
  ExprFields fieldsExpr ->
    rmapZipM (namedToTypedRec @a namedToTypedFieldVar fields) fieldsExpr
  Deconstructed comp ->
    IndigoState $ \md ->
      let GenCode _ decomposeMd decomposeExCd _ = usingIndigoState md comp in
      let setAllFieldsCd = setFieldsOnStack (namedToTypedRec @a namedToTypedFieldVar fields) decomposeMd in
      GenCode () md (decomposeExCd # setAllFieldsCd) L.nop
  where
    -- Set fields, if they are decomposed on stack.
    setFieldsOnStack :: forall rs . Rec TypedFieldVar rs -> MetaData (rs ++ inp) -> (rs ++ inp) :-> inp
    setFieldsOnStack RNil _ = L.nop
    setFieldsOnStack (TypedFieldVar f :& vs) md =
      let (val, setVarMd) = pushRefMd (popNoRefMd md) in
      let setVarCd = gcCode $ usingIndigoState setVarMd $ setVar f (V val) in
      setVarCd #
      L.drop #
      setFieldsOnStack vs (popNoRefMd md)

    -- Take list of fields (variables, referring to them)
    -- and list of corresponding expressions and call 'setVar' recursively.
    rmapZipM :: Rec TypedFieldVar rs -> Rec Expr rs -> IndigoState inp inp ()
    rmapZipM RNil RNil = return ()
    rmapZipM (TypedFieldVar f :& flds) (e :& exprs) = setVar f e >> rmapZipM flds exprs

-- | Set the field (direct or indirect) of a complex object.
setField ::
  forall dt fname ftype ex inp .
  ( ex :~> ftype
  , IsObject dt
  , IsObject ftype
  , HasField dt fname ftype
  )
  => Var dt -> Label fname -> ex -> IndigoState inp inp ()
setField v@(Cell _) lb ex = updateVar (sopSetField (flSFO fieldLens) lb) v ex
setField (Decomposed fields) targetLb ex = case fieldLens @dt @fname @ftype of
  TargetField lb _ ->
    case fetchField @dt lb fields of
      NamedFieldVar v ->
        setVar v ex
  DeeperField (lb :: Label fnameInterm) _ ->
    case fetchField @dt lb fields of
      NamedFieldVar vf ->
        setField @(GetFieldType dt fnameInterm) @fname @ftype vf targetLb ex

-- | Call binary operator with constant argument to update variable in-place.
updateVar
  :: (IsExpr ey y, IsObject x)
  => [y, x] :-> '[x]
  -> Var x
  -> ey
  -> IndigoState inp inp ()
updateVar action (Cell refId) e = do
  MetaData s _ <- iget
  unaryOpFlat e $ varActionUpdate refId s 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 it's implemented just in case.
updateVar action v@(Decomposed _) e = IndigoState $ \md ->
  let (var, newMd) = pushRefMd md in
  usingIndigoState md $ binaryOpFlat e (V v) $
    L.framed action #
    gcCode (usingIndigoState newMd (setVar v (V var))) #
    L.drop