morley-1.3.0: bench/Main.hs

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

module Main (main) where

import qualified Data.Map as M
import Gauge.Main (bench, nf, defaultMain, bgroup)
import Text.Megaparsec (parse)

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

main :: IO ()
main = 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,) <$> readFileUtf8 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.typeCheckContract (M.fromList [])) contract

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

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

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



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