Run.hs

module Lorentz.Run
  ( compileLorentz
  , compileLorentzContract
  , interpretLorentzInstr
  , interpretLorentzLambda
  , analyzeLorentz
  ) where

import Data.Constraint ((\\))
import Data.Vinyl.Core (Rec(..))
import Fmt (pretty)

import Lorentz.Base
import Lorentz.Constraints
import Lorentz.EntryPoints
import Michelson.Analyzer (AnalyzerRes, analyze)
import Michelson.Interpret
import Michelson.Typed
  (FullContract(..), Instr(..), IsoValue, IsoValuesStack(..), ToT, ToTs, isStar,
  mkParamNotes, starNotes)

-- | For use outside of Lorentz.
compileLorentz :: (inp :-> out) -> Instr (ToTs inp) (ToTs out)
compileLorentz = iAnyCode

-- | Version of 'compileLorentz' specialized to instruction corresponding to
-- contract code.
compileLorentzContract
  :: forall cp st.
     (NiceParameter cp, NiceStorage st, ParameterEntryPoints cp)
  => Contract cp st -> FullContract (ToT cp) (ToT st)
compileLorentzContract contract =
  FullContract
  { fcCode = if isStar cpNotes
      then  -- We have no annotations. Print contract as such.
        compileLorentz contract
      else  -- If we have some annotations, erase them.
        compileLorentz (I CAST # contract :: Contract cp st)
  , fcParamNotesSafe = case mkParamNotes cpNotes of
      Right n -> n
      Left e -> error $
        -- TODO [TM-280]: make sure Lorentz actually does not produce such
        "Lorentz unexpectedly compiled into contract with \
        \illegal parameter declaration: " <> show cpNotes <> "\n" <>
        "Reason: " <> pretty e
  , fcStoreNotes = starNotes
  } \\ niceParameterEvi @cp
    \\ niceStorageEvi @st
  where
    cpNotes = pesNotes (parameterEntryPoints @cp)

-- | Interpret a Lorentz instruction, for test purposes.
interpretLorentzInstr
  :: (IsoValuesStack inp, IsoValuesStack out)
  => ContractEnv
  -> inp :-> out
  -> Rec Identity inp
  -> Either MichelsonFailed (Rec Identity out)
interpretLorentzInstr env (compileLorentz -> instr) inp =
  fromValStack <$> interpretInstr env instr (toValStack inp)

-- | Like 'interpretLorentzInstr', but works on lambda rather than
-- arbitrary instruction.
interpretLorentzLambda
  :: (IsoValue inp, IsoValue out)
  => ContractEnv
  -> Lambda inp out
  -> inp
  -> Either MichelsonFailed out
interpretLorentzLambda env instr inp = do
  res <- interpretLorentzInstr env instr (Identity inp :& RNil)
  let Identity out :& RNil = res
  return out

-- | Lorentz version of analyzer.
analyzeLorentz :: inp :-> out -> AnalyzerRes
analyzeLorentz = analyze . compileLorentz