packages feed

indigo-0.6.0: src/Indigo/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 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 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 = mkContractCode $
  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)