indigo 0.1.0.0 → 0.2.0

raw patch · 20 files changed

+109/−94 lines, 20 filesdep +clevelandPVP ok

version bump matches the API change (PVP)

Dependencies added: cleveland

API changes (from Hackage documentation)

Files

• CHANGES.md +5/−0
• README.md +3/−3
• indigo.cabal +3/−2
• src/Indigo/Backend.hs +7/−7
• src/Indigo/Backend/Case.hs +6/−12
• src/Indigo/Frontend/Language.hs +36/−15
• src/Indigo/Frontend/Statement.hs +5/−5
• src/Indigo/Internal/Expr/Symbolic.hs +5/−5
• src/Indigo/Internal/Expr/Types.hs +2/−2
• src/Indigo/Internal/State.hs +2/−2
• src/Indigo/Lorentz.hs +4/−3
• test/Main.hs +1/−1
• test/Test/Code/Decomposition.hs +3/−4
• test/Test/Code/Examples.hs +9/−15
• test/Test/Code/Lambda.hs +3/−3
• test/Test/Decomposition.hs +3/−2
• test/Test/Examples.hs +3/−4
• test/Test/Expr.hs +8/−7
• test/Test/Lambda.hs +1/−1
• test/Test/Lookup.hs +0/−1

@@ -1,3 +1,8 @@+0.2.0+=====+* [!542](https://gitlab.com/morley-framework/morley/-/merge_requests/542)+  Use `#=` as a synonym for `//->`.+ 0.1.0.0 ======= 

@@ -9,7 +9,7 @@ It is built on top of `Lorentz`, which in turn is built on top of `Morley`, a dialect that is a superset of vanilla Michelson. If you are interested more in the relationships between these projects you can-start by taking a look at [Morley's README](../../README.md).+start by taking a look at [the repo on GitLab](https://gitlab.com/morley-framework/morley).  ## Overall idea @@ -30,6 +30,6 @@  ## Tutorial and documentation -Indigo has a tutorial that you can find [here](tutorial/).+Indigo has a tutorial that you can find at [indigo-lang.gitlab.io](https://indigo-lang.gitlab.io/). -In addition, as for the other Morley projects, it has Haddock documentation.+In addition, as for the other Morley projects, it has [Haddock documentation](https://hackage.haskell.org/package/indigo).

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 89d2d9515cfb2c4865221da490f19007abfc84bf0545ecf6319d2c748bb5f52a+-- hash: 4ddca34d74587bae4cd69ff4a36aa20d8c7ae38da4031d1669a7d7a9d5b53a53  name:           indigo-version:        0.1.0.0+version:        0.2.0 synopsis:       Convenient imperative eDSL over Lorentz. description:    Syntax and implementation of Indigo eDSL. category:       Language@@ -111,6 +111,7 @@   build-depends:       HUnit     , base >=4.7 && <5+    , cleveland     , containers     , fmt     , hedgehog

@@ -58,8 +58,8 @@ import Indigo.Internal import Indigo.Lorentz import qualified Lorentz.Doc as L-import qualified Lorentz.EntryPoints.Doc as L (finalizeParamCallingDoc)-import Lorentz.EntryPoints.Helpers (RequireSumType)+import qualified Lorentz.Entrypoints.Doc as L (finalizeParamCallingDoc)+import Lorentz.Entrypoints.Helpers (RequireSumType) import qualified Lorentz.Instr as L import qualified Michelson.Typed as MT import Util.Type (type (++))@@ -158,18 +158,18 @@ selfCalling   :: forall p inp mname.      ( NiceParameterFull p-     , KnownValue (GetEntryPointArgCustom p mname)+     , KnownValue (GetEntrypointArgCustom p mname)      )-  => EntryPointRef mname-  -> IndigoState inp (ContractRef (GetEntryPointArgCustom p mname) & inp)-                     (Var (ContractRef (GetEntryPointArgCustom p mname)))+  => EntrypointRef mname+  -> IndigoState inp (ContractRef (GetEntrypointArgCustom p mname) & inp)+                     (Var (ContractRef (GetEntrypointArgCustom p mname))) selfCalling epRef = do   nullaryOp (L.selfCalling @p epRef)   makeTopVar  contractCalling   :: forall cp inp epRef epArg addr exAddr.-     ( HasEntryPointArg cp epRef epArg+     ( HasEntrypointArg cp epRef epArg      , ToTAddress cp addr      , ToT addr ~ ToT Address      , IsExpr exAddr addr

@@ -7,8 +7,7 @@ -- | High level statements of Indigo language.  module Indigo.Backend.Case-  ( (#=)-  , caseRec+  ( caseRec   , entryCaseRec   , entryCaseSimpleRec @@ -27,7 +26,7 @@ import Indigo.Internal import Indigo.Lorentz import qualified Lorentz.ADT as L-import qualified Lorentz.EntryPoints.Doc as L+import qualified Lorentz.Entrypoints.Doc as L import qualified Lorentz.Instr as L import Michelson.Typed.Haskell.Instr.Sum   (CaseClauseParam(..), CaseClauses, CtorField(..), InstrCaseC)@@ -71,11 +70,6 @@                   liftClear' @(ClassifyReturnValue retBr) @retBr @(x & inp) @inp L.drop       ) --- | An alias for '/->' to use when the body is a lambda so that the--- whole thing won't have multiple arrows.-(#=) :: CaseArrow name body clause => Label name -> body -> clause-(#=) a b = a /-> b- -- This constraint is shared by all @case*@ functions. type CaseCommonF f dt guard ret clauses =      ( guard :~> dt@@ -99,11 +93,11 @@  -- | 'case_' for pattern-matching on parameter. entryCaseRec-  :: forall dt entryPointKind guard inp ret clauses .+  :: forall dt entrypointKind guard inp ret clauses .   ( CaseCommon dt guard ret clauses-  , DocumentEntryPoints entryPointKind dt+  , DocumentEntrypoints entrypointKind dt   )-  => Proxy entryPointKind+  => Proxy entrypointKind   -> guard   -> clauses   -> IndigoState inp (RetOutStack ret ++ inp) (RetVars ret)@@ -115,7 +109,7 @@ entryCaseSimpleRec   :: forall cp guard inp ret clauses .      ( CaseCommon cp guard ret clauses-     , DocumentEntryPoints PlainEntryPointsKind cp+     , DocumentEntrypoints PlainEntrypointsKind cp      , NiceParameterFull cp      , RequireFlatParamEps cp      )

@@ -45,6 +45,7 @@   , entryCaseRec   , entryCaseSimple   , (//->)+  , (#=)    -- * Scope   , scope@@ -113,7 +114,7 @@ import Indigo.Internal hiding (SetField, return, (>>), (>>=)) import Indigo.Lorentz import Indigo.Prelude-import Lorentz.EntryPoints.Helpers (RequireSumType)+import Lorentz.Entrypoints.Helpers (RequireSumType) import qualified Lorentz.Instr as L import qualified Lorentz.Run as L import qualified Michelson.Typed as MT@@ -394,11 +395,11 @@  -- | 'caseRec' for pattern-matching on parameter. entryCaseRec-  :: forall dt entryPointKind guard ret clauses .+  :: forall dt entrypointKind guard ret clauses .      ( CaseCommonF (IndigoMCaseClauseL IndigoM) dt guard ret clauses-     , DocumentEntryPoints entryPointKind dt+     , DocumentEntrypoints entrypointKind dt      )-  => Proxy entryPointKind+  => Proxy entrypointKind   -> guard   -> clauses   -> IndigoM (RetVars ret)@@ -406,12 +407,12 @@  -- | 'entryCaseRec' for tuples. entryCase-  :: forall dt entryPointKind guard ret clauses .+  :: forall dt entrypointKind guard ret clauses .      ( CaseCommonF (IndigoMCaseClauseL IndigoM) dt guard ret clauses      , RecFromTuple clauses-     , DocumentEntryPoints entryPointKind dt+     , DocumentEntrypoints entrypointKind dt      )-  => Proxy entryPointKind+  => Proxy entrypointKind   -> guard   -> IsoRecTuple clauses   -> IndigoM (RetVars ret)@@ -421,7 +422,7 @@   :: forall cp guard ret clauses .      ( CaseCommonF (IndigoMCaseClauseL IndigoM) cp guard ret clauses      , RecFromTuple clauses-     , DocumentEntryPoints PlainEntryPointsKind cp+     , DocumentEntrypoints PlainEntrypointsKind cp      , NiceParameterFull cp      , RequireFlatParamEps cp      )@@ -430,12 +431,32 @@   -> IndigoM (RetVars ret) entryCaseSimple g = oneIndigoM . EntryCaseSimple g . recFromTuple @clauses +{-# DEPRECATED (//->) "use '#=' instead" #-}+-- | An alias for '#=' kept only for backward compatibility.+(//->)+  :: ( CaseArrow name (Var x -> IndigoAnyOut x ret)+                      (IndigoCaseClauseL ret ('CaseClauseParam ctor ('OneField x)))+     , ScopeCodeGen retBr+     , ret ~ RetExprs retBr+     , RetOutStack ret ~ RetOutStack retBr+     , KnownValue x+     , name ~ (AppendSymbol "c" ctor)+     )+  => Label name+  -> (Var x -> IndigoM retBr)+  -> IndigoMCaseClauseL IndigoM ret ('CaseClauseParam ctor ('OneField x))+(//->) cName b = OneFieldIndigoMCaseClauseL cName b+infixr 0 //->+ -- | Use this instead of '/->'. -- -- This operator is like '/->' but wraps a body into 'IndigoAnyOut', -- which is needed for two reasons: to allow having any output stack -- and to allow returning not exactly the same values.-(//->)+--+-- It has the added benefit of not being an arrow, so in case the body of the+-- clause is a lambda there won't be several.+(#=)   :: ( CaseArrow name (Var x -> IndigoAnyOut x ret)                       (IndigoCaseClauseL ret ('CaseClauseParam ctor ('OneField x)))      , ScopeCodeGen retBr@@ -447,8 +468,8 @@   => Label name   -> (Var x -> IndigoM retBr)   -> IndigoMCaseClauseL IndigoM ret ('CaseClauseParam ctor ('OneField x))-(//->) cName b = OneFieldIndigoMCaseClauseL cName b-infixr 0 //->+(#=) cName b = OneFieldIndigoMCaseClauseL cName b+infixr 0 #=  ---------------------------------------------------------------------------- -- Scope & Functions@@ -632,15 +653,15 @@ selfCalling   :: forall p mname.      ( NiceParameterFull p-     , KnownValue (GetEntryPointArgCustom p mname)+     , KnownValue (GetEntrypointArgCustom p mname)      )-  => EntryPointRef mname-  -> IndigoM (Var (ContractRef (GetEntryPointArgCustom p mname)))+  => EntrypointRef mname+  -> IndigoM (Var (ContractRef (GetEntrypointArgCustom p mname))) selfCalling ep = liftIndigoState $ toSIS $ B.selfCalling @p ep  contractCalling   :: forall cp epRef epArg addr exAddr.-     ( HasEntryPointArg cp epRef epArg+     ( HasEntrypointArg cp epRef epArg      , ToTAddress cp addr      , ToT addr ~ ToT Address      , exAddr :~> addr

@@ -14,7 +14,7 @@ import qualified Data.Kind as Kind import Util.TypeLits (AppendSymbol) -import Lorentz.EntryPoints.Helpers (RequireSumType)+import Lorentz.Entrypoints.Helpers (RequireSumType) import qualified Lorentz.Run as L (Contract) import Michelson.Typed.Haskell.Instr.Sum (CaseClauseParam(..), CtorField(..)) @@ -127,15 +127,15 @@        -> StatementF freer (RetVars ret)   EntryCase ::     ( CaseCommonF (IndigoMCaseClauseL freer) dt guard ret clauses-    , DocumentEntryPoints entryPointKind dt+    , DocumentEntrypoints entrypointKind dt     )-    => Proxy entryPointKind+    => Proxy entrypointKind     -> guard     -> clauses     -> StatementF freer (RetVars ret)   EntryCaseSimple ::          ( CaseCommonF (IndigoMCaseClauseL freer) cp guard ret clauses-         , DocumentEntryPoints PlainEntryPointsKind cp+         , DocumentEntrypoints PlainEntrypointsKind cp          , NiceParameterFull cp          , RequireFlatParamEps cp          )@@ -178,7 +178,7 @@     -> exs     -> StatementF freer (Var Address)   ContractCalling ::-     ( HasEntryPointArg cp epRef epArg+     ( HasEntrypointArg cp epRef epArg      , ToTAddress cp addr      , ToT addr ~ ToT Address      , exAddr :~> addr

@@ -112,7 +112,7 @@ import qualified Michelson.Typed.Arith as M import Util.TypeTuple import Michelson.Text (unMText)-import Michelson.Untyped.EntryPoints (unsafeBuildEpName)+import Michelson.Untyped.Entrypoints (unsafeBuildEpName)  ---------------------------------------------------------------------------- -- Basic@@ -612,8 +612,8 @@   => exDt   -> (Label name, exFld)   -> Expr dt-(!!) (toExpr -> (ObjMan fa)) (fName, fld) = ObjMan (SetField fa fName (toExpr fld))-dt !! (fName, fld) = ObjMan (SetField (Object $ toExpr dt) fName (toExpr fld))+(!!) (toExpr -> (ObjMan fa)) (fName, eFld) = ObjMan (SetField fa fName (toExpr eFld))+dt !! (fName, eFld) = ObjMan (SetField (Object $ toExpr dt) fName (toExpr eFld))  ---------------------------------------------------------------------------- -- Record and Named@@ -663,7 +663,7 @@  contract   :: ( NiceParameterFull p-     , NoExplicitDefaultEntryPoint p+     , NoExplicitDefaultEntrypoint p      , ToTAddress p addr      , ToT addr ~ ToT Address      , exAddr :~> addr@@ -673,7 +673,7 @@  self   :: ( NiceParameterFull p-     , NoExplicitDefaultEntryPoint p+     , NoExplicitDefaultEntrypoint p      )   => Expr (ContractRef p) self = Self

@@ -302,7 +302,7 @@    Contract     :: ( NiceParameterFull p-       , NoExplicitDefaultEntryPoint p+       , NoExplicitDefaultEntrypoint p        , ToTAddress p addr        , ToT addr ~ ToT Address        , IsExpr exAddr addr@@ -311,7 +311,7 @@    Self     :: ( NiceParameterFull p-       , NoExplicitDefaultEntryPoint p+       , NoExplicitDefaultEntrypoint p        )     => Expr (ContractRef p) 

@@ -2,7 +2,7 @@ -- -- SPDX-License-Identifier: LicenseRef-MIT-TQ -{-# LANGUAGE DerivingStrategies, InstanceSigs #-}+{-# LANGUAGE InstanceSigs #-}  {- | This module contains the core of Indigo language:@@ -37,7 +37,7 @@   ) where  import qualified Data.Kind as Kind-import Data.Type.Equality (TestEquality (..))+import Data.Type.Equality (TestEquality(..)) import Data.Typeable (eqT)  import Indigo.Backend.Prelude

@@ -12,7 +12,8 @@   ( module L   ) where -import Lorentz.ADT as L hiding (caseT, case_, construct, constructT, HasField, setField)+import Lorentz.ADT as L hiding (HasField, caseT, case_, construct, constructT, setField)+import Lorentz.Annotation as L (HasAnnotation) import Lorentz.Arith as L import Lorentz.Base as L import Lorentz.Coercions as L@@ -20,8 +21,8 @@ import Lorentz.Constraints as L import Lorentz.Doc as L hiding   (contractGeneral, contractGeneralDefault, contractName, doc, docGroup, docStorage)-import Lorentz.EntryPoints as L-import Lorentz.EntryPoints.Doc as L hiding+import Lorentz.Entrypoints as L+import Lorentz.Entrypoints.Doc as L hiding   (entryCase, entryCaseSimple, entryCase_, finalizeParamCallingDoc) import Lorentz.Errors as L hiding (failCustom, failCustom_) import Lorentz.Errors.Common as L ()

@@ -9,7 +9,7 @@ import Prelude import Test.Tasty (defaultMainWithIngredients) -import Util.Test.Ingredients (ourIngredients)+import Cleveland.Ingredients (ourIngredients) import Test.Util.Golden (regenerateTests) import Tree (tests) 

@@ -12,17 +12,16 @@   ) where  import Indigo-import Lorentz.TypeAnns (HasTypeAnn)  data Meta = Meta   { mWeight :: Integer   , mDescr  :: MText   } deriving stock (Generic, Show)-    deriving anyclass (IsoValue)+    deriving anyclass (IsoValue, HasAnnotation)  data Color = Blue | White | Red   deriving stock (Generic, Show, Enum, Bounded)-  deriving anyclass (IsoValue, HasTypeAnn)+  deriving anyclass (IsoValue, HasAnnotation)  data Storage = Storage   { sColor :: Color@@ -30,7 +29,7 @@   , sY :: Integer   , sMeta :: Meta   } deriving stock (Generic, Show)-    deriving anyclass (IsoValue)+    deriving anyclass (IsoValue, HasAnnotation)  instance HasField Meta "weight" Integer where   fieldLens = fieldLensADT #mWeight

@@ -34,13 +34,7 @@     return ()  ifTest :: L.Contract Integer Integer-ifTest = noOptimizationContract $ compileIndigoContract $ \param -> do-  a <- new$ 7 int + param-  when (param < a) do-    _c <- new$ storageVar @Integer-    return ()-  _c <- new$ param < storageVar @Integer-  return ()+ifTest = noOptimizationContract contractIfValueLorentz  contractIfLorentz :: ContractCode Integer Integer contractIfLorentz = L.cCode ifTest@@ -79,14 +73,14 @@   -- 2. branches can return not exactly the same types   ---   it's useful when you have case bodies in-place, like   --      case_ param $-  --        ( #cSomething1 //-> const $ return (5 int)-  --        , #cSomething2 //-> (\var -> return (10 +. var))-  --        , #cSomething3 //-> return var)+  --        ( #cSomething1 #= const $ return (5 int)+  --        , #cSomething2 #= (\var -> return (10 +. var))+  --        , #cSomething3 #= return var)   -- Pay attention, that all three branches have different return types   -- but they all correspond to the same expression 'Expr Integer'.   _flag <- case_ param $-          ( #cDSub //-> doSub storageVar-          , #cDAdd //-> doAdd storageVar+          ( #cDSub #= doSub storageVar+          , #cDAdd #= doAdd storageVar           )   return () @@ -96,8 +90,8 @@   deriving stock (Generic, Show)   deriving anyclass (IsoValue) -instance ParameterHasEntryPoints DummyOp where-  type ParameterEntryPointsDerivation DummyOp = EpdPlain+instance ParameterHasEntrypoints DummyOp where+  type ParameterEntrypointsDerivation DummyOp = EpdPlain  doSub :: Var Integer -> Var (Integer, Integer) -> IndigoM (Var Bool) doSub storage p = do@@ -123,7 +117,7 @@ contractOpsLorentz :: ContractCode (Maybe KeyHash) Address contractOpsLorentz = compileIndigoContract $ \param -> do   setDelegate param-  m <- new$ 0 mutez+  m <- new$ zeroMutez   is <- new$ 0 int   addr <- createLorentzContract ifTest param m is   storageVar =: addr

@@ -15,9 +15,9 @@  import Indigo import qualified Lorentz as L-import Lorentz.TypeAnns (HasTypeAnn) import Test.Util +{-# ANN sumLambda ("HLint: ignore Use uncurry" :: Text) #-} sumLambda :: pr :~> (Integer, Integer) => pr -> IndigoM (Var Integer) sumLambda = defNamedPureLambda1 "add" $  \pr -> pure (fst pr + snd pr) @@ -44,7 +44,7 @@   , HasSideEffects, HasStorage Integer   ) => ex -> IndigoM () lambdaCreateContract = defNamedEffLambda1 @Integer "create storage" $ \paramSt -> do-  m <- new$ 0 mutez+  m <- new$ zeroMutez   _addr <- createLorentzContract dummyContract (fst paramSt) m (snd paramSt)   storageVar @Integer += 1 int @@ -68,7 +68,7 @@ newtype SmallMatrix = SmallMatrix [[Integer]]   deriving stock (Generic, Show)   deriving anyclass (IsoValue)-  deriving newtype (IterOpHs, HasTypeAnn)+  deriving newtype (IterOpHs, HasAnnotation)  sumInRowTwice :: (HasStorage Integer, lst :~> [Integer]) => lst -> IndigoM () sumInRowTwice = defNamedLambda1 @Integer "sum of the list" $ \lst -> do

@@ -19,9 +19,10 @@ import qualified Hedgehog.Range as Range import Test.Tasty (TestTree) +import Cleveland.Util (genTuple2)+import Hedgehog.Gen.Michelson (genMText) import Michelson.Interpret (MichelsonFailed(..))-import Michelson.Test.Util (genTuple2)-import Michelson.Text (genMText, mt)+import Michelson.Text (mt) import Test.Code.Decomposition import Test.Util 

@@ -41,16 +41,16 @@ import qualified Hedgehog.Range as Range import Test.Tasty (TestTree) +import Cleveland.Util (genTuple2)+import Hedgehog.Gen.Tezos.Address (genAddress)+import Hedgehog.Gen.Tezos.Crypto (genKeyHash) import Lorentz import Michelson.Doc (DName(..)) import Michelson.Interpret (MichelsonFailed(..)) import Michelson.Runtime.GState-import Michelson.Test.Util (genTuple2) import qualified Michelson.Typed as T import Test.Code.Examples import Test.Util-import Tezos.Address (genAddress)-import Tezos.Crypto (genKeyHash)  -------------------------------------------------------------------------------- -- Tests@@ -270,4 +270,3 @@   drop # drop #   -- return `st`   swap # pair-

@@ -19,22 +19,23 @@ import qualified Hedgehog.Range as Range import Test.Tasty (TestTree) +import Cleveland.Util (genTuple2)+import Hedgehog.Gen.Lorentz.UStore (genUStoreFieldExt, genUStoreSubMap)+import Hedgehog.Gen.Michelson (genMText)+import Hedgehog.Gen.Michelson.Typed (genBigMap)+import Hedgehog.Gen.Tezos.Address (genAddress)+import Hedgehog.Gen.Tezos.Core (genChainId, genMutez)+import Hedgehog.Gen.Tezos.Crypto (genKeyHash, genPublicKey, genSignature) import qualified Indigo as I import Indigo.Lorentz-import Lorentz.UStore.Types (genUStoreFieldExt, genUStoreSubMap) import Michelson.Interpret (MichelsonFailed(..), runUnpack) import Michelson.Interpret.Pack import Michelson.Runtime.GState (genesisAddress)-import Michelson.Test.Gen (genMutez)-import Michelson.Test.Util (genTuple2) import Michelson.Text-import Michelson.Typed (genBigMap) import qualified Michelson.Typed as T import Test.Code.Expr import Test.Util-import Tezos.Address (genAddress)-import Tezos.Core-import Tezos.Crypto (genKeyHash, genPublicKey, genSignature)+import Tezos.Core (dummyChainId, unsafeMkMutez) import qualified Tezos.Crypto as C  genMyTemplate :: Gen MyTemplate

@@ -25,13 +25,13 @@ import Test.Tasty (TestTree) import Test.Tasty.HUnit (testCase) +import Hedgehog.Gen.Tezos.Crypto (genKeyHash) import Lorentz hiding (map) import Michelson.Interpret (MichelsonFailed(..)) import Michelson.Runtime.GState import qualified Michelson.Typed as T import Test.Code.Lambda import Test.Util-import Tezos.Crypto (genKeyHash)  test_Lambdas :: [TestTree] test_Lambdas =

@@ -15,7 +15,6 @@ import Test.HUnit (Assertion, (@?=)) import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit (testCase)-import Util.Test.Arbitrary ()  import Indigo hiding (fromInteger) import Indigo.Backend.Prelude (fromInteger)