lorentz 0.7.0 → 0.7.1

raw patch · 8 files changed

+287/−19 lines, 8 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGES.md +7/−0
• README.md +15/−15
• lorentz.cabal +3/−1
• src/Lorentz.hs +2/−0
• src/Lorentz/Errors.hs +3/−0
• src/Lorentz/Macro.hs +3/−3
• src/Lorentz/OpSize.hs +38/−0
• src/Lorentz/ReferencedByName.hs +216/−0

@@ -1,3 +1,10 @@+0.7.1+=====+* [!653](https://gitlab.com/morley-framework/morley/-/merge_requests/653)+  Added primitives for evaluating `OpSize` in Lorentz.+* [!651](https://gitlab.com/morley-framework/morley/-/merge_requests/651)+  Add `dupL`.+ 0.7.0 ===== * [!629](https://gitlab.com/morley-framework/morley/-/merge_requests/629)

@@ -4,10 +4,10 @@  ## Table of contents -* [Overview](#overview)-* [Writing contracts in Lorentz](#writing-contracts-in-lorentz)-* [Lorentz contract example](#lorentz-example)-* [FAQ](#faq)+* [Overview](https://gitlab.com/morley-framework/morley/-/tree/master/code/lorentz#overview)+* [Writing contracts in Lorentz](https://gitlab.com/morley-framework/morley/-/tree/master/code/lorentz#writing-contracts-in-lorentz)+* [Lorentz contract example](https://gitlab.com/morley-framework/morley/-/tree/master/code/lorentz#lorentz-example)+* [FAQ](https://gitlab.com/morley-framework/morley/-/tree/master/code/lorentz#faq)  ## Overview @@ -15,17 +15,17 @@  Haskell's type checker and automatic type inference facilitate contracts implementation and reduce boilerplate related to types. Adoption of Algebraic Data Types makes work with complex objects safe and convenient.-Later Lorentz contract can be dumped as a plain textual Michelson contract using functions from [`Michelson.Printer`](../morley/src/Michelson/Printer.hs).+Later Lorentz contract can be dumped as a plain textual Michelson contract using functions from [`Michelson.Printer`](http://hackage.haskell.org/package/morley/docs/Michelson-Printer.html).  As an addition, you can optimize the transpiled Michelson contract before printing-using functions from [`Michelson.Optimizer`](../morley/src/Michelson/Optimizer.hs).+using functions from [`Michelson.Optimizer`](http://hackage.haskell.org/package/morley/docs/Michelson-Optimizer.html). E.g. this optimizer will replace `IF {} {}` with `DROP`. For more possible optimizations please refer to the module mentioned earlier. -You can find Lorentz instructions in [`Lorentz`](src/Lorentz.hs) modules.+You can find Lorentz instructions in [`Lorentz`](http://hackage.haskell.org/package/lorentz/docs/Lorentz.html) modules. -Examples of using Lorentz eDSL reside in the [`morley-multisig`](../morley-multisig) package.-For more information, refer to that package's [README](/code/morley-multisig/README.md).+Examples of using Lorentz eDSL reside in the [`morley-multisig`](https://gitlab.com/morley-framework/morley/-/tree/master/code/morley-multisig) package.+For more information, refer to that package's [README](https://gitlab.com/morley-framework/morley/-/blob/master/code/morley-multisig/README.md).  Also, to get more information about Lorentz you can read our [blogpost](https://serokell.io/blog/lorentz-implementing-smart-contract-edsl-in-haskell). @@ -51,8 +51,8 @@ type ContractCode parameter storage = '[(parameter, storage)] :-> ContractOut storage ``` -Lorentz reimplements all existing [instructions](./src/Lorentz/Instr.hs) and-[macros](./src/Lorentz/Macro.hs) from Michelson.+Lorentz reimplements all existing [instructions](http://hackage.haskell.org/package/lorentz/docs/Lorentz-Instr.html) and+[macros](http://hackage.haskell.org/package/lorentz/docs/Lorentz-Macro.html) from Michelson.  Apart from reimplementing existing Michelson functionality, Lorentz provides bunch of additional features:@@ -111,8 +111,8 @@    Lorentz provides primitives for embedding documentation in the contract code and   functions to produce documentation in Markdown, they can be found in-  [`Lorentz.Doc`](./src/Lorentz/Doc.hs) and [`Michelson.Doc`](../morley/src/Michelson/Doc.hs) modules.-  Documentation examples can be found [here](https://gitlab.com/morley-framework/morley/-/tree/autodoc/master/morley-multisig/autodoc).+  [`Lorentz.Doc`](http://hackage.haskell.org/package/lorentz/docs/Lorentz-Doc.html) and [`Michelson.Doc`](http://hackage.haskell.org/package/morley/docs/Michelson-Doc.html) modules.+  Documentation examples can be found [here](https://gitlab.com/morley-framework/morley/-/tree/autodoc/master/autodoc).  <a name="lorentz-example"></a> ## Sample smart contract written in Lorentz@@ -170,7 +170,7 @@  ### Generated documentation -Generated documentation for this contract can be found [here](./doc/sampleAutodoc.md).+Generated documentation for this contract can be found [here](https://gitlab.com/morley-framework/morley/-/blob/master/code/lorentz/doc/sampleAutodoc.md).  ### Transpiled Michelson contract @@ -202,7 +202,7 @@ <!-- This question should be removed once https://gitlab.com/morley-framework/morley/issues/79 is resolved --> * Q: I added a new parameter case to contract and GHC went mad. -  A: Ensure that your number of entry points does not exceed the limit set in [`Util.TypeTuple.Instances`](../morley/src/Util/TypeTuple/Instances.hs).+  A: Ensure that your number of entry points does not exceed the limit set in [`Util.TypeTuple.Instances`](http://hackage.haskell.org/package/morley/docs/Util-TypeTuple-Instances.html).  * Q: I added one more datatype that is used in the contract and GHC reports with errors related      to `Rep` type family.

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           lorentz-version:        0.7.0+version:        0.7.1 synopsis:       EDSL for the Michelson Language description:    Lorentz is a powerful meta-programming tool which allows one to write Michelson contracts directly in Haskell. It has the same instructions as Michelson, but operates on Haskell values and allows one to use Haskell features. category:       Language@@ -56,12 +56,14 @@       Lorentz.Extensible       Lorentz.Instr       Lorentz.Macro+      Lorentz.OpSize       Lorentz.Pack       Lorentz.Polymorphic       Lorentz.Prelude       Lorentz.Print       Lorentz.Rebinded       Lorentz.Referenced+      Lorentz.ReferencedByName       Lorentz.Run       Lorentz.StoreClass       Lorentz.UParam

@@ -23,12 +23,14 @@ import Lorentz.Ext as Exports import Lorentz.Instr as Exports import Lorentz.Macro as Exports+import Lorentz.OpSize as Exports import Lorentz.Pack as Exports import Lorentz.Polymorphic as Exports import Lorentz.Prelude as Exports import Lorentz.Print as Exports import Lorentz.Rebinded as Exports import Lorentz.Referenced as Exports+import Lorentz.ReferencedByName as Exports import Lorentz.Run as Exports import Lorentz.StoreClass as Exports import Lorentz.UParam as Exports

@@ -287,6 +287,9 @@ deriving stock instance Eq (ErrorArg tag) => Eq (CustomError tag) deriving stock instance Show (ErrorArg tag) => Show (CustomError tag) +instance Buildable (CustomError tag) where+  build (CustomError tg _err) = "CustomError #" +| build tg+ -- | How 'CustomError' is actually represented in Michelson. type CustomErrorRep tag = (MText, ErrorArg tag) 

@@ -358,13 +358,13 @@ class DuupX (n :: Peano) (s :: [Kind.Type]) (a :: Kind.Type) s1 tail where   duupXImpl :: s :-> a ': s -instance {-# OVERLAPPING #-} (s ~ (a ': xs)) => DuupX ('S 'Z) s a s1 tail where+instance (s ~ (a ': xs)) => DuupX ('S 'Z) s a s1 tail where   duupXImpl = dup -instance {-# OVERLAPPING #-} DuupX ('S ('S 'Z)) (b ': a ': xs) a s1 tail where+instance DuupX ('S ('S 'Z)) (b ': a ': xs) a s1 tail where   duupXImpl = dip dup # swap -instance {-# OVERLAPPABLE #-} (ConstraintDuupXLorentz ('S ('S n)) s a s1 tail) =>+instance (ConstraintDuupXLorentz ('S ('S n)) s a s1 tail) =>   DuupX ('S ('S ('S n))) s a s1 tail where   duupXImpl =     -- 'stackType' helps GHC deduce types

@@ -0,0 +1,38 @@+-- SPDX-FileCopyrightText: 2020 Tocqueville Group+--+-- SPDX-License-Identifier: LicenseRef-MIT-TQ++-- | Operation size evaluation.+module Lorentz.OpSize+  ( OpSize (..)+  , T.opSizeHardLimit+  , T.smallTransferOpSize++  , contractOpSize+  , valueOpSize+  ) where++import Data.Constraint ((\\))++import Lorentz.Constraints+import Lorentz.Run+import Lorentz.Value+import Michelson.Typed (OpSize)+import qualified Michelson.Typed as T++-- | Estimate code operation size.+contractOpSize+  :: (NiceParameterFull cp, NiceStorage st)+  => Contract cp st -> OpSize+contractOpSize =+  T.contractOpSize . compileLorentzContract++{- We do not provide a method for plain lorentz code because it can be+   compiled differently (e.g. with optimizations or not).+-}++-- | Estimate value operation size.+valueOpSize :: forall a. (NicePrintedValue a) => a -> OpSize+valueOpSize =+  T.valueOpSize . toVal+  \\ nicePrintedValueEvi @a

@@ -0,0 +1,216 @@+-- SPDX-FileCopyrightText: 2020 Tocqueville Group+--+-- SPDX-License-Identifier: LicenseRef-MIT-TQ++{-# LANGUAGE FunctionalDependencies #-}++-- | Referenced-by-name versions of some instructions.+--+-- They allow to "dig" into stack or copy elements of stack referring them+-- by label.+module Lorentz.ReferencedByName+  ( -- * Constraints+    HasNamedVar+  , HasNamedVars+  , (:=)++    -- * Instructions+  , dupL++    -- * Other+  , VarIsUnnamed+  ) where++import Data.Constraint ((\\))+import qualified Data.Kind as Kind+import Data.Singletons (Sing, SingI)+import Named (NamedF(..))++import Lorentz.ADT+import Lorentz.Base+import Lorentz.Coercions+import Lorentz.Instr+import Michelson.Text+import Util.Label+import Util.Peano+import Util.Type+import Util.TypeLits++-- Errors+----------------------------------------------------------------------------++type family StackElemNotFound name :: ErrorMessage where+  StackElemNotFound name =+    'Text "Element with name `" ':<>: 'ShowType name ':<>:+    'Text "` is not present on stack"++data NamedVariableNotFound name++-- Helpers+----------------------------------------------------------------------------++-- | Name of a variable on stack.+data VarNamed = VarNamed Symbol | VarUnnamed | VarNameDummy++-- | Get variable name.+type family VarName (a :: Kind.Type) :: VarNamed where+  VarName (NamedF _ _ name) = 'VarNamed name+  VarName _ = 'VarUnnamed++type family AnyVN :: VarNamed++-- Attach an error message to given variable.+-- If its evaluation is stuck, compiler's attempt to display this type+-- will cause the given error being displayed.+type family Assert (vn :: VarNamed) (err :: Constraint) :: VarNamed where+  Assert 'VarNameDummy _ = AnyVN+  Assert vn _ = vn++type family VarNamePretty' (x :: Kind.Type) (vn :: VarNamed) :: VarNamed where+  VarNamePretty' x vn = Assert vn+    (TypeError+      ('Text "Not clear which name `" ':<>: 'ShowType x ':<>: 'Text "` variable has" ':$$:+       'Text "Consider adding `VarIsUnnamed " ':<>: 'ShowType x ':<>: 'Text "` constraint" ':$$:+       'Text "or carrying a named variable instead"+      )+    )++-- | 'VarName' with pretty error message.+type VarNamePretty x = VarNamePretty' x (VarName x)++-- | Requires type @x@ to be an unnamed variable.+--+-- When e.g. 'dupL' sees a polymorphic variable, it can't judge whether+-- is it a variable we are seeking for or not; @VarIsUnnamed@ helps to+-- assure the type system that given variable won't be named.+type VarIsUnnamed x = VarName x ~ 'VarUnnamed++----------------------------------------------------------------------------+-- Dup+----------------------------------------------------------------------------++-- | Indicates that stack @s@ contains a @name :! var@ or @name :? var@ value.++{- Implementation notes:+We intentially keep this typeclass as simple as possible so that if a user has++@+myFunc :: Integer : s :-> Integer : s+myFunc = something that requires @"globalVar" :! Integer@+@++then user gets clear @Missing `HasEnv s globalVar Integer` instance@ error message,+and can easily add this constraint to his methods.++-}+class HasNamedVar (s :: [Kind.Type]) (name :: Symbol) (var :: Kind.Type)+    | s name -> var where++  -- | 1-based position of the variable on stack.+  varPosition :: VarPosition s name var++data VarPosition (s :: [Kind.Type]) (name :: Symbol) (var :: Kind.Type) where+  VarPosition+    :: (SingI n, KnownPeano n)+    => (Sing (n :: Nat))+    -> VarPosition s name var++instance ( TypeError (StackElemNotFound name)+         , var ~ NamedVariableNotFound name+         ) =>+         HasNamedVar '[] name var where+  varPosition = error "impossible"++instance ( ElemHasNamedVar (ty : s) name var+             (VarNamePretty ty == 'VarNamed name)+         ) =>+         HasNamedVar (ty : s) name var where+  varPosition = elemVarPosition @(ty : s) @name @var @(VarNamePretty ty == 'VarNamed name)++-- Helper for handling each separate variable on stack+class ElemHasNamedVar s name var (nameMatch :: Bool)+    | s name nameMatch -> var where+  elemVarPosition :: VarPosition s name var++instance (ty ~ NamedF f var name) =>+         ElemHasNamedVar (ty : s) name var 'True where+  elemVarPosition = VarPosition SZ++instance (HasNamedVar s name var) =>+         ElemHasNamedVar (ty : s) name var 'False where+  elemVarPosition = case varPosition @s @name @var of+    VarPosition n -> VarPosition (SS n)++-- | Version of 'HasNamedVar' for multiple variables.+--+-- >>> type HasContext = HasNamedVars s ["x" := Integer, "f" := Lambda MText MText]+type family HasNamedVars (s :: [Kind.Type]) (vs :: [NamedField]) :: Constraint where+  HasNamedVars _ '[] = ()+  HasNamedVars s ((n := ty) ': vs) = (HasNamedVar s n ty, HasNamedVars s vs)++-- | Get the variable at @n@-th position on stack, assuming that caller is sure+-- that stack is long enough.+--+-- @martoon: I'm not ready to fight the compiler regarding numerous+-- complex constraints, so just assuring it that those constraints will hold.+dupLUnsafe+  :: forall n s var.+     (SingI n, KnownPeano n)+  => Sing (n :: Nat) -> s :-> var : s+dupLUnsafe _ =+  -- generate dummy type variables+  case (Proxy, Proxy) of+    (_ :: Proxy s', _ :: Proxy (s0 :: [Kind.Type])) ->+      dipNPeano @n (dup :: var : s0 :-> var : var : s0) #+      digPeano @n+        \\ provideConstraintUnsafe @(ConstraintDIPNLorentz n s s' (var : s0) (var : var : s0))+        \\ provideConstraintUnsafe @(ConstraintDIGLorentz n s' (var : s) var)++-- | Take the element with given label on stack and copy it on top.+--+-- If there are multiple variables with given label, the one closest+-- to the top of the stack is picked.+--+-- TODO: maybe call it duupL for consistency? Or better not? :thinking:+dupL :: forall var name s.+        (HasNamedVar s name var)+     => Label name -> s :-> var : s+dupL l = case varPosition @s @name @var of+  VarPosition sn -> dupLUnsafe sn # fromNamed l++{- Note about optimizations:++In @duupX@ we have several separate instances in order to optimize+"duupX @1" and "duupX @2" cases, but I'm not sure whether can we do the same+here and at the same time preserve sane error messages+(like "missing `HasNamedVar s name Integer` instance", without mentioning any internal+details).++Since we are already delving into severely deceving the type system here,+I think we'd better optimize those cases via adding respective rules in+our optimizer (that would be difficult to do in an honest way).++-}++-- Samples+----------------------------------------------------------------------------++_dupSample1+  :: [Integer, Natural, "a" :! (), "b" :! MText, "c" :! ByteString]+  :-> [MText, Integer, Natural, "a" :! (), "b" :! MText, "c" :! ByteString]+_dupSample1 =+  dupL #b++_dupSample2+  :: (HasNamedVar s "x" Natural)+  => (Integer : s)+     :-> (Natural : Integer : s)+_dupSample2 =+  dupL #x++_dupSample3+  :: (HasNamedVar s "x" Natural, VarIsUnnamed store)+  => (store : s)+     :-> (Natural : store : s)+_dupSample3 =+  dupL #x