-- 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 qualified Data.Map as M
import Prelude

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.Internal hiding (SetField, (<>), (==), (>>))
import Indigo.Lorentz
import qualified Lorentz.Instr as L
import qualified Lorentz.Macro 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 :: SequentialHooks
-> IndigoWithParams n inp a
-> ((Block, RefId) -> StackVars inp -> inp :-> inp)
-> inp :-> inp
compileIndigoImpl seqHooks :: SequentialHooks
seqHooks paramCode :: IndigoWithParams n inp a
paramCode runner :: (Block, RefId) -> StackVars inp -> inp :-> inp
runner =
    (Block, RefId) -> StackVars inp -> inp :-> inp
runner (Block, RefId)
optimized StackVars inp
initMd
  where
    (code :: IndigoM a
code, initMd :: StackVars inp
initMd, nextRef :: RefId
nextRef) = IndigoWithParams n inp a -> (IndigoM a, StackVars inp, RefId)
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 :: CommentSettings -> IndigoWithParams n inp a -> inp :-> inp
compileIndigoFull (CommentSettings -> CommentHooks
settingsToHooks -> CommentHooks{..}) paramCode :: IndigoWithParams n inp a
paramCode =
  SequentialHooks
-> IndigoWithParams n inp a
-> ((Block, RefId) -> StackVars inp -> inp :-> inp)
-> inp :-> inp
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 :: (Block, RefId)
block stk :: 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 :: IndigoWithParams n inp a -> inp :-> inp
compileIndigo = CommentSettings -> IndigoWithParams n inp a -> inp :-> inp
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 :: CommentSettings -> IndigoContract param st -> ContractCode param st
compileIndigoContractFull (CommentSettings -> CommentHooks
settingsToHooks -> CommentHooks{..}) code :: IndigoContract param st
code =
  ('[param, st, Ops] :-> '[param, st, Ops]) -> ContractCode param st
prepare (('[param, st, Ops] :-> '[param, st, Ops])
 -> ContractCode param st)
-> ('[param, st, Ops] :-> '[param, st, Ops])
-> ContractCode param st
forall a b. (a -> b) -> a -> b
$ SequentialHooks
-> IndigoWithParams 3 '[param, st, Ops] ()
-> ((Block, RefId)
    -> StackVars '[param, st, Ops]
    -> '[param, st, Ops] :-> '[param, st, Ops])
-> '[param, st, Ops] :-> '[param, st, Ops]
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
block, nextRef :: RefId
nextRef) ->
    \case
      (StkElements (Ref parRef :: RefId
parRef :& Ref stRef :: RefId
stRef :& opsStack :: 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 (storageObj :: Object st
storageObj, nextRef' :: RefId
nextRef', someGen :: 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 decompStk :: StackVars out
decompStk decompose :: (st : rs) :-> out
decompose composeBack :: 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
      _ -> Text -> '[param, st, Ops] :-> '[param, st, Ops]
forall a. HasCallStack => Text -> a
error "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]) -> ContractCode param st
prepare cd :: '[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] :-> '[(Ops, st)]) -> ContractCode param st
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# '[Ops, st] :-> '[(Ops, 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 :: 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)