-- 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 Indigo.Backend.Prelude
import Indigo.Internal
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 = 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 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 :-> (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)) inp :-> inp
forall (s :: [*]). s :-> s
L.nop

-- | While-left statement. Repeats a block of code as long as the control
-- 'Either' is 'Left', returns when it is 'Right'.
whileLeft
  :: (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 = 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
    gc :: (l & inp) :-> (l & inp)
gc = 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 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 (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 ((l & inp) :-> (l & inp)
gc ((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)) (r & inp) :-> inp
forall a (s :: [*]). (a & s) :-> s
L.drop

-- | 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 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 :-> (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)) inp :-> inp
forall (s :: [*]). s :-> s
L.nop

----------------------------------------------------------------------------
-- 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
$ 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 (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) (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)

----------------------------------------------------------------------------
-- 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 = 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 = 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 = 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 (StkEl Address
forall a. KnownValue a => StkEl a
NoRef StkEl Address -> StackVars inp -> StackVars (Address & inp)
forall u (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& 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
$ DecomposedObjects
-> GenCode inp out -> ret -> inp :-> (RetOutStack ret ++ inp)
forall ret (inp :: [*]) (xs :: [*]).
ScopeCodeGen ret =>
DecomposedObjects
-> GenCode inp xs -> ret -> inp :-> (RetOutStack ret ++ inp)
compileScope @ret DecomposedObjects
mdObjects 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