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

{-# OPTIONS_GHC -Wno-redundant-constraints #-}

-- | Indigo compiler back-end helpers.
--
-- For reference, "back-end" refers to the part of the compiler pipeline
-- that comes after the intermediate representation. In our case, intermediate
-- representation is defined in "Indigo.Frontend.Internal.Statement".
--
-- Essentially these definitions simplify target code generation.
-- This is not intended to be exported from "Indigo".
module Indigo.Backend
  ( module ReExports

  -- * Loop
  , forEach
  , while
  , whileLeft

  -- * Contract call
  , selfCalling
  , contractCalling

  -- * Documentation
  , doc
  , docGroup
  , docStorage
  , contractName
  , finalizeParamCallingDoc
  , contractGeneral
  , contractGeneralDefault

  -- * Side-effects
  , transferTokens
  , setDelegate
  , createContract
  , emit

  -- * Functions, Procedures and Scopes
  , scope

  -- * Comments
  , comment
  ) where

import Indigo.Backend.Case as ReExports
import Indigo.Backend.Conditional as ReExports
import Indigo.Backend.Error as ReExports
import Indigo.Backend.Expr.Compilation as ReExports
import Indigo.Backend.Expr.Decompose as ReExports
import Indigo.Backend.Lambda as ReExports
import Indigo.Backend.Lookup as ReExports
import Indigo.Backend.Scope as ReExports
import Indigo.Backend.Var as ReExports

import Fmt (build, fmt, pretty, (+|), (|+))

import Indigo.Backend.Prelude
import Indigo.Common.Expr (Expr)
import Indigo.Common.SIS
  (SomeGenCode(SomeGenCode), SomeIndigoState(SomeIndigoState), overSIS, runSIS)
import Indigo.Common.State
import Indigo.Common.Var (HasSideEffects, Var, pushNoRef, pushRef)
import Indigo.Lorentz hiding (comment)
import Lorentz.Doc qualified as L
import Lorentz.Entrypoints.Doc qualified as L (finalizeParamCallingDoc)
import Lorentz.Entrypoints.Helpers (RequireSumType)
import Lorentz.Ext qualified as L
import Lorentz.Instr qualified as L
import Lorentz.Run qualified as L
import Morley.Michelson.Typed qualified as MT
import Morley.Michelson.Untyped.Annotation (FieldAnn)
import Morley.Util.Type (type (++))

----------------------------------------------------------------------------
-- Loop
----------------------------------------------------------------------------

-- | While statement.
while
  :: Expr Bool
  -- ^ Expression for the control flow
  -> SomeIndigoState inp
  -- ^ Block of code to execute, as long as the expression holds 'True'
  -> IndigoState inp inp
while :: forall (inp :: [*]).
Expr Bool -> SomeIndigoState inp -> IndigoState inp inp
while Expr Bool
e SomeIndigoState inp
body = (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 expCd :: inp :-> (Bool : inp)
expCd = MetaData inp
-> Text -> (inp :-> (Bool : inp)) -> inp :-> (Bool : inp)
forall (inp :: [*]) (out :: [*]) (any :: [*]).
MetaData any -> Text -> (inp :-> out) -> inp :-> out
exprHook MetaData inp
md (Expr Bool -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty Expr Bool
e) ((inp :-> (Bool : inp)) -> inp :-> (Bool : inp))
-> (inp :-> (Bool : inp)) -> inp :-> (Bool : inp)
forall a b. (a -> b) -> a -> b
$ GenCode inp (Bool : inp) -> inp :-> (Bool : inp)
forall (inp :: [*]) (out :: [*]). GenCode inp out -> inp :-> out
gcCode (GenCode inp (Bool : inp) -> inp :-> (Bool : inp))
-> GenCode inp (Bool : inp) -> inp :-> (Bool : inp)
forall a b. (a -> b) -> a -> b
$ MetaData inp
-> IndigoState inp (Bool : inp) -> GenCode inp (Bool : inp)
forall (inp :: [*]) (out :: [*]).
MetaData inp -> IndigoState inp out -> GenCode inp out
usingIndigoState MetaData inp
md (Expr Bool -> IndigoState inp (Bool : inp)
forall a (inp :: [*]). Expr a -> IndigoState inp (a : inp)
compileExpr Expr Bool
e)
      bodyIndigoState :: inp :-> inp
bodyIndigoState = SomeIndigoState inp
-> MetaData inp
-> (forall (out :: [*]). GenCode inp out -> inp :-> inp)
-> inp :-> inp
forall (inp :: [*]) r.
SomeIndigoState inp
-> MetaData inp -> (forall (out :: [*]). GenCode inp out -> r) -> r
runSIS SomeIndigoState inp
body MetaData inp
md forall (out :: [*]). GenCode inp out -> inp :-> inp
forall (inp :: [*]) (out :: [*]). GenCode inp out -> inp :-> inp
cleanGenCode
  in ((inp :-> inp) -> (inp :-> inp) -> GenCode inp inp)
-> (inp :-> inp) -> (inp :-> inp) -> GenCode inp inp
forall a b c. (a -> b -> c) -> b -> a -> c
flip (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
forall (s :: [*]). s :-> s
L.nop ((inp :-> inp) -> GenCode inp inp)
-> (inp :-> inp) -> GenCode inp inp
forall a b. (a -> b) -> a -> b
$
        MetaData inp -> Text -> (inp :-> inp) -> inp :-> inp
forall (inp :: [*]) (out :: [*]) (any :: [*]).
MetaData any -> Text -> (inp :-> out) -> inp :-> out
stmtHook MetaData inp
md (Text
"while (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr Bool -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty Expr Bool
e Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")") ((inp :-> inp) -> inp :-> inp) -> (inp :-> inp) -> inp :-> inp
forall a b. (a -> b) -> a -> b
$
          inp :-> (Bool : inp)
expCd (inp :-> (Bool : inp)) -> ((Bool : inp) :-> inp) -> inp :-> inp
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#
          (inp :-> (Bool : inp)) -> (Bool : inp) :-> inp
forall (s :: [*]). (s :-> (Bool : s)) -> (Bool : s) :-> s
L.loop (inp :-> inp
bodyIndigoState (inp :-> inp) -> (inp :-> (Bool : inp)) -> inp :-> (Bool : inp)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#
                  inp :-> (Bool : inp)
expCd)

-- | While-left statement. Repeats a block of code as long as the control
-- 'Either' is 'Left', returns when it is 'Right'.
whileLeft
  :: forall l r inp . (KnownValue l, KnownValue r)
  => Expr (Either l r)
  -- ^ Expression for the control flow value
  -> Var l
  -- ^ Variable for the 'Left' value (available to the code block)
  -> SomeIndigoState (l : inp)
  -- ^ Code block to execute while the value is 'Left'
  -> Var r
  -- ^ Variable that will be assigned to the resulting value
  -> IndigoState inp (r : inp)
whileLeft :: forall l r (inp :: [*]).
(KnownValue l, KnownValue r) =>
Expr (Either l r)
-> Var l
-> SomeIndigoState (l : inp)
-> Var r
-> IndigoState inp (r : inp)
whileLeft Expr (Either l r)
e Var l
varL SomeIndigoState (l : inp)
body Var r
varR = (MetaData inp -> GenCode inp (r : inp))
-> IndigoState inp (r : inp)
forall (inp :: [*]) (out :: [*]).
(MetaData inp -> GenCode inp out) -> IndigoState inp out
IndigoState ((MetaData inp -> GenCode inp (r : inp))
 -> IndigoState inp (r : inp))
-> (MetaData inp -> GenCode inp (r : inp))
-> IndigoState inp (r : inp)
forall a b. (a -> b) -> a -> b
$ \MetaData inp
md ->
  let
    cde :: inp :-> (Either l r : inp)
cde = MetaData inp
-> Text
-> (inp :-> (Either l r : inp))
-> inp :-> (Either l r : inp)
forall (inp :: [*]) (out :: [*]) (any :: [*]).
MetaData any -> Text -> (inp :-> out) -> inp :-> out
exprHook MetaData inp
md (Expr (Either l r) -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty Expr (Either l r)
e) ((inp :-> (Either l r : inp)) -> inp :-> (Either l r : inp))
-> (inp :-> (Either l r : inp)) -> inp :-> (Either l r : inp)
forall a b. (a -> b) -> a -> b
$ GenCode inp (Either l r : inp) -> inp :-> (Either l r : inp)
forall (inp :: [*]) (out :: [*]). GenCode inp out -> inp :-> out
gcCode (GenCode inp (Either l r : inp) -> inp :-> (Either l r : inp))
-> GenCode inp (Either l r : inp) -> inp :-> (Either l r : inp)
forall a b. (a -> b) -> a -> b
$ MetaData inp
-> IndigoState inp (Either l r : inp)
-> GenCode inp (Either l r : inp)
forall (inp :: [*]) (out :: [*]).
MetaData inp -> IndigoState inp out -> GenCode inp out
usingIndigoState MetaData inp
md (Expr (Either l r) -> IndigoState inp (Either l r : inp)
forall a (inp :: [*]). Expr a -> IndigoState inp (a : inp)
compileExpr Expr (Either l r)
e)
    newMd :: MetaData (l : inp)
newMd = Var l -> MetaData inp -> MetaData (l : inp)
forall a (inp :: [*]).
KnownValue a =>
Var a -> MetaData inp -> MetaData (a : inp)
pushRefMd Var l
varL MetaData inp
md
    bodyCd :: (l : inp) :-> (l : inp)
bodyCd = SomeIndigoState (l : inp)
-> MetaData (l : inp)
-> (forall (out :: [*]).
    GenCode (l : inp) out -> (l : inp) :-> (l : inp))
-> (l : inp) :-> (l : inp)
forall (inp :: [*]) r.
SomeIndigoState inp
-> MetaData inp -> (forall (out :: [*]). GenCode inp out -> r) -> r
runSIS SomeIndigoState (l : inp)
body MetaData (l : inp)
newMd forall (out :: [*]).
GenCode (l : inp) out -> (l : inp) :-> (l : inp)
forall (inp :: [*]) (out :: [*]). GenCode inp out -> inp :-> inp
cleanGenCode
    resSt :: StackVars (r : inp)
resSt = Var r -> StackVars inp -> StackVars (r : inp)
forall a (inp :: [*]).
KnownValue a =>
Var a -> StackVars inp -> StackVars (a : inp)
pushRef Var r
varR (StackVars inp -> StackVars (r : inp))
-> StackVars inp -> StackVars (r : inp)
forall a b. (a -> b) -> a -> b
$ MetaData inp -> StackVars inp
forall (inp :: [*]). MetaData inp -> StackVars inp
mdStack MetaData inp
md
  in ((inp :-> (r : inp))
 -> ((r : inp) :-> inp) -> GenCode inp (r : inp))
-> ((r : inp) :-> inp)
-> (inp :-> (r : inp))
-> GenCode inp (r : inp)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (StackVars (r : inp)
-> (inp :-> (r : inp))
-> ((r : inp) :-> inp)
-> GenCode inp (r : inp)
forall (inp :: [*]) (out :: [*]).
StackVars out -> (inp :-> out) -> (out :-> inp) -> GenCode inp out
GenCode StackVars (r : inp)
resSt) (r : inp) :-> inp
forall a (s :: [*]). (a : s) :-> s
L.drop ((inp :-> (r : inp)) -> GenCode inp (r : inp))
-> (inp :-> (r : inp)) -> GenCode inp (r : inp)
forall a b. (a -> b) -> a -> b
$
        MetaData inp -> Text -> (inp :-> (r : inp)) -> inp :-> (r : inp)
forall (inp :: [*]) (out :: [*]) (any :: [*]).
MetaData any -> Text -> (inp :-> out) -> inp :-> out
stmtHook MetaData inp
md (forall ret x.
ReturnableValue ret =>
RetVars ret -> Text -> Expr x -> Text
condStmtPretty @(Var r) Var r
RetVars (Var r)
varR Text
"whileLeft" Expr (Either l r)
e) ((inp :-> (r : inp)) -> inp :-> (r : inp))
-> (inp :-> (r : inp)) -> inp :-> (r : inp)
forall a b. (a -> b) -> a -> b
$
          MetaData inp
-> Text
-> (inp :-> (Either l r : inp))
-> inp :-> (Either l r : inp)
forall (inp :: [*]) (out :: [*]) (any :: [*]).
MetaData any -> Text -> (inp :-> out) -> inp :-> out
exprHook MetaData inp
md (Expr (Either l r) -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty Expr (Either l r)
e) inp :-> (Either l r : inp)
cde (inp :-> (Either l r : inp))
-> ((Either l r : inp) :-> (r : inp)) -> inp :-> (r : inp)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#
          ((l : inp) :-> (Either l r : inp))
-> (Either l r : inp) :-> (r : inp)
forall a (s :: [*]) b.
((a : s) :-> (Either a b : s)) -> (Either a b : s) :-> (b : s)
L.loopLeft (MetaData inp
-> Text -> ((l : inp) :-> (l : inp)) -> (l : inp) :-> (l : inp)
forall (inp :: [*]) (out :: [*]) (any :: [*]).
MetaData any -> Text -> (inp :-> out) -> inp :-> out
auxiliaryHook MetaData inp
md (Text
"body: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Var l -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty Var l
varL Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":= fromLeft " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr (Either l r) -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty Expr (Either l r)
e) (l : inp) :-> (l : inp)
bodyCd ((l : inp) :-> (l : inp))
-> ((l : inp) :-> inp) -> (l : inp) :-> inp
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#
                      (l : inp) :-> inp
forall a (s :: [*]). (a : s) :-> s
L.drop ((l : inp) :-> inp)
-> (inp :-> (Either l r : inp)) -> (l : inp) :-> (Either l r : inp)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#
                      inp :-> (Either l r : inp)
cde)

-- | For statements to iterate over a container.
forEach
  :: (IterOpHs a, KnownValue (IterOpElHs a))
  => Expr a
  -- ^ Expression for the container to traverse
  -> Var (IterOpElHs a)
  -- ^ Variable for the current item (available to the code block)
  -> SomeIndigoState ((IterOpElHs a) : inp)
  -- ^ Code block to execute over each element of the container
  -> IndigoState inp inp
forEach :: forall a (inp :: [*]).
(IterOpHs a, KnownValue (IterOpElHs a)) =>
Expr a
-> Var (IterOpElHs a)
-> SomeIndigoState (IterOpElHs a : inp)
-> IndigoState inp inp
forEach Expr a
container Var (IterOpElHs a)
var SomeIndigoState (IterOpElHs a : inp)
body = (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 cde :: inp :-> (a : inp)
cde = GenCode inp (a : inp) -> inp :-> (a : inp)
forall (inp :: [*]) (out :: [*]). GenCode inp out -> inp :-> out
gcCode (GenCode inp (a : inp) -> inp :-> (a : inp))
-> GenCode inp (a : inp) -> inp :-> (a : inp)
forall a b. (a -> b) -> a -> b
$ 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 (Expr a -> IndigoState inp (a : inp)
forall a (inp :: [*]). Expr a -> IndigoState inp (a : inp)
compileExpr Expr a
container)
      newMd :: MetaData (IterOpElHs a : inp)
newMd = Var (IterOpElHs a) -> MetaData inp -> MetaData (IterOpElHs a : inp)
forall a (inp :: [*]).
KnownValue a =>
Var a -> MetaData inp -> MetaData (a : inp)
pushRefMd Var (IterOpElHs a)
var MetaData inp
md
      bodyIndigoState :: (IterOpElHs a : inp) :-> (IterOpElHs a : inp)
bodyIndigoState = SomeIndigoState (IterOpElHs a : inp)
-> MetaData (IterOpElHs a : inp)
-> (forall (out :: [*]).
    GenCode (IterOpElHs a : inp) out
    -> (IterOpElHs a : inp) :-> (IterOpElHs a : inp))
-> (IterOpElHs a : inp) :-> (IterOpElHs a : inp)
forall (inp :: [*]) r.
SomeIndigoState inp
-> MetaData inp -> (forall (out :: [*]). GenCode inp out -> r) -> r
runSIS SomeIndigoState (IterOpElHs a : inp)
body MetaData (IterOpElHs a : inp)
newMd forall (out :: [*]).
GenCode (IterOpElHs a : inp) out
-> (IterOpElHs a : inp) :-> (IterOpElHs a : inp)
forall (inp :: [*]) (out :: [*]). GenCode inp out -> inp :-> inp
cleanGenCode
  in ((inp :-> inp) -> (inp :-> inp) -> GenCode inp inp)
-> (inp :-> inp) -> (inp :-> inp) -> GenCode inp inp
forall a b c. (a -> b -> c) -> b -> a -> c
flip (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
forall (s :: [*]). s :-> s
L.nop ((inp :-> inp) -> GenCode inp inp)
-> (inp :-> inp) -> GenCode inp inp
forall a b. (a -> b) -> a -> b
$ MetaData inp -> Text -> (inp :-> inp) -> inp :-> inp
forall (inp :: [*]) (out :: [*]) (any :: [*]).
MetaData any -> Text -> (inp :-> out) -> inp :-> out
stmtHook MetaData inp
md (Builder -> Text
forall b. FromBuilder b => Builder -> b
fmt (Builder -> Text) -> Builder -> Text
forall a b. (a -> b) -> a -> b
$ Builder
"foreach (" Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Var (IterOpElHs a)
var Var (IterOpElHs a) -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
" in " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Expr a
container Expr a -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
")") ((inp :-> inp) -> inp :-> inp) -> (inp :-> inp) -> inp :-> inp
forall a b. (a -> b) -> a -> b
$
        MetaData inp -> Text -> (inp :-> (a : inp)) -> inp :-> (a : inp)
forall (inp :: [*]) (out :: [*]) (any :: [*]).
MetaData any -> Text -> (inp :-> out) -> inp :-> out
exprHook MetaData inp
md (Expr a -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty Expr a
container) inp :-> (a : inp)
cde (inp :-> (a : inp)) -> ((a : inp) :-> inp) -> inp :-> inp
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#
        ((IterOpElHs a : inp) :-> inp) -> (a : inp) :-> inp
forall c (s :: [*]).
(IterOpHs c, HasCallStack) =>
((IterOpElHs c : s) :-> s) -> (c : s) :-> s
L.iter ((IterOpElHs a : inp) :-> (IterOpElHs a : inp)
bodyIndigoState ((IterOpElHs a : inp) :-> (IterOpElHs a : inp))
-> ((IterOpElHs a : inp) :-> inp) -> (IterOpElHs a : inp) :-> inp
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# (IterOpElHs a : inp) :-> inp
forall a (s :: [*]). (a : s) :-> s
L.drop)

----------------------------------------------------------------------------
-- Documentation
----------------------------------------------------------------------------

-- | Put a document item.
doc :: DocItem di => di -> IndigoState s s
doc :: forall di (s :: [*]). DocItem di => di -> IndigoState s s
doc di
di = (MetaData s -> GenCode s s) -> IndigoState s s
forall (inp :: [*]) (out :: [*]).
(MetaData inp -> GenCode inp out) -> IndigoState inp out
IndigoState \MetaData s
md -> StackVars s -> (s :-> s) -> (s :-> s) -> GenCode s s
forall (inp :: [*]) (out :: [*]).
StackVars out -> (inp :-> out) -> (out :-> inp) -> GenCode inp out
GenCode (MetaData s -> StackVars s
forall (inp :: [*]). MetaData inp -> StackVars inp
mdStack MetaData s
md) (di -> s :-> s
forall di (s :: [*]). DocItem di => di -> s :-> s
L.doc di
di) s :-> s
forall (s :: [*]). s :-> s
L.nop

-- | Group documentation built in the given piece of code
-- into a block dedicated to one thing, e.g. to one entrypoint.
docGroup :: DocItem di => (SubDoc -> di) -> SomeIndigoState i -> SomeIndigoState i
docGroup :: forall di (i :: [*]).
DocItem di =>
(SubDoc -> di) -> SomeIndigoState i -> SomeIndigoState i
docGroup SubDoc -> di
gr = (forall (out :: [*]). GenCode i out -> SomeGenCode i)
-> SomeIndigoState i -> SomeIndigoState i
forall (inp :: [*]).
(forall (out :: [*]). GenCode inp out -> SomeGenCode inp)
-> SomeIndigoState inp -> SomeIndigoState inp
overSIS ((forall (out :: [*]). GenCode i out -> SomeGenCode i)
 -> SomeIndigoState i -> SomeIndigoState i)
-> (forall (out :: [*]). GenCode i out -> SomeGenCode i)
-> SomeIndigoState i
-> SomeIndigoState i
forall a b. (a -> b) -> a -> b
$ \(GenCode StackVars out
md i :-> out
cd out :-> i
clr) -> GenCode i out -> SomeGenCode i
forall (inp :: [*]) (out :: [*]).
GenCode inp out -> SomeGenCode inp
SomeGenCode (GenCode i out -> SomeGenCode i) -> GenCode i out -> SomeGenCode i
forall a b. (a -> b) -> a -> b
$
  StackVars out -> (i :-> out) -> (out :-> i) -> GenCode i out
forall (inp :: [*]) (out :: [*]).
StackVars out -> (inp :-> out) -> (out :-> inp) -> GenCode inp out
GenCode StackVars out
md ((SubDoc -> di) -> (i :-> out) -> i :-> out
forall di (inp :: [*]) (out :: [*]).
DocItem di =>
(SubDoc -> di) -> (inp :-> out) -> inp :-> out
L.docGroup SubDoc -> di
gr i :-> out
cd) out :-> i
clr

-- | Insert documentation of the contract storage type. The type
-- should be passed using type applications.
{-# DEPRECATED docStorage "Use `doc (dStorage @storage)` instead." #-}
docStorage :: forall storage s. TypeHasDoc storage => IndigoState s s
docStorage :: forall storage (s :: [*]). TypeHasDoc storage => IndigoState s s
docStorage = DStorageType -> IndigoState s s
forall di (s :: [*]). DocItem di => di -> IndigoState s s
doc (forall store. TypeHasDoc store => DStorageType
dStorage @storage)

-- | Give a name to the given contract. Apply it to the whole contract code.
{-# DEPRECATED contractName "Use `docGroup name` instead." #-}
contractName :: Text -> SomeIndigoState i -> SomeIndigoState i
contractName :: forall (i :: [*]). Text -> SomeIndigoState i -> SomeIndigoState i
contractName Text
cName = (SubDoc -> DName) -> SomeIndigoState i -> SomeIndigoState i
forall di (i :: [*]).
DocItem di =>
(SubDoc -> di) -> SomeIndigoState i -> SomeIndigoState i
docGroup (Text -> SubDoc -> DName
DName Text
cName)

-- | Attach general info to the given contract.
{-# DEPRECATED contractGeneral "Use `docGroup DGeneralInfoSection` instead." #-}
contractGeneral :: SomeIndigoState i -> SomeIndigoState i
contractGeneral :: forall (i :: [*]). SomeIndigoState i -> SomeIndigoState i
contractGeneral = (SubDoc -> DGeneralInfoSection)
-> SomeIndigoState i -> SomeIndigoState i
forall di (i :: [*]).
DocItem di =>
(SubDoc -> di) -> SomeIndigoState i -> SomeIndigoState i
docGroup SubDoc -> DGeneralInfoSection
DGeneralInfoSection

-- | Attach default general info to the contract documentation.
contractGeneralDefault :: IndigoState s s
contractGeneralDefault :: forall (s :: [*]). IndigoState s s
contractGeneralDefault = (MetaData s -> GenCode s s) -> IndigoState s s
forall (inp :: [*]) (out :: [*]).
(MetaData inp -> GenCode inp out) -> IndigoState inp out
IndigoState \MetaData s
md -> StackVars s -> (s :-> s) -> (s :-> s) -> GenCode s s
forall (inp :: [*]) (out :: [*]).
StackVars out -> (inp :-> out) -> (out :-> inp) -> GenCode inp out
GenCode (MetaData s -> StackVars s
forall (inp :: [*]). MetaData inp -> StackVars inp
mdStack MetaData s
md) s :-> s
forall (s :: [*]). s :-> s
L.contractGeneralDefault s :-> s
forall (s :: [*]). s :-> s
L.nop

-- | Indigo version for the function of the same name from Lorentz.
finalizeParamCallingDoc
  :: (NiceParameterFull cp, RequireSumType cp, HasCallStack)
  => Var cp
  -> SomeIndigoState (cp : inp)
  -> Expr cp
  -> SomeIndigoState inp
finalizeParamCallingDoc :: forall cp (inp :: [*]).
(NiceParameterFull cp, RequireSumType cp, HasCallStack) =>
Var cp
-> SomeIndigoState (cp : inp) -> Expr cp -> SomeIndigoState inp
finalizeParamCallingDoc Var cp
vc SomeIndigoState (cp : inp)
act Expr cp
param = (MetaData inp -> SomeGenCode inp) -> SomeIndigoState inp
forall (inp :: [*]).
(MetaData inp -> SomeGenCode inp) -> SomeIndigoState inp
SomeIndigoState ((MetaData inp -> SomeGenCode inp) -> SomeIndigoState inp)
-> (MetaData inp -> SomeGenCode inp) -> SomeIndigoState inp
forall a b. (a -> b) -> a -> b
$ \MetaData inp
md ->
  let cde :: inp :-> (cp : inp)
cde = GenCode inp (cp : inp) -> inp :-> (cp : inp)
forall (inp :: [*]) (out :: [*]). GenCode inp out -> inp :-> out
gcCode (GenCode inp (cp : inp) -> inp :-> (cp : inp))
-> GenCode inp (cp : inp) -> inp :-> (cp : inp)
forall a b. (a -> b) -> a -> b
$ MetaData inp
-> IndigoState inp (cp : inp) -> GenCode inp (cp : inp)
forall (inp :: [*]) (out :: [*]).
MetaData inp -> IndigoState inp out -> GenCode inp out
usingIndigoState MetaData inp
md (Expr cp -> IndigoState inp (cp : inp)
forall a (inp :: [*]). Expr a -> IndigoState inp (a : inp)
compileExpr Expr cp
param)
      newMd :: MetaData (cp : inp)
newMd = Var cp -> MetaData inp -> MetaData (cp : inp)
forall a (inp :: [*]).
KnownValue a =>
Var a -> MetaData inp -> MetaData (a : inp)
pushRefMd Var cp
vc MetaData inp
md
  in SomeIndigoState (cp : inp)
-> MetaData (cp : inp)
-> (forall (out :: [*]). GenCode (cp : inp) out -> SomeGenCode inp)
-> SomeGenCode inp
forall (inp :: [*]) r.
SomeIndigoState inp
-> MetaData inp -> (forall (out :: [*]). GenCode inp out -> r) -> r
runSIS SomeIndigoState (cp : inp)
act MetaData (cp : inp)
newMd ((forall (out :: [*]). GenCode (cp : inp) out -> SomeGenCode inp)
 -> SomeGenCode inp)
-> (forall (out :: [*]). GenCode (cp : inp) out -> SomeGenCode inp)
-> SomeGenCode inp
forall a b. (a -> b) -> a -> b
$ \(GenCode StackVars out
st1 (cp : inp) :-> out
cd out :-> (cp : inp)
clr) ->
    GenCode inp out -> SomeGenCode inp
forall (inp :: [*]) (out :: [*]).
GenCode inp out -> SomeGenCode inp
SomeGenCode (GenCode inp out -> SomeGenCode inp)
-> GenCode inp out -> SomeGenCode inp
forall a b. (a -> b) -> a -> b
$ ((inp :-> out) -> (out :-> inp) -> GenCode inp out)
-> (out :-> inp) -> (inp :-> out) -> GenCode inp out
forall a b c. (a -> b -> c) -> b -> a -> c
flip (StackVars out -> (inp :-> out) -> (out :-> inp) -> GenCode inp out
forall (inp :: [*]) (out :: [*]).
StackVars out -> (inp :-> out) -> (out :-> inp) -> GenCode inp out
GenCode StackVars out
st1) (out :-> (cp : inp)
clr (out :-> (cp : inp)) -> ((cp : inp) :-> inp) -> out :-> inp
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# (cp : inp) :-> inp
forall a (s :: [*]). (a : s) :-> s
L.drop) ((inp :-> out) -> GenCode inp out)
-> (inp :-> out) -> GenCode inp out
forall a b. (a -> b) -> a -> b
$
    MetaData inp -> Text -> (inp :-> out) -> inp :-> out
forall (inp :: [*]) (out :: [*]) (any :: [*]).
MetaData any -> Text -> (inp :-> out) -> inp :-> out
stmtHook MetaData inp
md (Text
"finalizeParamCallingDoc (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr cp -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty Expr cp
param Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")") ((inp :-> out) -> inp :-> out) -> (inp :-> out) -> inp :-> out
forall a b. (a -> b) -> a -> b
$
      MetaData inp -> Text -> (inp :-> (cp : inp)) -> inp :-> (cp : inp)
forall (inp :: [*]) (out :: [*]) (any :: [*]).
MetaData any -> Text -> (inp :-> out) -> inp :-> out
exprHook MetaData inp
md (Expr cp -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty Expr cp
param) inp :-> (cp : inp)
cde (inp :-> (cp : inp)) -> ((cp : inp) :-> out) -> inp :-> out
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#
      ((cp : inp) :-> out) -> (cp : inp) :-> out
forall cp (inp :: [*]) (out :: [*]).
(NiceParameterFull cp, RequireSumType cp, HasCallStack) =>
((cp : inp) :-> out) -> (cp : inp) :-> out
L.finalizeParamCallingDoc (cp : inp) :-> out
cd

----------------------------------------------------------------------------
-- Contract call
----------------------------------------------------------------------------

selfCalling
  :: forall p inp mname.
     ( NiceParameterFull p
     , KnownValue (GetEntrypointArgCustom p mname)
     , IsoValue (ContractRef (GetEntrypointArgCustom p mname))
     , IsNotInView
     )
  => EntrypointRef mname
  -> Var (ContractRef (GetEntrypointArgCustom p mname))
  -- ^ Variable that will be assigned to the resulting 'ContractRef'
  -> IndigoState inp (ContractRef (GetEntrypointArgCustom p mname) : inp)
selfCalling :: forall p (inp :: [*]) (mname :: Maybe Symbol).
(NiceParameterFull p, KnownValue (GetEntrypointArgCustom p mname),
 IsoValue (ContractRef (GetEntrypointArgCustom p mname)),
 IsNotInView) =>
EntrypointRef mname
-> Var (ContractRef (GetEntrypointArgCustom p mname))
-> IndigoState
     inp (ContractRef (GetEntrypointArgCustom p mname) : inp)
selfCalling EntrypointRef mname
epRef Var (ContractRef (GetEntrypointArgCustom p mname))
var = Text
-> IndigoState
     inp (ContractRef (GetEntrypointArgCustom p mname) : inp)
-> IndigoState
     inp (ContractRef (GetEntrypointArgCustom p mname) : inp)
forall (inp :: [*]) (out :: [*]).
Text -> IndigoState inp out -> IndigoState inp out
stmtHookState (Var (ContractRef (GetEntrypointArgCustom p mname)) -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty Var (ContractRef (GetEntrypointArgCustom p mname))
var Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" := selfCalling " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> EpName -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty (EntrypointRef mname -> EpName
forall (mname :: Maybe Symbol). EntrypointRef mname -> EpName
eprName EntrypointRef mname
epRef)) (IndigoState
   inp (ContractRef (GetEntrypointArgCustom p mname) : inp)
 -> IndigoState
      inp (ContractRef (GetEntrypointArgCustom p mname) : inp))
-> IndigoState
     inp (ContractRef (GetEntrypointArgCustom p mname) : inp)
-> IndigoState
     inp (ContractRef (GetEntrypointArgCustom p mname) : inp)
forall a b. (a -> b) -> a -> b
$ do
  (inp :-> (ContractRef (GetEntrypointArgCustom p mname) : inp))
-> IndigoState
     inp (ContractRef (GetEntrypointArgCustom p mname) : inp)
forall res (inp :: [*]).
KnownValue res =>
(inp :-> (res : inp)) -> IndigoState inp (res : inp)
nullaryOp (forall p (mname :: Maybe Symbol) (s :: [*]).
(NiceParameterFull p, IsNotInView) =>
EntrypointRef mname
-> s :-> (ContractRef (GetEntrypointArgCustom p mname) : s)
L.selfCalling @p EntrypointRef mname
epRef)
  Var (ContractRef (GetEntrypointArgCustom p mname))
-> IndigoState
     (ContractRef (GetEntrypointArgCustom p mname) : inp)
     (ContractRef (GetEntrypointArgCustom p mname) : inp)
forall x (inp :: [*]).
KnownValue x =>
Var x -> IndigoState (x : inp) (x : inp)
assignTopVar Var (ContractRef (GetEntrypointArgCustom p mname))
var

contractCalling
  :: forall cp vd inp epRef epArg addr.
     ( HasEntrypointArg cp epRef epArg
     , ToTAddress cp vd addr
     , ToT addr ~ ToT Address
     , MT.HasNoOp (ToT epArg)
     , MT.HasNoNestedBigMaps (ToT epArg)
     , KnownValue epArg
     )
  => epRef
  -> Expr addr
  -> Var (Maybe (ContractRef epArg))
  -- ^ Variable that will be assigned to the resulting 'ContractRef'
  -> IndigoState inp (Maybe (ContractRef epArg) : inp)
contractCalling :: forall cp vd (inp :: [*]) epRef epArg addr.
(HasEntrypointArg cp epRef epArg, ToTAddress cp vd addr,
 ToT addr ~ ToT Address, HasNoOp (ToT epArg),
 HasNoNestedBigMaps (ToT epArg), KnownValue epArg) =>
epRef
-> Expr addr
-> Var (Maybe (ContractRef epArg))
-> IndigoState inp (Maybe (ContractRef epArg) : inp)
contractCalling epRef
epRef Expr addr
addr Var (Maybe (ContractRef epArg))
var = Text
-> IndigoState inp (Maybe (ContractRef epArg) : inp)
-> IndigoState inp (Maybe (ContractRef epArg) : inp)
forall (inp :: [*]) (out :: [*]).
Text -> IndigoState inp out -> IndigoState inp out
stmtHookState (Var (Maybe (ContractRef epArg)) -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty Var (Maybe (ContractRef epArg))
var Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" := contractCalling " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr addr -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty Expr addr
addr) (IndigoState inp (Maybe (ContractRef epArg) : inp)
 -> IndigoState inp (Maybe (ContractRef epArg) : inp))
-> IndigoState inp (Maybe (ContractRef epArg) : inp)
-> IndigoState inp (Maybe (ContractRef epArg) : inp)
forall a b. (a -> b) -> a -> b
$ do
  Expr addr
-> ((addr : inp) :-> (Maybe (ContractRef epArg) : inp))
-> IndigoState inp (Maybe (ContractRef epArg) : inp)
forall res n (inp :: [*]).
KnownValue res =>
Expr n
-> ((n : inp) :-> (res : inp)) -> IndigoState inp (res : inp)
unaryOp Expr addr
addr (forall cp epRef epArg addr vd (s :: [*]).
(HasEntrypointArg cp epRef epArg, ToTAddress_ cp vd addr) =>
epRef -> (addr : s) :-> (Maybe (ContractRef epArg) : s)
L.contractCalling @cp @_ @_ @_ @vd epRef
epRef)
  Var (Maybe (ContractRef epArg))
-> IndigoState
     (Maybe (ContractRef epArg) : inp) (Maybe (ContractRef epArg) : inp)
forall x (inp :: [*]).
KnownValue x =>
Var x -> IndigoState (x : inp) (x : inp)
assignTopVar Var (Maybe (ContractRef epArg))
var

----------------------------------------------------------------------------
-- Side-effects
----------------------------------------------------------------------------

transferTokens
  :: (NiceParameter p, HasSideEffects, IsNotInView)
  => Expr p -> Expr Mutez -> Expr (ContractRef p)
  -> IndigoState inp inp
transferTokens :: forall p (inp :: [*]).
(NiceParameter p, HasSideEffects, IsNotInView) =>
Expr p -> Expr Mutez -> Expr (ContractRef p) -> IndigoState inp inp
transferTokens Expr p
ep Expr Mutez
em Expr (ContractRef p)
ec = (StackVars inp -> IndigoState inp inp) -> IndigoState inp inp
forall (inp :: [*]) (out :: [*]).
(StackVars inp -> IndigoState inp out) -> IndigoState inp out
withStackVars ((StackVars inp -> IndigoState inp inp) -> IndigoState inp inp)
-> (StackVars inp -> IndigoState inp inp) -> IndigoState inp inp
forall a b. (a -> b) -> a -> b
$ \StackVars inp
s ->
  Expr p
-> Expr Mutez
-> Expr (ContractRef p)
-> ((p : Mutez : ContractRef p : inp) :-> inp)
-> IndigoState inp inp
forall n m l (inp :: [*]).
Expr n
-> Expr m
-> Expr l
-> ((n : m : l : inp) :-> inp)
-> IndigoState inp inp
ternaryOpFlat Expr p
ep Expr Mutez
em Expr (ContractRef p)
ec ((p : Mutez : ContractRef p : inp) :-> (Operation : inp)
forall p (s :: [*]).
(NiceParameter p, IsNotInView) =>
(p : Mutez : ContractRef p : s) :-> (Operation : s)
L.transferTokens ((p : Mutez : ContractRef p : inp) :-> (Operation : inp))
-> ((Operation : inp) :-> inp)
-> (p : Mutez : ContractRef p : inp) :-> inp
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# StackVars inp -> (Operation : inp) :-> inp
forall (stk :: [*]).
HasSideEffects =>
StackVars stk -> (Operation : stk) :-> stk
varActionOperation StackVars inp
s)

setDelegate :: (HasSideEffects, IsNotInView) => Expr (Maybe KeyHash) -> IndigoState inp inp
setDelegate :: forall (inp :: [*]).
(HasSideEffects, IsNotInView) =>
Expr (Maybe KeyHash) -> IndigoState inp inp
setDelegate Expr (Maybe KeyHash)
e = (StackVars inp -> IndigoState inp inp) -> IndigoState inp inp
forall (inp :: [*]) (out :: [*]).
(StackVars inp -> IndigoState inp out) -> IndigoState inp out
withStackVars ((StackVars inp -> IndigoState inp inp) -> IndigoState inp inp)
-> (StackVars inp -> IndigoState inp inp) -> IndigoState inp inp
forall a b. (a -> b) -> a -> b
$ \StackVars inp
s ->
  Expr (Maybe KeyHash)
-> ((Maybe KeyHash : inp) :-> inp) -> IndigoState inp inp
forall n (inp :: [*]).
Expr n -> ((n : inp) :-> inp) -> IndigoState inp inp
unaryOpFlat Expr (Maybe KeyHash)
e ((Maybe KeyHash : inp) :-> (Operation : inp)
forall (s :: [*]).
IsNotInView =>
(Maybe KeyHash : s) :-> (Operation : s)
L.setDelegate ((Maybe KeyHash : inp) :-> (Operation : inp))
-> ((Operation : inp) :-> inp) -> (Maybe KeyHash : inp) :-> inp
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# StackVars inp -> (Operation : inp) :-> inp
forall (stk :: [*]).
HasSideEffects =>
StackVars stk -> (Operation : stk) :-> stk
varActionOperation StackVars inp
s)

createContract
  :: ( HasSideEffects, NiceStorage s, NiceParameterFull p
     , NiceViewsDescriptor vd, Typeable vd, IsNotInView
     )
  => L.Contract p s vd
  -> Expr (Maybe KeyHash)
  -> Expr Mutez
  -> Expr s
  -> Var Address
  -- ^ Variable that will be assigned to the resulting 'Address'
  -> IndigoState inp (Address : inp)
createContract :: forall s p vd (inp :: [*]).
(HasSideEffects, NiceStorage s, NiceParameterFull p,
 NiceViewsDescriptor vd, Typeable vd, IsNotInView) =>
Contract p s vd
-> Expr (Maybe KeyHash)
-> Expr Mutez
-> Expr s
-> Var Address
-> IndigoState inp (Address : inp)
createContract Contract p s vd
lCtr Expr (Maybe KeyHash)
ek Expr Mutez
em Expr s
es Var Address
var = Text
-> IndigoState inp (Address : inp)
-> IndigoState inp (Address : inp)
forall (inp :: [*]) (out :: [*]).
Text -> IndigoState inp out -> IndigoState inp out
stmtHookState
  (Builder -> Text
forall b. FromBuilder b => Builder -> b
fmt (Builder -> Text) -> Builder -> Text
forall a b. (a -> b) -> a -> b
$ Var Address -> Builder
forall p. Buildable p => p -> Builder
build Var Address
var Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Builder
" := createContract (key_hash = " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Expr (Maybe KeyHash)
ek Expr (Maybe KeyHash) -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
", mutez = " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Expr Mutez
em Expr Mutez -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
", storage = " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Expr s -> Builder
forall p. Buildable p => p -> Builder
build Expr s
es) (IndigoState inp (Address : inp)
 -> IndigoState inp (Address : inp))
-> IndigoState inp (Address : inp)
-> IndigoState inp (Address : inp)
forall a b. (a -> b) -> a -> b
$ do
    (StackVars inp -> IndigoState inp (Address : inp))
-> IndigoState inp (Address : inp)
forall (inp :: [*]) (out :: [*]).
(StackVars inp -> IndigoState inp out) -> IndigoState inp out
withStackVars ((StackVars inp -> IndigoState inp (Address : inp))
 -> IndigoState inp (Address : inp))
-> (StackVars inp -> IndigoState inp (Address : inp))
-> IndigoState inp (Address : inp)
forall a b. (a -> b) -> a -> b
$ \StackVars inp
s ->
      Expr (Maybe KeyHash)
-> Expr Mutez
-> Expr s
-> ((Maybe KeyHash : Mutez : s : inp) :-> (Address : inp))
-> IndigoState inp (Address : 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 (Maybe KeyHash)
ek Expr Mutez
em Expr s
es (((Maybe KeyHash : Mutez : s : inp) :-> (Address : inp))
 -> IndigoState inp (Address : inp))
-> ((Maybe KeyHash : Mutez : s : inp) :-> (Address : inp))
-> IndigoState inp (Address : inp)
forall a b. (a -> b) -> a -> b
$ Contract p s vd
-> (Maybe KeyHash : Mutez : s : inp)
   :-> (Operation : TAddress p vd : inp)
forall p g vd (s :: [*]).
IsNotInView =>
Contract p g vd
-> (Maybe KeyHash : Mutez : g : s)
   :-> (Operation : TAddress p vd : s)
L.createContract Contract p s vd
lCtr ((Maybe KeyHash : Mutez : s : inp)
 :-> (Operation : TAddress p vd : inp))
-> ((Operation : TAddress p vd : inp) :-> (TAddress p vd : inp))
-> (Maybe KeyHash : Mutez : s : inp) :-> (TAddress p vd : inp)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# StackVars (TAddress p vd : inp)
-> (Operation : TAddress p vd : inp) :-> (TAddress p vd : inp)
forall (stk :: [*]).
HasSideEffects =>
StackVars stk -> (Operation : stk) :-> stk
varActionOperation (StackVars inp -> StackVars (TAddress p vd : inp)
forall a (inp :: [*]).
KnownValue a =>
StackVars inp -> StackVars (a : inp)
pushNoRef StackVars inp
s) ((Maybe KeyHash : Mutez : s : inp) :-> (TAddress p vd : inp))
-> ((TAddress p vd : inp) :-> (Address : inp))
-> (Maybe KeyHash : Mutez : s : inp) :-> (Address : inp)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# (TAddress p vd : inp) :-> (Address : inp)
forall a b (s :: [*]). Castable_ a b => (a : s) :-> (b : s)
checkedCoerce_
    Var Address -> IndigoState (Address : inp) (Address : inp)
forall x (inp :: [*]).
KnownValue x =>
Var x -> IndigoState (x : inp) (x : inp)
assignTopVar Var Address
var

emit
  :: (HasSideEffects, NicePackedValue a, HasAnnotation a)
  => FieldAnn -> Expr a -> IndigoState inp inp
emit :: forall a (inp :: [*]).
(HasSideEffects, NicePackedValue a, HasAnnotation a) =>
FieldAnn -> Expr a -> IndigoState inp inp
emit FieldAnn
tag Expr a
ex = (StackVars inp -> IndigoState inp inp) -> IndigoState inp inp
forall (inp :: [*]) (out :: [*]).
(StackVars inp -> IndigoState inp out) -> IndigoState inp out
withStackVars ((StackVars inp -> IndigoState inp inp) -> IndigoState inp inp)
-> (StackVars inp -> IndigoState inp inp) -> IndigoState inp inp
forall a b. (a -> b) -> a -> b
$ \StackVars inp
s ->
  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
$ FieldAnn -> (a : inp) :-> (Operation : inp)
forall t (s :: [*]).
(NicePackedValue t, HasAnnotation t) =>
FieldAnn -> (t : s) :-> (Operation : s)
L.emit FieldAnn
tag ((a : inp) :-> (Operation : inp))
-> ((Operation : inp) :-> inp) -> (a : inp) :-> inp
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# StackVars inp -> (Operation : inp) :-> inp
forall (stk :: [*]).
HasSideEffects =>
StackVars stk -> (Operation : stk) :-> stk
varActionOperation StackVars inp
s

----------------------------------------------------------------------------
-- Functions, Procedures and Scopes
----------------------------------------------------------------------------

-- | Takes an arbitrary 'IndigoM' and wraps it into an 'IndigoFunction'
-- producing a local scope for its execution. Once it executed, all
-- non-returned variables are cleaned up so that the stack has only
-- returned variables at the top. This also can be interpreted as
-- @if True then f else nop@.
--
-- Note, that by default we do not define scope inside indigo functions,
-- meaning that once we want to create a new variable or return it from
-- a function we need to do it inside @scope $ instr@ construction, for
-- example:
--
-- @
-- f :: IndigoFunction s Natural
-- f = scope $ do
--   *[s]*
--   res <- newVar (0 :: Natural)
--   *[Natural, s]*
--   scope $ do
--     _n <- newVar (1 :: Integer)
--     *[Integer, Natural, s]
--     res += 4
--   *[Natural, s]*
--   return res
--   *[s]*
-- @
scope
  :: forall ret inp . ScopeCodeGen ret
  => SomeIndigoState inp
  -- ^ Code block to execute inside the scope
  -> ret
  -- ^ Return value(s) of the scoped code block
  -> RetVars ret
  -- ^ Variable(s) that will be assigned to the resulting value(s)
  -> IndigoState inp (RetOutStack ret ++ inp)
scope :: forall ret (inp :: [*]).
ScopeCodeGen ret =>
SomeIndigoState inp
-> ret -> RetVars ret -> IndigoState inp (RetOutStack ret ++ inp)
scope SomeIndigoState inp
f ret
ret RetVars ret
retVars = (MetaData inp
 -> GenCode inp (RetOutStack' (ClassifyReturnValue ret) ret ++ inp))
-> IndigoState
     inp (RetOutStack' (ClassifyReturnValue ret) ret ++ inp)
forall (inp :: [*]) (out :: [*]).
(MetaData inp -> GenCode inp out) -> IndigoState inp out
IndigoState ((MetaData inp
  -> GenCode inp (RetOutStack' (ClassifyReturnValue ret) ret ++ inp))
 -> IndigoState
      inp (RetOutStack' (ClassifyReturnValue ret) ret ++ inp))
-> (MetaData inp
    -> GenCode inp (RetOutStack' (ClassifyReturnValue ret) ret ++ inp))
-> IndigoState
     inp (RetOutStack' (ClassifyReturnValue ret) ret ++ 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
..} ->
  SomeIndigoState inp
-> MetaData inp
-> (forall (out :: [*]).
    GenCode inp out
    -> GenCode inp (RetOutStack' (ClassifyReturnValue ret) ret ++ inp))
-> GenCode inp (RetOutStack' (ClassifyReturnValue ret) ret ++ inp)
forall (inp :: [*]) r.
SomeIndigoState inp
-> MetaData inp -> (forall (out :: [*]). GenCode inp out -> r) -> r
runSIS SomeIndigoState inp
f MetaData inp
md ((forall (out :: [*]).
  GenCode inp out
  -> GenCode inp (RetOutStack' (ClassifyReturnValue ret) ret ++ inp))
 -> GenCode inp (RetOutStack' (ClassifyReturnValue ret) ret ++ inp))
-> (forall (out :: [*]).
    GenCode inp out
    -> GenCode inp (RetOutStack' (ClassifyReturnValue ret) ret ++ inp))
-> GenCode inp (RetOutStack' (ClassifyReturnValue ret) ret ++ inp)
forall a b. (a -> b) -> a -> b
$ \GenCode inp out
fs ->
    forall ret (inp :: [*]).
ScopeCodeGen ret =>
StackVars inp
-> RetVars ret
-> (inp :-> (RetOutStack ret ++ inp))
-> GenCode inp (RetOutStack ret ++ inp)
finalizeStatement @ret StackVars inp
mdStack RetVars ret
retVars ((inp :-> (RetOutStack' (ClassifyReturnValue ret) ret ++ inp))
 -> GenCode inp (RetOutStack' (ClassifyReturnValue ret) ret ++ inp))
-> (inp :-> (RetOutStack' (ClassifyReturnValue ret) ret ++ inp))
-> GenCode inp (RetOutStack' (ClassifyReturnValue ret) ret ++ inp)
forall a b. (a -> b) -> a -> b
$ MetaData inp
-> Text
-> (inp :-> (RetOutStack' (ClassifyReturnValue ret) ret ++ inp))
-> inp :-> (RetOutStack' (ClassifyReturnValue ret) ret ++ inp)
forall (inp :: [*]) (out :: [*]) (any :: [*]).
MetaData any -> Text -> (inp :-> out) -> inp :-> out
stmtHook MetaData inp
md (forall ret. ReturnableValue ret => RetVars ret -> Text -> Text
prettyAssign @ret RetVars ret
retVars Text
"scope") ((inp :-> (RetOutStack' (ClassifyReturnValue ret) ret ++ inp))
 -> inp :-> (RetOutStack' (ClassifyReturnValue ret) ret ++ inp))
-> (inp :-> (RetOutStack' (ClassifyReturnValue ret) ret ++ inp))
-> inp :-> (RetOutStack' (ClassifyReturnValue ret) ret ++ inp)
forall a b. (a -> b) -> a -> b
$
      forall ret (inp :: [*]) (xs :: [*]).
ScopeCodeGen ret =>
(StackVars xs -> MetaData xs)
-> GenCode inp xs -> ret -> inp :-> (RetOutStack ret ++ inp)
compileScope @ret (MetaData inp -> StackVars out -> MetaData out
forall (inp :: [*]) (inp1 :: [*]).
MetaData inp -> StackVars inp1 -> MetaData inp1
replStkMd MetaData inp
md) GenCode inp out
fs ret
ret

-- | Add a comment
comment :: MT.CommentType -> IndigoState i i
comment :: forall (i :: [*]). CommentType -> IndigoState i i
comment CommentType
t = (MetaData i -> GenCode i i) -> IndigoState i i
forall (inp :: [*]) (out :: [*]).
(MetaData inp -> GenCode inp out) -> IndigoState inp out
IndigoState ((MetaData i -> GenCode i i) -> IndigoState i i)
-> (MetaData i -> GenCode i i) -> IndigoState i i
forall a b. (a -> b) -> a -> b
$ \MetaData i
md -> StackVars i -> (i :-> i) -> (i :-> i) -> GenCode i i
forall (inp :: [*]) (out :: [*]).
StackVars out -> (inp :-> out) -> (out :-> inp) -> GenCode inp out
GenCode (MetaData i -> StackVars i
forall (inp :: [*]). MetaData inp -> StackVars inp
mdStack MetaData i
md) (CommentType -> i :-> i
forall (s :: [*]). CommentType -> s :-> s
L.comment CommentType
t) i :-> i
forall (s :: [*]). s :-> s
L.nop