Compilation.hs

-- 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 seqHooks paramCode runner =
    runner optimized initMd
  where
    (code, initMd, nextRef) = fromIndigoWithParams @n @a paramCode
    optimized = indigoMtoSequential nextRef seqHooks code
      & compileLambdas
      & 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 (settingsToHooks -> CommentHooks{..}) paramCode =
  compileIndigoImpl @n @inp @a chFrontendHooks paramCode $
    \block stk -> sequentialToLorentz (MetaData stk mempty chBackendHooks) 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 = compileIndigoFull @n @inp @a (defaultCommentSettings 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 (settingsToHooks -> CommentHooks{..}) code =
  prepare $ compileIndigoImpl @3 @'[param, st, Ops] chFrontendHooks (contractToIndigoWithParams code) $ \(block, nextRef) ->
    \case
      (StkElements (Ref parRef :& Ref stRef :& 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, nextRef', someGen) = deepDecomposeCompose nextRef (pushNoRef $ StkElements opsStack) in
        case someGen of
          SomeGenCode (GenCode decompStk decompose composeBack) ->
            let md = MetaData (pushRef (Var parRef) decompStk) (M.singleton stRef (SomeObject storageObj)) chBackendHooks
                indigoCode = sequentialToLorentz md (block, nextRef') in
            L.dip decompose # -- decompose storage
            indigoCode # -- run indigo code
            L.dip composeBack
      _ -> error "invalid initial stack during contract compilation"
  where
    prepare :: ('[param, st, Ops] :-> '[param, st, Ops]) -> ('[(param, st)] :-> '[(Ops, st)])
    prepare cd =
      L.nil # L.swap # L.unpair #
      cd #
      L.drop # -- drop param
      L.swap # L.pair

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