[#124] revise Indigo operators

Problem: some operators in Indigo are named in an odd way (usually with
a `.`) to avoid conflicts with Haskell operators, additionally many of
them operating on structures have been added organically and do not
follow any convention, being confusing.
Moreover, many of them do not have a prefix counterpart, which may be
useful to have available.

Solution: rename operators, replacing the ones from Prelude in case of
name clashing and based on a convention in case of structure-based.
Addionally, add all necessary prefix counterpart using the names of
Michelson instructions where one exists.
parent e2d74925
......@@ -4,7 +4,7 @@ cabal-version: 2.2
--
-- see: https://github.com/sol/hpack
--
-- hash: 1c2d4a888a25f87dbbd5d8ca0b6d4e30d2e04958dc41879c560a65f3028e8366
-- hash: 48d16593ed34a1234412a44d6955d9a4a87901512856d448949e4902e2c2038a
name: indigo
version: 0.1.0.0
......@@ -49,6 +49,7 @@ library
Indigo.Internal.Expr
Indigo.Internal.Expr.Compilation
Indigo.Internal.Expr.Decompose
Indigo.Internal.Expr.Symbolic
Indigo.Internal.Expr.Types
Indigo.Internal.Field
Indigo.Internal.Lookup
......
......@@ -125,9 +125,9 @@ docStorage = IndigoState \md -> GenCode () md (L.docStorage @storage) L.nop
-- | Give a name to given contract. Apply it to the whole contract code.
contractName :: Text -> IndigoState i o () -> IndigoState i o ()
contractName name b = IndigoState $ \md ->
contractName cName b = IndigoState $ \md ->
let GenCode _ mdb gc clr = runIndigoState b md in
GenCode () mdb (L.contractName name gc) clr
GenCode () mdb (L.contractName cName gc) clr
-- | Attach general info to given contract.
contractGeneral :: IndigoState i o () -> IndigoState i o ()
......
......@@ -23,7 +23,9 @@ module Indigo.Backend.Error
import Indigo.Backend.Conditional
import Indigo.Backend.Prelude
import Indigo.Internal
import Indigo.Internal.Expr.Compilation
import Indigo.Internal.Expr.Types
import Indigo.Internal.State
import Indigo.Lorentz
import qualified Lorentz.Errors as L
import qualified Lorentz.Instr as L
......
......@@ -75,17 +75,17 @@ simpleCompileIndigoM indigoM =
compileSt (LiftIndigoState cd) = pure cd
compileSt (NewVar ex) = pure $ toSIS (B.newVar ex)
compileSt (SetVar v ex) = pure $ toSIS (B.setVar v ex)
compileSt (SetField v name ex) = pure $ toSIS (B.setField v name ex)
compileSt (SetField v fName ex) = pure $ toSIS (B.setField v fName ex)
compileSt (VarModification act var ex) = pure $ toSIS (B.updateVar act var ex)
compileSt (LambdaPure1Call name (body :: (Var arg -> IndigoM res)) argm) =
execGenericLambda @'[] @res (B.executeLambdaPure1 @res) name body argm
compileSt (LambdaPure1Call lName (body :: (Var arg -> IndigoM res)) argm) =
execGenericLambda @'[] @res (B.executeLambdaPure1 @res) lName body argm
compileSt (Lambda1Call (_ :: Proxy st) name (body :: (Var arg -> IndigoM res)) argm) =
execGenericLambda @'[st] @res (B.executeLambda1 @st @res) name body argm
compileSt (Lambda1Call (_ :: Proxy st) lName (body :: (Var arg -> IndigoM res)) argm) =
execGenericLambda @'[st] @res (B.executeLambda1 @st @res) lName body argm
compileSt (LambdaEff1Call (_ :: Proxy st) name (body :: (Var arg -> IndigoM res)) argm) =
execGenericLambda @'[st, Ops] @res (B.executeLambdaEff1 @st @res) name body argm
compileSt (LambdaEff1Call (_ :: Proxy st) lName (body :: (Var arg -> IndigoM res)) argm) =
execGenericLambda @'[st, Ops] @res (B.executeLambdaEff1 @st @res) lName body argm
compileSt (Scope cd) = do
definedLambdas <- ask
......@@ -132,9 +132,9 @@ simpleCompileIndigoM indigoM =
definedLambdas <- ask
pure $ withSIS1 (compileBody definedLambdas . body) $ \bd -> toSIS (B.forEach e bd)
compileSt (ContractName name contr) = do
compileSt (ContractName cName contr) = do
definedLambdas <- ask
pure $ withSIS (compileBody definedLambdas contr) $ toSIS . B.contractName name
pure $ withSIS (compileBody definedLambdas contr) $ toSIS . B.contractName cName
compileSt (DocGroup gr ii) = do
definedLambdas <- ask
pure $ withSIS (compileBody definedLambdas ii) $ toSIS . B.docGroup gr
......@@ -163,20 +163,20 @@ simpleCompileIndigoM indigoM =
=> Map String CompiledLambda
-> Rec (IndigoMCaseClauseL IndigoM ret) cs
-> Rec (B.IndigoCaseClauseL ret) cs
rmapClauses definedLambdas = rmap (\(OneFieldIndigoMCaseClauseL name clause) ->
name /-> (\v -> B.IndigoAnyOut $ compileBody definedLambdas $ clause v))
rmapClauses definedLambdas = rmap (\(OneFieldIndigoMCaseClauseL cName clause) ->
cName /-> (\v -> B.IndigoAnyOut $ compileBody definedLambdas $ clause v))
forMSIS :: [r] -> (forall someInp . r -> SomeIndigoState someInp v) -> SomeIndigoState someInp1 [v]
forMSIS [] _ = returnSIS []
forMSIS (x : xs) f = f x `bindSIS` (\what -> (what :) <$> forMSIS xs f)
defineLambda :: Lambda1Def -> SomeIndigoState someOut CompiledLambda
defineLambda (LambdaPure1Def (_ :: Proxy (_s, arg, res)) name fun) =
defineGenericLambda @'[] B.initMetaDataPure B.createLambdaPure1 name fun
defineLambda (Lambda1Def (_ :: Proxy (st, arg, res)) name fun) =
defineGenericLambda @'[st] B.initMetaData B.createLambda1 name fun
defineLambda (LambdaEff1Def (_ :: Proxy (st, arg, res)) name fun) =
defineGenericLambda @'[st, Ops] B.initMetaDataEff B.createLambdaEff1 name fun
defineLambda (LambdaPure1Def (_ :: Proxy (_s, arg, res)) lName fun) =
defineGenericLambda @'[] B.initMetaDataPure B.createLambdaPure1 lName fun
defineLambda (Lambda1Def (_ :: Proxy (st, arg, res)) lName fun) =
defineGenericLambda @'[st] B.initMetaData B.createLambda1 lName fun
defineLambda (LambdaEff1Def (_ :: Proxy (st, arg, res)) lName fun) =
defineGenericLambda @'[st, Ops] B.initMetaDataEff B.createLambdaEff1 lName fun
defineGenericLambda
:: forall extra res arg someOut .
......@@ -186,12 +186,12 @@ simpleCompileIndigoM indigoM =
-> String
-> (Var arg -> IndigoM res)
-> SomeIndigoState someOut CompiledLambda
defineGenericLambda (varArg, initMd) lambdaCreator name fun = do
defineGenericLambda (varArg, initMd) lambdaCreator lName fun = do
runSIS
(simpleCompileIndigoM $ fun varArg) initMd
(\gc -> toSIS $ lambdaCreator (\_v -> IndigoState $ \_md -> gc))
`bindSIS`
(returnSIS . CompiledLambda (Proxy @res) name)
(returnSIS . CompiledLambda (Proxy @res) lName)
execGenericLambda
:: forall extra res arg someOut .
......@@ -201,21 +201,21 @@ simpleCompileIndigoM indigoM =
-> (Var arg -> IndigoM res)
-> Expr arg
-> Reader (Map String CompiledLambda) (SomeIndigoState someOut (B.RetVars res))
execGenericLambda executor name (body :: (Var arg -> IndigoM res)) (argm :: Expr arg) = do
execGenericLambda executor lName (body :: (Var arg -> IndigoM res)) (argm :: Expr arg) = do
compiled <- ask
let maybeToRight' = flip maybeToRight
-- This code seems to be pretty unsafe, but it works almost inevitably
pure $ either (error . fromString) id $ do
case M.lookup name compiled of
case M.lookup lName compiled of
Nothing -> Right $
-- Just inline lambda without calling Lorentz lambda
withSIS1 (compileBody compiled . body)
(\bd -> toSIS $ B.newVar argm I.>>= (B.scope @res . bd))
Just compLam -> case compLam of
CompiledLambda (_ :: Proxy res1) _ (varF :: Var (B.Lambda1Generic extra1 arg1 res1)) -> do
Refl <- maybeToRight' (eqT @res @res1) ("unexpected result type of " ++ name ++ " lambda didn't match")
Refl <- maybeToRight' (eqT @arg @arg1) ("unexpected argument type of " ++ name ++ " lambda didn't match")
Refl <- maybeToRight' (eqT @extra @extra1) ("unexpected storage type of " ++ name ++ " lambda didn't match")
Refl <- maybeToRight' (eqT @res @res1) ("unexpected result type of " ++ lName ++ " lambda didn't match")
Refl <- maybeToRight' (eqT @arg @arg1) ("unexpected argument type of " ++ lName ++ " lambda didn't match")
Refl <- maybeToRight' (eqT @extra @extra1) ("unexpected storage type of " ++ lName ++ " lambda didn't match")
pure $ toSIS (executor varF argm)
-- | Compile Indigo code to Lorentz.
......
......@@ -14,7 +14,9 @@ import qualified Data.Map as M
import Indigo.Backend as B
import Indigo.Frontend.Program (IndigoM(..), interpretProgram)
import Indigo.Frontend.Statement
import Indigo.Internal hiding (SetField, fst, return, (>>), (>>=))
import Indigo.Internal.Object
import Indigo.Internal.SIS
import Indigo.Internal.State hiding ((>>))
import Indigo.Lorentz
data CompiledLambda where
......
......@@ -13,7 +13,8 @@ import Data.Typeable ((:~:)(..), eqT)
import Indigo.Backend.Prelude
import Indigo.Frontend.Program (IndigoM)
import Indigo.Internal
import Indigo.Internal.Object
import Indigo.Internal.State
import Indigo.Lorentz
import Util.Peano
......
......@@ -12,8 +12,8 @@ module Indigo.Frontend.Language
, (+=)
, (-=)
, (*=)
, (<<=)
, (>>=.)
, (<<<=)
, (>>>=)
, (&&=)
, (||=)
, (^=)
......@@ -156,7 +156,7 @@ setField
, HasField dt fname ftype
)
=> Var dt -> Label fname -> ex -> IndigoM ()
setField v name e = oneIndigoM $ SetField v name e
setField v fName e = oneIndigoM $ SetField v fName e
(+=)
:: ( IsExpr ex1 n, IsObject m
......@@ -194,17 +194,17 @@ setField v name e = oneIndigoM $ SetField v name e
) => Var m -> ex1 -> IndigoM ()
(^=) = varModification L.xor
(<<=)
(<<<=)
:: ( IsExpr ex1 n, IsObject m
, ArithOpHs M.Lsl n m, ArithResHs M.Lsl n m ~ m
) => Var m -> ex1 -> IndigoM ()
(<<=) = varModification L.lsl
(<<<=) = varModification L.lsl
(>>=.)
(>>>=)
:: ( IsExpr ex1 n, IsObject m
, ArithOpHs M.Lsr n m, ArithResHs M.Lsr n m ~ m
) => Var m -> ex1 -> IndigoM ()
(>>=.) = varModification L.lsr
(>>>=) = varModification L.lsr
----------------------------------------------------------------------------
-- Storage Fields
......@@ -236,9 +236,9 @@ updateStorageField
-> IndigoM ()
updateStorageField field upd = scope $ do
let storage = storageVar @store
fieldVar <- new$ storage %! field
fieldVar <- new$ storage #! field
expr <- upd fieldVar
setField (storageVar @store) field expr
setField storage field expr
-- | Get a field from the storage, returns a variable.
--
......@@ -249,7 +249,7 @@ getStorageField
, HasField store fname ftype
)
=> Label fname -> IndigoM (Var ftype)
getStorageField field = new$ storageVar @store %! field
getStorageField field = new$ storageVar @store #! field
----------------------------------------------------------------------------
-- Conditional
......@@ -447,7 +447,7 @@ entryCaseSimple g = oneIndigoM . EntryCaseSimple g . recFromTuple @clauses
=> Label name
-> (Var x -> IndigoM retBr)
-> IndigoMCaseClauseL IndigoM ret ('CaseClauseParam ctor ('OneField x))
(//->) name b = OneFieldIndigoMCaseClauseL name b
(//->) cName b = OneFieldIndigoMCaseClauseL cName b
infixr 0 //->
----------------------------------------------------------------------------
......@@ -518,8 +518,8 @@ defNamedEffLambda1
=> String
-> (Var (ExprType argExpr) -> IndigoM res)
-> (argExpr -> IndigoM (RetVars res))
defNamedEffLambda1 name body = \ex ->
oneIndigoM $ LambdaEff1Call (Proxy @st) name body (toExpr ex)
defNamedEffLambda1 lName body = \ex ->
oneIndigoM $ LambdaEff1Call (Proxy @st) lName body (toExpr ex)
-- | Like defNamedEffLambda1 but doesn't make side effects.
defNamedLambda1
......@@ -531,8 +531,8 @@ defNamedLambda1
=> String
-> (Var (ExprType argExpr) -> IndigoM res)
-> (argExpr -> IndigoM (RetVars res))
defNamedLambda1 name body = \ex ->
oneIndigoM $ Lambda1Call (Proxy @st) name body (toExpr ex)
defNamedLambda1 lName body = \ex ->
oneIndigoM $ Lambda1Call (Proxy @st) lName body (toExpr ex)
-- | Like defNamedLambda1 but doesn't take an argument.
defNamedLambda0
......@@ -543,7 +543,7 @@ defNamedLambda0
=> String
-> IndigoM res
-> IndigoM (RetVars res)
defNamedLambda0 name body = oneIndigoM $ Lambda1Call (Proxy @st) name (\(_ :: Var ()) -> body) (C ())
defNamedLambda0 lName body = oneIndigoM $ Lambda1Call (Proxy @st) lName (\(_ :: Var ()) -> body) (C ())
-- | Like defNamedEffLambda1 but doesn't modify storage and doesn't make side effects.
defNamedPureLambda1
......@@ -555,8 +555,8 @@ defNamedPureLambda1
=> String
-> (Var (ExprType argExpr) -> IndigoM res)
-> (argExpr -> IndigoM (RetVars res))
defNamedPureLambda1 name body = \ex ->
oneIndigoM $ LambdaPure1Call name body (toExpr ex)
defNamedPureLambda1 lName body = \ex ->
oneIndigoM $ LambdaPure1Call lName body (toExpr ex)
----------------------------------------------------------------------------
-- Loop
......@@ -767,15 +767,15 @@ comment t = liftIndigoState $ toSIS (B.comment t)
-- | Add a comment before and after the given Indigo function code.
-- The first argument is the name of the function.
commentAroundFun :: Text -> IndigoM a -> IndigoM a
commentAroundFun name body =
comment (MT.FunctionStarts name) >>
commentAroundFun fName body =
comment (MT.FunctionStarts fName) >>
body >>=
\res -> res <$ comment (MT.FunctionEnds name)
\res -> res <$ comment (MT.FunctionEnds fName)
-- | Add a comment before and after the given Indigo statement code.
-- The first argument is the name of the statement.
commentAroundStmt :: Text -> IndigoM a -> IndigoM a
commentAroundStmt name body =
comment (MT.StatementStarts name) >>
commentAroundStmt sName body =
comment (MT.StatementStarts sName) >>
body >>=
\res -> res <$ comment (MT.StatementEnds name)
\res -> res <$ comment (MT.StatementEnds sName)
......@@ -11,810 +11,9 @@
module Indigo.Internal.Expr
( module Exported
-- * Basic
, constExpr, varExpr, cast, mem, size
, (&?)
-- * Generic
, update
, ExprMagma (..)
, ExprInsertable (..)
, ExprRemovable (..)
, (^!), (^~), (^-), (^?)
-- * Math
, (+.), (-.), (*.), (/.), (%.), neg, abs
-- ** Comparison
, (==.), (/=.), (<=.), (>=.), (<.), (>.)
-- ** Conversion
, isNat, toInt, nonZero
-- * Bits and boolean
, (<<.), (>>.), (&&.), (||.), (^.), not
-- * Serialization
, pack, unpack
-- * Pairs
, pair, fst, snd
-- * Maybe
, some, none
-- * Either
, right, left
-- * Bytes, String
, slice, concat, (<>.)
-- * List
, (.:), concatAll, nil
-- * Store
, (%@), (%~~), (%~), (%!), uMem, uUpdate, uDelete
-- * Record
, (~.), (!.), (!~), (!!~), construct, constructRec
-- * Map
, emptyMap
-- * BigMap
, emptyBigMap
-- * Set
, emptySet
-- * Contract
, contract
, self
, contractAddress
, contractCallingUnsafe
, runFutureContract
, implicitAccount
, convertEpAddressToContract
, makeView
, makeVoid
-- * Auxiliary
, now
, amount
, sender
, blake2b
, sha256
, sha512
, hashKey
, chainId
, balance
, checkSignature
-- * To make extensions work
, fromLabel
) where
import Indigo.Internal.Expr.Compilation as Exported
import Indigo.Internal.Expr.Decompose as Exported
import Indigo.Internal.Expr.Symbolic as Exported
import Indigo.Internal.Expr.Types as Exported
import Data.Vinyl.Core (RMap(..))
import Indigo.Internal.Field
import Indigo.Internal.Object (Var)
import Indigo.Lorentz
import Indigo.Prelude
import qualified Michelson.Typed.Arith as M
import Util.TypeTuple
----------------------------------------------------------------------------
-- Operators
----------------------------------------------------------------------------
-- Basic generic operations
----------------------------------------------------------------------------
-- | Create an expression holding a constant.
constExpr :: NiceConstant a => a -> Expr a
constExpr = C
-- | Create an expression holding a variable.
varExpr :: KnownValue a => Var a -> Expr a
varExpr = V
cast :: ( ex :~> a
, KnownValue a
)
=> ex -> Expr a
cast = Cast
mem
:: IsMemExpr exKey exN n
=> exKey -> exN
-> Expr Bool
mem = Mem
size
:: IsSizeExpr exN n
=> exN -> Expr Natural
size = Size
-- Generic structure manipulation operators
----------------------------------------------------------------------------
update
:: ( UpdOpHs c
, KnownValue c
, exKey :~> UpdOpKeyHs c
, exValue :~> UpdOpParamsHs c
, exStructure :~> c
)
=> exStructure -> exKey -> exValue
-> Expr c
update = Update
lookup
:: ( KnownValue (GetOpValHs c)
, exKey :~> GetOpKeyHs c
, exStruct :~> c
, GetOpHs c
)
=> exKey -> exStruct
-> Expr (Maybe (GetOpValHs c))
lookup = Get
class ExprMagma c where
empty
:: ( NiceComparable (UpdOpKeyHs c)
, KnownValue c
)
=> Expr c
class UpdOpHs c => ExprRemovable c where
remove
:: ( KnownValue c
, exStruct :~> c
, exKey :~> UpdOpKeyHs c
)
=> exKey -> exStruct
-> Expr c
class UpdOpHs c => ExprInsertable c insParam where
insert :: (KnownValue c, ex :~> c) => insParam -> ex -> Expr c
instance (KnownValue v) => ExprMagma (Map k v) where
empty = EmptyMap
emptyMap
:: (KnownValue value, NiceComparable key, KnownValue (Map key value))
=> Expr (Map key value)
emptyMap = empty
instance
( NiceComparable k
, KnownValue v
, exKey :~> k
, exValue :~> v
)
=>
ExprInsertable (Map k v) (exKey, exValue)
where
insert (k, v) c = update c k (some v)
instance
( NiceComparable k
, KnownValue v
)
=>
ExprRemovable (Map k v)
where
remove k c = update c k none
instance (KnownValue v) => ExprMagma (BigMap k v) where
empty = EmptyBigMap
emptyBigMap
:: (KnownValue value, NiceComparable key, KnownValue (BigMap key value))
=> Expr (BigMap key value)
emptyBigMap = empty
instance
( NiceComparable k
, KnownValue v
, exKey :~> k
, exValue :~> v
)
=>
ExprInsertable (BigMap k v) (exKey, exValue)
where
insert (k, v) c = update c k (some v)
instance
( NiceComparable k
, KnownValue v
)
=>
ExprRemovable (BigMap k v)
where
remove k c = update c k none
instance ExprMagma (Set k) where
empty = EmptySet
emptySet
:: (NiceComparable key, KnownValue (Set key))
=> Expr (Set key)
emptySet = empty
instance
(NiceComparable a, exKey :~> a)
=>
ExprInsertable (Set a) exKey
where
insert k c = update c k True
instance
(NiceComparable a)
=>
ExprRemovable (Set a)
where
remove k c = update c k False
infixl 8 ^?
(^?) :: ( GetOpHs c
, KnownValue (GetOpValHs c)
, exKey :~> GetOpKeyHs c
, exMap :~> c
)
=> exMap -> exKey
-> Expr (Maybe (GetOpValHs c))
m ^? k = lookup k m
infixl 8 &?