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

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

-- | Strictly typed statements of Indigo language.

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

  -- * 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.Lambda 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.Internal hiding ((<>))
import Indigo.Lorentz
import qualified Lorentz.Doc as L
import qualified Lorentz.Entrypoints.Doc as L (finalizeParamCallingDoc)
import Lorentz.Entrypoints.Helpers (RequireSumType)
import qualified Lorentz.Instr as L
import qualified Lorentz.Run as L
import qualified Michelson.Typed as MT
import 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 :: Expr Bool -> SomeIndigoState inp -> IndigoState inp inp
while e :: Expr Bool
e body :: 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
$ \md :: 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 ("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
<> ")") ((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 :: Expr (Either l r)
-> Var l
-> SomeIndigoState (l : inp)
-> Var r
-> IndigoState inp (r : inp)
whileLeft e :: Expr (Either l r)
e varL :: Var l
varL body :: SomeIndigoState (l : inp)
body varR :: 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
$ \md :: 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 (RetVars (Var r) -> Text -> Expr (Either l r) -> Text
forall ret x.
ReturnableValue ret =>
RetVars ret -> Text -> Expr x -> Text
condStmtPretty @(Var r) Var r
RetVars (Var r)
varR "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 ("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
<> ":= 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 :: Expr a
-> Var (IterOpElHs a)
-> SomeIndigoState (IterOpElHs a : inp)
-> IndigoState inp inp
forEach container :: Expr a
container var :: Var (IterOpElHs a)
var body :: 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
$ \md :: 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
$ "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
|+ " 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
|+ ")") ((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 :: di -> IndigoState s s
doc di :: di
di = (MetaData s -> GenCode s s) -> IndigoState s s
forall (inp :: [*]) (out :: [*]).
(MetaData inp -> GenCode inp out) -> IndigoState inp out
IndigoState \md :: 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 :: DocGrouping -> SomeIndigoState i -> SomeIndigoState i
docGroup :: DocGrouping -> SomeIndigoState i -> SomeIndigoState i
docGroup gr :: DocGrouping
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 md :: StackVars out
md cd :: i :-> out
cd clr :: 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 (DocGrouping -> (i :-> out) -> i :-> out
forall (inp :: [*]) (out :: [*]).
DocGrouping -> (inp :-> out) -> inp :-> out
L.docGroup DocGrouping
gr i :-> out
cd) out :-> i
clr

-- | Insert documentation of the contract storage type. The type
-- should be passed using type applications.
docStorage :: forall storage s. TypeHasDoc storage => IndigoState s s
docStorage :: IndigoState s s
docStorage = (MetaData s -> GenCode s s) -> IndigoState s s
forall (inp :: [*]) (out :: [*]).
(MetaData inp -> GenCode inp out) -> IndigoState inp out
IndigoState \md :: 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) (forall (s :: [*]). TypeHasDoc storage => s :-> s
forall storage (s :: [*]). TypeHasDoc storage => s :-> s
L.docStorage @storage) s :-> s
forall (s :: [*]). s :-> s
L.nop

-- | Give a name to the given contract. Apply it to the whole contract code.
contractName :: Text -> SomeIndigoState i -> SomeIndigoState i
contractName :: Text -> SomeIndigoState i -> SomeIndigoState i
contractName cName :: Text
cName = (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 mdb :: StackVars out
mdb gc :: i :-> out
gc clr :: 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
mdb (Text -> (i :-> out) -> i :-> out
forall (inp :: [*]) (out :: [*]).
Text -> (inp :-> out) -> inp :-> out
L.contractName Text
cName i :-> out
gc) out :-> i
clr

-- | Attach general info to the given contract.
contractGeneral :: SomeIndigoState i -> SomeIndigoState i
contractGeneral :: SomeIndigoState i -> SomeIndigoState i
contractGeneral = (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 mdb :: StackVars out
mdb gc :: i :-> out
gc clr :: 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
mdb ((i :-> out) -> i :-> out
forall (inp :: [*]) (out :: [*]). (inp :-> out) -> inp :-> out
L.contractGeneral i :-> out
gc) out :-> i
clr

-- | Attach default general info to the contract documentation.
contractGeneralDefault :: IndigoState s s
contractGeneralDefault :: IndigoState s s
contractGeneralDefault = (MetaData s -> GenCode s s) -> IndigoState s s
forall (inp :: [*]) (out :: [*]).
(MetaData inp -> GenCode inp out) -> IndigoState inp out
IndigoState \md :: 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 :: Var cp
-> SomeIndigoState (cp : inp) -> Expr cp -> SomeIndigoState inp
finalizeParamCallingDoc vc :: Var cp
vc act :: SomeIndigoState (cp : inp)
act param :: 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
$ \md :: 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 st1 :: StackVars out
st1 cd :: (cp : inp) :-> out
cd clr :: 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 ("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
<> ")") ((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)
     )
  => EntrypointRef mname
  -> Var (ContractRef (GetEntrypointArgCustom p mname))
  -- ^ Variable that will be assigned to the resulting 'ContractRef'
  -> IndigoState inp (ContractRef (GetEntrypointArgCustom p mname) : inp)
selfCalling :: EntrypointRef mname
-> Var (ContractRef (GetEntrypointArgCustom p mname))
-> IndigoState
     inp (ContractRef (GetEntrypointArgCustom p mname) : inp)
selfCalling epRef :: EntrypointRef mname
epRef var :: 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
<> " := 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 (EntrypointRef mname
-> inp :-> (ContractRef (GetEntrypointArgCustom p mname) : inp)
forall p (mname :: Maybe Symbol) (s :: [*]).
NiceParameterFull p =>
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 inp epRef epArg addr.
     ( HasEntrypointArg cp epRef epArg
     , ToTAddress cp addr
     , ToT addr ~ ToT Address
     , 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 :: epRef
-> Expr addr
-> Var (Maybe (ContractRef epArg))
-> IndigoState inp (Maybe (ContractRef epArg) : inp)
contractCalling epRef :: epRef
epRef addr :: Expr addr
addr var :: 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
<> " := 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 (epRef -> (addr : inp) :-> (Maybe (ContractRef epArg) : inp)
forall cp epRef epArg addr (s :: [*]).
(HasEntrypointArg cp epRef epArg, ToTAddress_ cp addr) =>
epRef -> (addr : s) :-> (Maybe (ContractRef epArg) : s)
L.contractCalling @cp 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)
  => Expr p -> Expr Mutez -> Expr (ContractRef p)
  -> IndigoState inp inp
transferTokens :: Expr p -> Expr Mutez -> Expr (ContractRef p) -> IndigoState inp inp
transferTokens ep :: Expr p
ep em :: Expr Mutez
em ec :: 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
$ \s :: 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 =>
(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 => Expr (Maybe KeyHash) -> IndigoState inp inp
setDelegate :: Expr (Maybe KeyHash) -> IndigoState inp inp
setDelegate e :: 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
$ \s :: 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 :: [*]). (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)
  => L.Contract p s
  -> Expr (Maybe KeyHash)
  -> Expr Mutez
  -> Expr s
  -> Var Address
  -- ^ Variable that will be assigned to the resulting 'Address'
  -> IndigoState inp (Address : inp)
createContract :: Contract p s
-> Expr (Maybe KeyHash)
-> Expr Mutez
-> Expr s
-> Var Address
-> IndigoState inp (Address : inp)
createContract lCtr :: Contract p s
lCtr ek :: Expr (Maybe KeyHash)
ek em :: Expr Mutez
em es :: Expr s
es var :: 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
+| " := 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
|+ ", 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
|+ ", 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
$ \s :: 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
-> (Maybe KeyHash : Mutez : s : inp)
   :-> (Operation : Address : inp)
forall p g (s :: [*]).
(NiceStorage g, NiceParameterFull p) =>
Contract p g
-> (Maybe KeyHash : Mutez : g : s) :-> (Operation : Address : s)
L.createContract Contract p s
lCtr ((Maybe KeyHash : Mutez : s : inp) :-> (Operation : Address : inp))
-> ((Operation : Address : inp) :-> (Address : inp))
-> (Maybe KeyHash : Mutez : s : inp) :-> (Address : inp)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# StackVars (Address : inp)
-> (Operation : Address : inp) :-> (Address : inp)
forall (stk :: [*]).
HasSideEffects =>
StackVars stk -> (Operation : stk) :-> stk
varActionOperation (StackVars inp -> StackVars (Address : inp)
forall a (inp :: [*]).
KnownValue a =>
StackVars inp -> StackVars (a : inp)
pushNoRef StackVars inp
s)
    Var Address -> IndigoState (Address : inp) (Address : inp)
forall x (inp :: [*]).
KnownValue x =>
Var x -> IndigoState (x : inp) (x : inp)
assignTopVar Var Address
var

----------------------------------------------------------------------------
-- 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 :: SomeIndigoState inp
-> ret -> RetVars ret -> IndigoState inp (RetOutStack ret ++ inp)
scope f :: SomeIndigoState inp
f ret :: ret
ret retVars :: RetVars ret
retVars = (MetaData inp -> GenCode inp (RetOutStack ret ++ inp))
-> IndigoState inp (RetOutStack ret ++ inp)
forall (inp :: [*]) (out :: [*]).
(MetaData inp -> GenCode inp out) -> IndigoState inp out
IndigoState ((MetaData inp -> GenCode inp (RetOutStack ret ++ inp))
 -> IndigoState inp (RetOutStack ret ++ inp))
-> (MetaData inp -> GenCode inp (RetOutStack ret ++ inp))
-> IndigoState inp (RetOutStack ret ++ inp)
forall a b. (a -> b) -> a -> b
$ \md :: MetaData inp
md@MetaData{..} ->
  SomeIndigoState inp
-> MetaData inp
-> (forall (out :: [*]).
    GenCode inp out -> GenCode inp (RetOutStack ret ++ inp))
-> GenCode inp (RetOutStack 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 ret ++ inp))
 -> GenCode inp (RetOutStack ret ++ inp))
-> (forall (out :: [*]).
    GenCode inp out -> GenCode inp (RetOutStack ret ++ inp))
-> GenCode inp (RetOutStack ret ++ inp)
forall a b. (a -> b) -> a -> b
$ \fs :: GenCode inp out
fs ->
    StackVars inp
-> RetVars ret
-> (inp :-> (RetOutStack ret ++ inp))
-> GenCode inp (RetOutStack ret ++ inp)
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 ret ++ inp))
 -> GenCode inp (RetOutStack ret ++ inp))
-> (inp :-> (RetOutStack ret ++ inp))
-> GenCode inp (RetOutStack ret ++ inp)
forall a b. (a -> b) -> a -> b
$ MetaData inp
-> Text
-> (inp :-> (RetOutStack ret ++ inp))
-> inp :-> (RetOutStack ret ++ inp)
forall (inp :: [*]) (out :: [*]) (any :: [*]).
MetaData any -> Text -> (inp :-> out) -> inp :-> out
stmtHook MetaData inp
md (RetVars ret -> Text -> Text
forall ret. ReturnableValue ret => RetVars ret -> Text -> Text
prettyAssign @ret RetVars ret
retVars "scope") ((inp :-> (RetOutStack ret ++ inp))
 -> inp :-> (RetOutStack ret ++ inp))
-> (inp :-> (RetOutStack ret ++ inp))
-> inp :-> (RetOutStack ret ++ inp)
forall a b. (a -> b) -> a -> b
$
      (StackVars out -> MetaData out)
-> GenCode inp out -> ret -> inp :-> (RetOutStack ret ++ inp)
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 :: CommentType -> IndigoState i i
comment t :: 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
$ \md :: 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