cleveland-0.1.0: morley-bench/Main.hs

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

module Main (main) where

import Data.Default (def)
import qualified Data.Text.IO.Utf8 as Utf8 (readFile)
import Gauge.Main (bench, bgroup, defaultMain, nf)
import Main.Utf8 (withUtf8)
import Text.Megaparsec (parse)

import Morley.Michelson.Interpret (interpret)
import Morley.Michelson.Parser as P
import Morley.Michelson.Runtime (prepareContract)
import Morley.Michelson.Runtime.Dummy
import Morley.Michelson.Text
import Morley.Michelson.TypeCheck as T
import Morley.Michelson.Typed as T
import Morley.Tezos.Address
import Test.Cleveland.Michelson.Import (importContract)

main :: IO ()
main = withUtf8 $ do
  let
    basicFp = "../../contracts/basic1.tz"
    stringCallerFp = "../../contracts/string_caller.tz"
    callSelfFp = "../../contracts/call_self_several_times.tz"
    sq2Fp = "../../contracts/testassert_square2.mtz"
    contractPaths = [basicFp, stringCallerFp, callSelfFp, sq2Fp]
  contracts <- traverse (\x -> (x,) <$> Utf8.readFile x) contractPaths
  let makeParseBench (filename, code) =
        bench filename $ nf (parse P.program filename) code
  preparedContracts <- evaluateNF =<< traverse (\x -> (x,) <$> prepareContract (Just x)) contractPaths
  let
    makeTypeCheckBench (filename, contract) = bench filename $
      nf (T.typeCheckingWith def . T.typeCheckContract) contract

  basicC <- importContract basicFp
  stringCallerC <- importContract stringCallerFp
  callSelfC <- importContract callSelfFp
  sq2C <- importContract sq2Fp
  let
    basicBench = bench basicFp
      (nf
        (interpret basicC T.epcPrimitive T.VUnit (T.VList [T.VInt 0]) dummyGlobalCounter dummyBigMapCounter)
        dummyContractEnv
      )

    dummyAddress = detGenKeyAddress "thegreatandpowerful"
    dummyString = unsafeMkMText "TGAP"
    stringCallerBench = bench stringCallerFp
      (nf
        (interpret stringCallerC T.epcPrimitive  (T.toVal dummyString) (T.toVal dummyAddress) dummyGlobalCounter dummyBigMapCounter)
        dummyContractEnv
      )
    callSelfBench = bench callSelfFp
      (nf
        (interpret callSelfC T.epcPrimitive (T.toVal (100 :: Integer)) (T.toVal (0 :: Natural)) dummyGlobalCounter dummyBigMapCounter)
        dummyContractEnv
      )

    sq2Bench = bench sq2Fp
      (nf
        (interpret sq2C T.epcPrimitive (T.toVal (100 :: Integer, 200 :: Integer)) T.VUnit dummyGlobalCounter dummyBigMapCounter)
        dummyContractEnv
      )



  defaultMain
    [ bgroup "parsing" $ map makeParseBench contracts
    , bgroup "type-checking" $ map makeTypeCheckBench preparedContracts
    , bgroup "interpreting" $ [basicBench, stringCallerBench, callSelfBench, sq2Bench]
    ]