morley 1.15.0 → 1.15.1

raw patch · 12 files changed

+164/−34 lines, 12 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGES.md +9/−1
• app/Main.hs +1/−1
• docs/language/morleyLanguage.md +1/−1
• morley.cabal +1/−1
• src/Michelson/Macro.hs +1/−3
• src/Michelson/Optimizer.hs +127/−18
• src/Michelson/Printer.hs +6/−6
• src/Michelson/Runtime/Dummy.hs +1/−1
• src/Michelson/Typed/Convert.hs +8/−0
• src/Michelson/Typed/Sing.hs +1/−0
• src/Morley/Micheline/Class.hs +2/−2
• src/Util/PeanoNatural.hs +6/−0

@@ -2,6 +2,14 @@ ========== <!-- Append new entries here --> +1.15.1+======+* [!879](https://gitlab.com/morley-framework/morley/-/merge_requests/879)+  + Add Buildable and RenderDoc instances for `Instr inp out` type.+  + Instances are based on transforming `Instr inp out` to list of `ExpandedOp` and using its instance+* [!900](https://gitlab.com/morley-framework/morley/-/merge_requests/900)+  + Added clarification that "OCaml reference client" is `tezos-client`.+ 1.15.0 ====== * [!878](https://gitlab.com/morley-framework/morley/-/merge_requests/878)@@ -14,7 +22,7 @@   + Fixed loss of type annotations in serialization of right-combed pairs. * [!795](https://gitlab.com/morley-framework/morley/-/merge_requests/795)   + Changed typecheck exception messages.-  +  Changed Buildable instances for several datatypes to be based on+  + Changed Buildable instances for several datatypes to be based on      RenderDoc instances.   + Changed the regexp in scripts/regenerate-gold-files-for-verbose-typechecking.sh     so it does not ommit extra space in .gold files on MacOS.

@@ -124,7 +124,7 @@              <*> (#output <.?> outputOption)              <*> (#singleLine <.!> onelineOption))       ("Parse a Morley contract and print corresponding Michelson " <>-       "contract that can be parsed by the OCaml reference client")+       "contract that can be parsed by the OCaml reference client: tezos-client")      runSubCmd =       mkCommandParser "run"

@@ -9,7 +9,7 @@ The Morley Language is a low-level syntactic sugar over the core Michelson instructions (core Michelson being the instructions which are actually executed in the Tezos blockchain, as opposed to the various syntactic conveniences-provided by the OCaml reference client).+provided by the OCaml reference client: `tezos-client`).  The general principle is that any syntactically valid core Michelson expression will also be a valid Morley expression, i.e. Morley is a superset of

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           morley-version:        1.15.0+version:        1.15.1 synopsis:       Developer tools for the Michelson Language description:    A library to make writing smart contracts in Michelson — the smart contract language of the Tezos blockchain — pleasant and effective. category:       Language

@@ -41,7 +41,6 @@ import Data.Data (Data(..)) import qualified Data.Text as T import Fmt (Buildable(build), genericF, (+|), (+||), (|+), (||+))-import qualified Text.PrettyPrint.Leijen.Text as PP (empty)  import Michelson.ErrorPos import Michelson.Printer (RenderDoc(..))@@ -101,9 +100,8 @@   | Seq [ParsedOp]   SrcPos -- ^ A sequence of instructions   deriving stock (Eq, Show, Data, Generic) --- dummy value instance RenderDoc ParsedOp where-  renderDoc _ _ = PP.empty+  renderDoc pn parsedOp = renderDoc pn $ expand [] parsedOp  instance Buildable ParsedOp where   build = \case

@@ -30,7 +30,7 @@   , ocGotoValuesL   ) where -import Prelude hiding (EQ)+import Prelude hiding (EQ, LT, GT)  import Control.Lens (makeLensesFor) import Data.Constraint (Dict(..))@@ -118,6 +118,7 @@     `orSimpleRule` pairUnpair     `orSimpleRule` unpairMisc     `orSimpleRule` swapBeforeCommutative+    `orSimpleRule` justDrops  -- | We do not enable 'pushPack' rule by default because it is -- potentially dangerous.@@ -165,24 +166,52 @@  variousNops :: Rule variousNops = \case-  SWAP      :# SWAP :# c -> Just c-  PUSH _    :# DROP :# c -> Just c-  DUP       :# DROP :# c -> Just c-  UNIT      :# DROP :# c -> Just c-  NOW       :# DROP :# c -> Just c-  SENDER    :# DROP :# c -> Just c-  EMPTY_MAP :# DROP :# c -> Just c-  EMPTY_SET :# DROP :# c -> Just c+  DUP                :# DROP :# c -> Just c+  DUPN _             :# DROP :# c -> Just c+  SWAP               :# SWAP :# c -> Just c+  PUSH _             :# DROP :# c -> Just c+  NONE               :# DROP :# c -> Just c+  UNIT               :# DROP :# c -> Just c+  NIL                :# DROP :# c -> Just c+  EMPTY_SET          :# DROP :# c -> Just c+  EMPTY_MAP          :# DROP :# c -> Just c+  EMPTY_BIG_MAP      :# DROP :# c -> Just c+  LAMBDA _           :# DROP :# c -> Just c+  SELF _             :# DROP :# c -> Just c+  NOW                :# DROP :# c -> Just c+  AMOUNT             :# DROP :# c -> Just c+  BALANCE            :# DROP :# c -> Just c+  TOTAL_VOTING_POWER :# DROP :# c -> Just c+  SOURCE             :# DROP :# c -> Just c+  SENDER             :# DROP :# c -> Just c+  CHAIN_ID           :# DROP :# c -> Just c+  LEVEL              :# DROP :# c -> Just c+  SELF_ADDRESS       :# DROP :# c -> Just c+  READ_TICKET        :# DROP :# c -> Just c -  SWAP      :# SWAP      -> Just Nop-  PUSH _    :# DROP      -> Just Nop-  DUP       :# DROP      -> Just Nop-  UNIT      :# DROP      -> Just Nop-  NOW       :# DROP      -> Just Nop-  SENDER    :# DROP      -> Just Nop-  EMPTY_MAP :# DROP      -> Just Nop-  EMPTY_SET :# DROP      -> Just Nop-  _                      -> Nothing+  DUP                :# DROP -> Just Nop+  DUPN _             :# DROP -> Just Nop+  SWAP               :# SWAP -> Just Nop+  PUSH _             :# DROP -> Just Nop+  NONE               :# DROP -> Just Nop+  UNIT               :# DROP -> Just Nop+  NIL                :# DROP -> Just Nop+  EMPTY_SET          :# DROP -> Just Nop+  EMPTY_MAP          :# DROP -> Just Nop+  EMPTY_BIG_MAP      :# DROP -> Just Nop+  LAMBDA _           :# DROP -> Just Nop+  SELF _             :# DROP -> Just Nop+  NOW                :# DROP -> Just Nop+  AMOUNT             :# DROP -> Just Nop+  BALANCE            :# DROP -> Just Nop+  TOTAL_VOTING_POWER :# DROP -> Just Nop+  SOURCE             :# DROP -> Just Nop+  SENDER             :# DROP -> Just Nop+  CHAIN_ID           :# DROP -> Just Nop+  LEVEL              :# DROP -> Just Nop+  SELF_ADDRESS       :# DROP -> Just Nop+  READ_TICKET        :# DROP -> Just Nop+  _                          -> Nothing  dupSwap2dup :: Rule dupSwap2dup = \case@@ -359,6 +388,9 @@    DUP :# CDR :# DIP CAR      -> Just $ UNPAIR :# SWAP   DUP :# CDR :# DIP CAR :# c -> Just $ UNPAIR :# SWAP :# c++  UNPAIR :# DROP             -> Just CDR+  UNPAIR :# DROP :# c        -> Just $ CDR :# c   _ -> Nothing  commuteArith ::@@ -387,6 +419,83 @@   where     pushPacked :: PackedValScope t => Value t -> Instr s ('TBytes ': s)     pushPacked = PUSH . VBytes . packValue'++justDrops :: Rule+justDrops = \case+  CAR              :# DROP :# c -> Just $ DROP :# c+  CDR              :# DROP :# c -> Just $ DROP :# c+  SOME             :# DROP :# c -> Just $ DROP :# c+  LEFT             :# DROP :# c -> Just $ DROP :# c+  RIGHT            :# DROP :# c -> Just $ DROP :# c+  SIZE             :# DROP :# c -> Just $ DROP :# c+  GETN _           :# DROP :# c -> Just $ DROP :# c+  CAST             :# DROP :# c -> Just $ DROP :# c+  RENAME           :# DROP :# c -> Just $ DROP :# c+  PACK             :# DROP :# c -> Just $ DROP :# c+  UNPACK           :# DROP :# c -> Just $ DROP :# c+  CONCAT'          :# DROP :# c -> Just $ DROP :# c+  ISNAT            :# DROP :# c -> Just $ DROP :# c+  ABS              :# DROP :# c -> Just $ DROP :# c+  NEG              :# DROP :# c -> Just $ DROP :# c+  NOT              :# DROP :# c -> Just $ DROP :# c+  EQ               :# DROP :# c -> Just $ DROP :# c+  NEQ              :# DROP :# c -> Just $ DROP :# c+  LT               :# DROP :# c -> Just $ DROP :# c+  GT               :# DROP :# c -> Just $ DROP :# c+  LE               :# DROP :# c -> Just $ DROP :# c+  GE               :# DROP :# c -> Just $ DROP :# c+  INT              :# DROP :# c -> Just $ DROP :# c+  CONTRACT _ _     :# DROP :# c -> Just $ DROP :# c+  SET_DELEGATE     :# DROP :# c -> Just $ DROP :# c+  IMPLICIT_ACCOUNT :# DROP :# c -> Just $ DROP :# c+  VOTING_POWER     :# DROP :# c -> Just $ DROP :# c+  SHA256           :# DROP :# c -> Just $ DROP :# c+  SHA512           :# DROP :# c -> Just $ DROP :# c+  BLAKE2B          :# DROP :# c -> Just $ DROP :# c+  SHA3             :# DROP :# c -> Just $ DROP :# c+  KECCAK           :# DROP :# c -> Just $ DROP :# c+  HASH_KEY         :# DROP :# c -> Just $ DROP :# c+  PAIRING_CHECK    :# DROP :# c -> Just $ DROP :# c+  ADDRESS          :# DROP :# c -> Just $ DROP :# c+  JOIN_TICKETS     :# DROP :# c -> Just $ DROP :# c++  CAR              :# DROP      -> Just DROP+  CDR              :# DROP      -> Just DROP+  SOME             :# DROP      -> Just DROP+  LEFT             :# DROP      -> Just DROP+  RIGHT            :# DROP      -> Just DROP+  SIZE             :# DROP      -> Just DROP+  GETN _           :# DROP      -> Just DROP+  CAST             :# DROP      -> Just DROP+  RENAME           :# DROP      -> Just DROP+  PACK             :# DROP      -> Just DROP+  UNPACK           :# DROP      -> Just DROP+  CONCAT'          :# DROP      -> Just DROP+  ISNAT            :# DROP      -> Just DROP+  ABS              :# DROP      -> Just DROP+  NEG              :# DROP      -> Just DROP+  NOT              :# DROP      -> Just DROP+  EQ               :# DROP      -> Just DROP+  NEQ              :# DROP      -> Just DROP+  LT               :# DROP      -> Just DROP+  GT               :# DROP      -> Just DROP+  LE               :# DROP      -> Just DROP+  GE               :# DROP      -> Just DROP+  INT              :# DROP      -> Just DROP+  CONTRACT _ _     :# DROP      -> Just DROP+  SET_DELEGATE     :# DROP      -> Just DROP+  IMPLICIT_ACCOUNT :# DROP      -> Just DROP+  VOTING_POWER     :# DROP      -> Just DROP+  SHA256           :# DROP      -> Just DROP+  SHA512           :# DROP      -> Just DROP+  BLAKE2B          :# DROP      -> Just DROP+  SHA3             :# DROP      -> Just DROP+  KECCAK           :# DROP      -> Just DROP+  HASH_KEY         :# DROP      -> Just DROP+  PAIRING_CHECK    :# DROP      -> Just DROP+  ADDRESS          :# DROP      -> Just DROP+  JOIN_TICKETS     :# DROP      -> Just DROP+  _                             -> Nothing  -- | Append LHS of 'Seq' to RHS and re-run pointwise ocRuleset at each point. --   That might cause reinvocation of this function (see 'defaultRules'),

@@ -23,24 +23,24 @@ import qualified Michelson.Untyped as U  -- | Convert an untyped contract into a textual representation which--- will be accepted by the OCaml reference client.+-- will be accepted by the OCaml reference client: tezos-client. printUntypedContract :: (RenderDoc op) => Bool -> U.Contract' op -> TL.Text printUntypedContract forceSingleLine = printDoc forceSingleLine . renderDoc doesntNeedParens  -- | Convert a typed contract into a textual representation which--- will be accepted by the OCaml reference client.+-- will be accepted by the OCaml reference client: tezos-client. printTypedContractCode :: (SingI p, SingI s) => Bool -> T.ContractCode p s -> TL.Text printTypedContractCode forceSingleLine =   printUntypedContract forceSingleLine . T.convertContractCode  -- | Convert typed contract into a textual representation which--- will be accepted by the OCaml reference client.+-- will be accepted by the OCaml reference client: tezos-client. printTypedContract :: Bool -> T.Contract p s -> TL.Text printTypedContract forceSingleLine fc@T.Contract{} =   printUntypedContract forceSingleLine $ T.convertContract fc  -- | Convert typed value into a textual representation which--- will be accepted by the OCaml reference client.+-- will be accepted by the OCaml reference client: tezos-client. printTypedValue   :: forall t.       (T.ProperPrintedValBetterErrors t)@@ -50,13 +50,13 @@   printUntypedValue forceSingleLine . T.untypeValue  -- | Convert untyped value into a textual representation which--- will be accepted by the OCaml reference client.+-- will be accepted by the OCaml reference client: tezos-client. printUntypedValue :: (RenderDoc op) => Bool -> U.Value' op -> TL.Text printUntypedValue forceSingleLine =   printDoc forceSingleLine . renderDoc doesntNeedParens  -- | Convert 'SomeContract' into a textual representation which--- will be accepted by the OCaml reference client.+-- will be accepted by the OCaml reference client: tezos-client. printSomeContract :: Bool -> T.SomeContract -> TL.Text printSomeContract forceSingleLine (T.SomeContract fc) =   printTypedContract forceSingleLine fc

@@ -27,7 +27,7 @@ dummyNow = Timestamp 100  dummyLevel :: Natural-dummyLevel = 0+dummyLevel = 4000  -- | Dummy value for maximal number of steps a contract can -- make. Intentionally quite large, because most likely if you use

@@ -30,6 +30,7 @@ import Data.Vinyl (Rec(..)) import Fmt (Buildable(..), Builder, blockListF, fmt, indentF, listF, pretty, unlinesF) + import Michelson.Text import Michelson.Typed.Aliases import Michelson.Typed.Annotation (Notes(..))@@ -40,6 +41,7 @@ import Michelson.Typed.Sing (SingT(..)) import Michelson.Typed.T (T(..)) import Michelson.Typed.Value+import Michelson.Printer.Util import qualified Michelson.Untyped as U import Michelson.Untyped.Annotation (Annotation(unAnnotation)) import Tezos.Address (Address(..), ContractHash(..))@@ -761,6 +763,12 @@  instance (SingI t, HasNoOp t) => Buildable (Value' Instr t) where   build = build . untypeValue++instance Buildable (Instr inp out) where+  build = buildRenderDocExtended++instance RenderDoc (Instr inp out) where+  renderDoc context = renderDocList context . instrToOps  -- | Generate a value used for generating examples in documentation. --

@@ -5,6 +5,7 @@ {-# LANGUAGE StandaloneKindSignatures #-} {-# OPTIONS_GHC -Wno-unused-top-binds #-} {-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wno-redundant-constraints #-}  -- | Module, providing singleton boilerplate for -- 'T' data types.

@@ -798,9 +798,9 @@       let va1 = firstAnn @VarTag as1       let va2 = firstAnn @VarTag as2       l <- fromExpression $ removeAnns arg1-        (liftA2 (||) isAnnotationField isAnnotationVariable)+        (isAnnotationField || isAnnotationVariable)       r <- fromExpression $ removeAnns arg2-        (liftA2 (||) isAnnotationField isAnnotationVariable)+        (isAnnotationField || isAnnotationVariable)       pure $ Untyped.TPair fa1 fa2 va1 va2 l r     PrimExpr "pair" args [] ->       case (nonEmpty args) >>= forbidSingletonList of

@@ -18,9 +18,12 @@   ) where  import Data.Singletons (SingI (..))+import Text.PrettyPrint.Leijen.Text (integer) import Util.Peano (Nat (Z, S), SingNat(..), ToPeano) import qualified GHC.TypeNats as GHC (Nat) +import Michelson.Printer.Util+ -- | PeanoNatural data type -- -- The @PN@ constructor stores @s :: SingNat n@ and @k :: Natural@@@ -32,6 +35,9 @@  deriving stock instance Show (PeanoNatural n) deriving stock instance Eq (PeanoNatural n)++instance RenderDoc (PeanoNatural n) where+  renderDoc _ = integer . toInteger . fromPeanoNatural  instance NFData (PeanoNatural n) where   rnf (PN s _) = rnf s