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

-- | This module contains the high-level compilation of Indigo to Lorentz,
-- including plain Indigo code, as well as Indigo contracts.

module Indigo.Compilation
  ( CommentSettings (..)
  , CommentsVerbosity (..)
  , defaultCommentSettings
  , compileIndigo
  , compileIndigoContractFull
  , compileIndigoContract
  ) where

import Data.Map qualified as M
import Prelude

import Indigo.Backend.Expr.Decompose (deepDecomposeCompose)
import Indigo.Common.Object (IsObject, SomeObject(SomeObject))
import Indigo.Common.SIS (SomeGenCode(SomeGenCode))
import Indigo.Common.State (GenCode(GenCode), MetaData(MetaData))
import Indigo.Common.Var
import Indigo.Compilation.Field
import Indigo.Compilation.Hooks
  (CommentHooks(..), CommentSettings(..), CommentsVerbosity(..), defaultCommentSettings,
  settingsToHooks)
import Indigo.Compilation.Lambda
import Indigo.Compilation.Params
import Indigo.Compilation.Sequential
import Indigo.Frontend.Program (IndigoContract)
import Indigo.Lorentz
import Lorentz.Instr qualified as L

-- | Compile Indigo code to Lorentz.
--
-- Note: it is necessary to specify the number of parameters (using the first
-- type variable) of the Indigo function. Also, these should be on the top of
-- the input stack in inverse order (see 'IndigoWithParams').
compileIndigoImpl
  :: forall n inp a. (AreIndigoParams n inp, KnownValue a, Default (StackVars inp))
  => SequentialHooks
  -> IndigoWithParams n inp a
  -> ((Block, RefId) -> StackVars inp -> (inp :-> inp))
  -> inp :-> inp
compileIndigoImpl :: forall (n :: Nat) (inp :: [*]) a.
(AreIndigoParams n inp, KnownValue a, Default (StackVars inp)) =>
SequentialHooks
-> IndigoWithParams n inp a
-> ((Block, RefId) -> StackVars inp -> inp :-> inp)
-> inp :-> inp
compileIndigoImpl SequentialHooks
seqHooks IndigoWithParams n inp a
paramCode (Block, RefId) -> StackVars inp -> inp :-> inp
runner =
    (Block, RefId) -> StackVars inp -> inp :-> inp
runner (Block, RefId)
optimized StackVars inp
initMd
  where
    (IndigoM a
code, StackVars inp
initMd, RefId
nextRef) = forall (n :: Nat) a (inp :: [*]).
(AreIndigoParams n inp, KnownValue a, Default (StackVars inp)) =>
IndigoWithParams n inp a -> (IndigoM a, StackVars inp, RefId)
fromIndigoWithParams @n @a IndigoWithParams n inp a
paramCode
    optimized :: (Block, RefId)
optimized = RefId -> SequentialHooks -> IndigoM a -> (Block, RefId)
forall a. RefId -> SequentialHooks -> IndigoM a -> (Block, RefId)
indigoMtoSequential RefId
nextRef SequentialHooks
seqHooks IndigoM a
code
      (Block, RefId)
-> ((Block, RefId) -> (Block, RefId)) -> (Block, RefId)
forall a b. a -> (a -> b) -> b
& (Block, RefId) -> (Block, RefId)
compileLambdas
      (Block, RefId)
-> ((Block, RefId) -> (Block, RefId)) -> (Block, RefId)
forall a b. a -> (a -> b) -> b
& (Block, RefId) -> (Block, RefId)
optimizeFields

-- | Specialization of 'compileIndigoImpl' without var decompositions.
compileIndigoFull
  :: forall n inp a. (AreIndigoParams n inp, KnownValue a, Default (StackVars inp))
  => CommentSettings
  -> IndigoWithParams n inp a
  -> inp :-> inp
compileIndigoFull :: forall (n :: Nat) (inp :: [*]) a.
(AreIndigoParams n inp, KnownValue a, Default (StackVars inp)) =>
CommentSettings -> IndigoWithParams n inp a -> inp :-> inp
compileIndigoFull (CommentSettings -> CommentHooks
settingsToHooks -> CommentHooks{GenCodeHooks
SequentialHooks
chBackendHooks :: CommentHooks -> GenCodeHooks
chFrontendHooks :: CommentHooks -> SequentialHooks
chBackendHooks :: GenCodeHooks
chFrontendHooks :: SequentialHooks
..}) IndigoWithParams n inp a
paramCode =
  forall (n :: Nat) (inp :: [*]) a.
(AreIndigoParams n inp, KnownValue a, Default (StackVars inp)) =>
SequentialHooks
-> IndigoWithParams n inp a
-> ((Block, RefId) -> StackVars inp -> inp :-> inp)
-> inp :-> inp
compileIndigoImpl @n @inp @a SequentialHooks
chFrontendHooks IndigoWithParams n inp a
paramCode (((Block, RefId) -> StackVars inp -> inp :-> inp) -> inp :-> inp)
-> ((Block, RefId) -> StackVars inp -> inp :-> inp) -> inp :-> inp
forall a b. (a -> b) -> a -> b
$
    \(Block, RefId)
block StackVars inp
stk -> MetaData inp -> (Block, RefId) -> inp :-> inp
forall (inp :: [*]). MetaData inp -> (Block, RefId) -> inp :-> inp
sequentialToLorentz (StackVars inp -> DecomposedObjects -> GenCodeHooks -> MetaData inp
forall (inp :: [*]).
StackVars inp -> DecomposedObjects -> GenCodeHooks -> MetaData inp
MetaData StackVars inp
stk DecomposedObjects
forall a. Monoid a => a
mempty GenCodeHooks
chBackendHooks) (Block, RefId)
block

-- | Simplified version of 'compileIndigoFull'
compileIndigo
  :: forall n inp a. (AreIndigoParams n inp, KnownValue a, Default (StackVars inp))
  => IndigoWithParams n inp a
  -> inp :-> inp
compileIndigo :: forall (n :: Nat) (inp :: [*]) a.
(AreIndigoParams n inp, KnownValue a, Default (StackVars inp)) =>
IndigoWithParams n inp a -> inp :-> inp
compileIndigo = forall (n :: Nat) (inp :: [*]) a.
(AreIndigoParams n inp, KnownValue a, Default (StackVars inp)) =>
CommentSettings -> IndigoWithParams n inp a -> inp :-> inp
compileIndigoFull @n @inp @a (CommentsVerbosity -> CommentSettings
defaultCommentSettings CommentsVerbosity
NoComments)

-- | Compile Indigo code to Lorentz contract.
-- Drop elements from the stack to return only @[Operation]@ and @storage@.
compileIndigoContractFull
  :: forall param st .
  ( KnownValue param
  , IsObject st
  )
  => CommentSettings
  -> IndigoContract param st
  -> ContractCode param st
compileIndigoContractFull :: forall param st.
(KnownValue param, IsObject st) =>
CommentSettings -> IndigoContract param st -> ContractCode param st
compileIndigoContractFull (CommentSettings -> CommentHooks
settingsToHooks -> CommentHooks{GenCodeHooks
SequentialHooks
chBackendHooks :: GenCodeHooks
chFrontendHooks :: SequentialHooks
chBackendHooks :: CommentHooks -> GenCodeHooks
chFrontendHooks :: CommentHooks -> SequentialHooks
..}) IndigoContract param st
code = (IsNotInView => '[(param, st)] :-> ContractOut st)
-> ContractCode param st
forall cp st.
(IsNotInView => '[(cp, st)] :-> ContractOut st)
-> ContractCode cp st
mkContractCode ((IsNotInView => '[(param, st)] :-> ContractOut st)
 -> ContractCode param st)
-> (IsNotInView => '[(param, st)] :-> ContractOut st)
-> ContractCode param st
forall a b. (a -> b) -> a -> b
$
  ('[param, st, Ops] :-> '[param, st, Ops])
-> '[(param, st)] :-> ContractOut st
prepare (('[param, st, Ops] :-> '[param, st, Ops])
 -> '[(param, st)] :-> ContractOut st)
-> ('[param, st, Ops] :-> '[param, st, Ops])
-> '[(param, st)] :-> ContractOut st
forall a b. (a -> b) -> a -> b
$ forall (n :: Nat) (inp :: [*]) a.
(AreIndigoParams n inp, KnownValue a, Default (StackVars inp)) =>
SequentialHooks
-> IndigoWithParams n inp a
-> ((Block, RefId) -> StackVars inp -> inp :-> inp)
-> inp :-> inp
compileIndigoImpl @3 @'[param, st, Ops] SequentialHooks
chFrontendHooks (IndigoContract param st -> IndigoWithParams 3 '[param, st, Ops] ()
forall param st.
KnownValue st =>
IndigoContract param st -> IndigoWithParams 3 '[param, st, Ops] ()
contractToIndigoWithParams IndigoContract param st
code) (((Block, RefId)
  -> StackVars '[param, st, Ops]
  -> '[param, st, Ops] :-> '[param, st, Ops])
 -> '[param, st, Ops] :-> '[param, st, Ops])
-> ((Block, RefId)
    -> StackVars '[param, st, Ops]
    -> '[param, st, Ops] :-> '[param, st, Ops])
-> '[param, st, Ops] :-> '[param, st, Ops]
forall a b. (a -> b) -> a -> b
$ \(Block
block, RefId
nextRef) ->
    \case
      (StkElements (Ref RefId
parRef :& Ref RefId
stRef :& Rec StkEl rs
opsStack))  ->
        -- during code Indigo code compilation the stack will look like:
        -- [var_10, var_9, ... , var_3, param_var_2, storage_field_11, storage_field_12, ..., storage_field_20, ops_var_0]
        -- var_1 will represent storage and passed to DecomposedObjects
        let (Object st
storageObj, RefId
nextRef', SomeGenCode (st : rs)
someGen) = SIS' (st : rs) (Object st)
forall a (inp :: [*]). IsObject a => SIS' (a : inp) (Object a)
deepDecomposeCompose RefId
nextRef (StackVars rs -> StackVars (st : rs)
forall a (inp :: [*]).
KnownValue a =>
StackVars inp -> StackVars (a : inp)
pushNoRef (StackVars rs -> StackVars (st : rs))
-> StackVars rs -> StackVars (st : rs)
forall a b. (a -> b) -> a -> b
$ Rec StkEl rs -> StackVars rs
forall (stk :: [*]). Rec StkEl stk -> StackVars stk
StkElements Rec StkEl rs
opsStack) in
        case SomeGenCode (st : rs)
someGen of
          SomeGenCode (GenCode StackVars out
decompStk (st : rs) :-> out
decompose out :-> (st : rs)
composeBack) ->
            let md :: MetaData (param : out)
md = StackVars (param : out)
-> DecomposedObjects -> GenCodeHooks -> MetaData (param : out)
forall (inp :: [*]).
StackVars inp -> DecomposedObjects -> GenCodeHooks -> MetaData inp
MetaData (Var param -> StackVars out -> StackVars (param : out)
forall a (inp :: [*]).
KnownValue a =>
Var a -> StackVars inp -> StackVars (a : inp)
pushRef (RefId -> Var param
forall {k} (a :: k). RefId -> Var a
Var RefId
parRef) StackVars out
decompStk) (RefId -> SomeObject -> DecomposedObjects
forall k a. k -> a -> Map k a
M.singleton RefId
stRef (Object st -> SomeObject
forall a. IsObject a => Object a -> SomeObject
SomeObject Object st
storageObj)) GenCodeHooks
chBackendHooks
                indigoCode :: (param : out) :-> (param : out)
indigoCode = MetaData (param : out)
-> (Block, RefId) -> (param : out) :-> (param : out)
forall (inp :: [*]). MetaData inp -> (Block, RefId) -> inp :-> inp
sequentialToLorentz MetaData (param : out)
md (Block
block, RefId
nextRef') in
            ((st : rs) :-> out) -> (param : st : rs) :-> (param : out)
forall a (s :: [*]) (s' :: [*]).
HasCallStack =>
(s :-> s') -> (a : s) :-> (a : s')
L.dip (st : rs) :-> out
decompose ((param : st : rs) :-> (param : out))
-> ((param : out) :-> (param : out))
-> (param : st : rs) :-> (param : out)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# -- decompose storage
            (param : out) :-> (param : out)
indigoCode ((param : st : rs) :-> (param : out))
-> ((param : out) :-> (param : st : rs))
-> (param : st : rs) :-> (param : st : rs)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# -- run indigo code
            (out :-> (st : rs)) -> (param : out) :-> (param : st : rs)
forall a (s :: [*]) (s' :: [*]).
HasCallStack =>
(s :-> s') -> (a : s) :-> (a : s')
L.dip out :-> (st : rs)
composeBack
      StackVars '[param, st, Ops]
_ -> Text -> '[param, st, Ops] :-> '[param, st, Ops]
forall a. HasCallStack => Text -> a
error Text
"invalid initial stack during contract compilation"
  where
    prepare :: ('[param, st, Ops] :-> '[param, st, Ops]) -> ('[(param, st)] :-> '[(Ops, st)])
    prepare :: ('[param, st, Ops] :-> '[param, st, Ops])
-> '[(param, st)] :-> ContractOut st
prepare '[param, st, Ops] :-> '[param, st, Ops]
cd =
      '[(param, st)] :-> '[Ops, (param, st)]
forall p (s :: [*]). KnownValue p => s :-> (List p : s)
L.nil ('[(param, st)] :-> '[Ops, (param, st)])
-> ('[Ops, (param, st)] :-> '[(param, st), Ops])
-> '[(param, st)] :-> '[(param, st), Ops]
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# '[Ops, (param, st)] :-> '[(param, st), Ops]
forall a b (s :: [*]). (a : b : s) :-> (b : a : s)
L.swap ('[(param, st)] :-> '[(param, st), Ops])
-> ('[(param, st), Ops] :-> '[param, st, Ops])
-> '[(param, st)] :-> '[param, st, Ops]
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# '[(param, st), Ops] :-> '[param, st, Ops]
forall a b (s :: [*]). ((a, b) : s) :-> (a : b : s)
L.unpair ('[(param, st)] :-> '[param, st, Ops])
-> ('[param, st, Ops] :-> '[param, st, Ops])
-> '[(param, st)] :-> '[param, st, Ops]
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#
      '[param, st, Ops] :-> '[param, st, Ops]
cd ('[(param, st)] :-> '[param, st, Ops])
-> ('[param, st, Ops] :-> '[st, Ops])
-> '[(param, st)] :-> '[st, Ops]
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#
      '[param, st, Ops] :-> '[st, Ops]
forall a (s :: [*]). (a : s) :-> s
L.drop ('[(param, st)] :-> '[st, Ops])
-> ('[st, Ops] :-> '[Ops, st]) -> '[(param, st)] :-> '[Ops, st]
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# -- drop param
      '[st, Ops] :-> '[Ops, st]
forall a b (s :: [*]). (a : b : s) :-> (b : a : s)
L.swap ('[(param, st)] :-> '[Ops, st])
-> ('[Ops, st] :-> ContractOut st)
-> '[(param, st)] :-> ContractOut st
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# '[Ops, st] :-> ContractOut st
forall a b (s :: [*]). (a : b : s) :-> ((a, b) : s)
L.pair

-- | Simplified version of 'compileIndigoContractFull'
compileIndigoContract
  :: forall param st .
  ( KnownValue param
  , IsObject st
  )
  => IndigoContract param st
  -> ContractCode param st
compileIndigoContract :: forall param st.
(KnownValue param, IsObject st) =>
IndigoContract param st -> ContractCode param st
compileIndigoContract = CommentSettings -> IndigoContract param st -> ContractCode param st
forall param st.
(KnownValue param, IsObject st) =>
CommentSettings -> IndigoContract param st -> ContractCode param st
compileIndigoContractFull (CommentsVerbosity -> CommentSettings
defaultCommentSettings CommentsVerbosity
NoComments)