-- SPDX-FileCopyrightText: 2021 Oxhead Alpha
-- SPDX-License-Identifier: LicenseRef-MIT-OA

-- | Module, containing type classes for operating with Michelson values
-- in the context of polymorphic stack type operations.

module Morley.Michelson.Typed.Polymorphic
  ( EDivOp (..)
  , MemOp (..)
  , MapOp (..)
  , IterOp (..)
  , SizeOp (..)
  , GetOp (..)
  , UpdOp (..)
  , SliceOp (..)
  , ConcatOp (..)
  , divMich
  , modMich
  ) where

import Data.ByteString qualified as B
import Data.Map qualified as M
import Data.Set qualified as S
import Data.Singletons (SingI)
import Unsafe qualified (fromIntegral)

import Morley.Michelson.Text
import Morley.Michelson.Typed.Annotation
import Morley.Michelson.Typed.T (T(..))
import Morley.Michelson.Typed.Value (Value'(..))
import Morley.Michelson.Untyped.Annotation (noAnn)

import Morley.Tezos.Core (divModMutez, divModMutezInt)

class MemOp (c :: T) where
  type MemOpKey c :: T
  evalMem :: Value' instr (MemOpKey c) -> Value' instr c -> Bool
instance MemOp ('TSet e) where
  type MemOpKey ('TSet e) = e
  evalMem :: forall (instr :: [T] -> [T] -> *).
Value' instr (MemOpKey ('TSet e)) -> Value' instr ('TSet e) -> Bool
evalMem Value' instr (MemOpKey ('TSet e))
e (VSet Set (Value' instr t1)
s) = Value' instr t1
Value' instr (MemOpKey ('TSet e))
e Value' instr t1 -> Set (Value' instr t1) -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set (Value' instr t1)
s
instance MemOp ('TMap k v) where
  type MemOpKey ('TMap k v) = k
  evalMem :: forall (instr :: [T] -> [T] -> *).
Value' instr (MemOpKey ('TMap k v))
-> Value' instr ('TMap k v) -> Bool
evalMem Value' instr (MemOpKey ('TMap k v))
k (VMap Map (Value' instr k) (Value' instr v)
m) = Value' instr k
Value' instr (MemOpKey ('TMap k v))
k Value' instr k -> Map (Value' instr k) (Value' instr v) -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`M.member` Map (Value' instr k) (Value' instr v)
m
instance MemOp ('TBigMap k v) where
  type MemOpKey ('TBigMap k v) = k
  evalMem :: forall (instr :: [T] -> [T] -> *).
Value' instr (MemOpKey ('TBigMap k v))
-> Value' instr ('TBigMap k v) -> Bool
evalMem Value' instr (MemOpKey ('TBigMap k v))
k (VBigMap Maybe Natural
_ Map (Value' instr k) (Value' instr v)
m) = Value' instr k
Value' instr (MemOpKey ('TBigMap k v))
k Value' instr k -> Map (Value' instr k) (Value' instr v) -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`M.member` Map (Value' instr k) (Value' instr v)
m

class MapOp (c :: T) where
  type MapOpInp c :: T
  type MapOpRes c :: T -> T
  mapOpToList :: Value' instr c -> [Value' instr (MapOpInp c)]
  mapOpFromList
    :: (SingI b)
    => Value' instr c -> [Value' instr b] -> Value' instr (MapOpRes c b)
  mapOpNotes :: Notes c -> Notes (MapOpInp c)
instance MapOp ('TMap k v) where
  type MapOpInp ('TMap k v) = 'TPair k v
  type MapOpRes ('TMap k v) = 'TMap k
  mapOpToList :: forall (instr :: [T] -> [T] -> *).
Value' instr ('TMap k v) -> [Value' instr (MapOpInp ('TMap k v))]
mapOpToList (VMap Map (Value' instr k) (Value' instr v)
m) = ((Value' instr k, Value' instr v) -> Value' instr ('TPair k v))
-> [(Value' instr k, Value' instr v)]
-> [Value' instr ('TPair k v)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\(Value' instr k
k, Value' instr v
v) -> (Value' instr k, Value' instr v) -> Value' instr ('TPair k v)
forall (l :: T) (r :: T) (instr :: [T] -> [T] -> *).
(Value' instr l, Value' instr r) -> Value' instr ('TPair l r)
VPair (Value' instr k
k, Value' instr v
v)) ([(Value' instr k, Value' instr v)] -> [Value' instr ('TPair k v)])
-> [(Value' instr k, Value' instr v)]
-> [Value' instr ('TPair k v)]
forall a b. (a -> b) -> a -> b
$ Map (Value' instr k) (Value' instr v)
-> [(Value' instr k, Value' instr v)]
forall k a. Map k a -> [(k, a)]
M.toAscList Map (Value' instr k) (Value' instr v)
m
  mapOpFromList :: forall (b :: T) (instr :: [T] -> [T] -> *).
SingI b =>
Value' instr ('TMap k v)
-> [Value' instr b] -> Value' instr (MapOpRes ('TMap k v) b)
mapOpFromList (VMap Map (Value' instr k) (Value' instr v)
m) [Value' instr b]
l =
    Map (Value' instr k) (Value' instr b) -> Value' instr ('TMap k b)
forall (k :: T) (v :: T) (instr :: [T] -> [T] -> *).
(SingI k, SingI v, Comparable k) =>
Map (Value' instr k) (Value' instr v) -> Value' instr ('TMap k v)
VMap (Map (Value' instr k) (Value' instr b) -> Value' instr ('TMap k b))
-> Map (Value' instr k) (Value' instr b)
-> Value' instr ('TMap k b)
forall a b. (a -> b) -> a -> b
$ [(Value' instr k, Value' instr b)]
-> Map (Value' instr k) (Value' instr b)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Value' instr k, Value' instr b)]
 -> Map (Value' instr k) (Value' instr b))
-> [(Value' instr k, Value' instr b)]
-> Map (Value' instr k) (Value' instr b)
forall a b. (a -> b) -> a -> b
$ [Value' instr k]
-> [Value' instr b] -> [(Value' instr k, Value' instr b)]
forall a b. [a] -> [b] -> [(a, b)]
zip (((Value' instr k, Value' instr v) -> Value' instr k)
-> [(Value' instr k, Value' instr v)] -> [Value' instr k]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (Value' instr k, Value' instr v) -> Value' instr k
forall a b. (a, b) -> a
fst ([(Value' instr k, Value' instr v)] -> [Value' instr k])
-> [(Value' instr k, Value' instr v)] -> [Value' instr k]
forall a b. (a -> b) -> a -> b
$ Map (Value' instr k) (Value' instr v)
-> [(Value' instr k, Value' instr v)]
forall k a. Map k a -> [(k, a)]
M.toAscList Map (Value' instr k) (Value' instr v)
m) [Value' instr b]
l
  mapOpNotes :: Notes ('TMap k v) -> Notes (MapOpInp ('TMap k v))
mapOpNotes (NTMap TypeAnn
_ Notes k
nk Notes v
nv) = TypeAnn
-> FieldAnn
-> FieldAnn
-> VarAnn
-> VarAnn
-> Notes k
-> Notes v
-> Notes ('TPair k v)
forall (p :: T) (q :: T).
TypeAnn
-> FieldAnn
-> FieldAnn
-> VarAnn
-> VarAnn
-> Notes p
-> Notes q
-> Notes ('TPair p q)
NTPair TypeAnn
forall {k} (a :: k). Annotation a
noAnn FieldAnn
forall {k} (a :: k). Annotation a
noAnn FieldAnn
forall {k} (a :: k). Annotation a
noAnn VarAnn
forall {k} (a :: k). Annotation a
noAnn VarAnn
forall {k} (a :: k). Annotation a
noAnn Notes k
nk Notes v
nv
instance MapOp ('TList e) where
  type MapOpInp ('TList e) = e
  type MapOpRes ('TList e) = 'TList
  mapOpToList :: forall (instr :: [T] -> [T] -> *).
Value' instr ('TList e) -> [Value' instr (MapOpInp ('TList e))]
mapOpToList (VList [Value' instr t1]
l) = [Value' instr t1]
[Value' instr (MapOpInp ('TList e))]
l
  mapOpFromList :: forall (b :: T) (instr :: [T] -> [T] -> *).
SingI b =>
Value' instr ('TList e)
-> [Value' instr b] -> Value' instr (MapOpRes ('TList e) b)
mapOpFromList (VList [Value' instr t1]
_) [Value' instr b]
l' = [Value' instr b] -> Value' instr ('TList b)
forall (t1 :: T) (instr :: [T] -> [T] -> *).
SingI t1 =>
[Value' instr t1] -> Value' instr ('TList t1)
VList [Value' instr b]
l'
  mapOpNotes :: Notes ('TList e) -> Notes (MapOpInp ('TList e))
mapOpNotes (NTList TypeAnn
_ Notes t1
n) = Notes t1
Notes (MapOpInp ('TList e))
n
instance MapOp ('TOption e) where
  type MapOpInp ('TOption e) = e
  type MapOpRes ('TOption e) = 'TOption
  mapOpToList :: forall (instr :: [T] -> [T] -> *).
Value' instr ('TOption e) -> [Value' instr (MapOpInp ('TOption e))]
mapOpToList (VOption Maybe (Value' instr t1)
l) = [Value' instr t1]
-> (Value' instr t1 -> [Value' instr t1])
-> Maybe (Value' instr t1)
-> [Value' instr t1]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Value' instr t1 -> [Value' instr t1]
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Value' instr t1)
l
  mapOpFromList :: forall (b :: T) (instr :: [T] -> [T] -> *).
SingI b =>
Value' instr ('TOption e)
-> [Value' instr b] -> Value' instr (MapOpRes ('TOption e) b)
mapOpFromList (VOption Maybe (Value' instr t1)
_) [Value' instr b]
l' = Maybe (Value' instr b) -> Value' instr ('TOption b)
forall (t1 :: T) (instr :: [T] -> [T] -> *).
SingI t1 =>
Maybe (Value' instr t1) -> Value' instr ('TOption t1)
VOption (Maybe (Value' instr b) -> Value' instr ('TOption b))
-> Maybe (Value' instr b) -> Value' instr ('TOption b)
forall a b. (a -> b) -> a -> b
$ [Value' instr b] -> Maybe (Value' instr b)
forall a. [a] -> Maybe a
listToMaybe [Value' instr b]
l'
  mapOpNotes :: Notes ('TOption e) -> Notes (MapOpInp ('TOption e))
mapOpNotes (NTOption TypeAnn
_ Notes t1
n) = Notes t1
Notes (MapOpInp ('TOption e))
n
-- If you find it difficult to implement 'MapOp' for your datatype
-- because of order of type arguments in it, consider wrapping it
-- into a newtype.

class IterOp (c :: T) where
  type IterOpEl c :: T
  iterOpDetachOne ::
    Value' instr c -> (Maybe (Value' instr (IterOpEl c)), Value' instr c)
  iterOpNotes :: Notes c -> Notes (IterOpEl c)
instance IterOp ('TMap k v) where
  type IterOpEl ('TMap k v) = 'TPair k v
  iterOpDetachOne :: forall (instr :: [T] -> [T] -> *).
Value' instr ('TMap k v)
-> (Maybe (Value' instr (IterOpEl ('TMap k v))),
    Value' instr ('TMap k v))
iterOpDetachOne (VMap Map (Value' instr k) (Value' instr v)
m) =
    ((Value' instr k, Value' instr v) -> Value' instr ('TPair k v)
forall (l :: T) (r :: T) (instr :: [T] -> [T] -> *).
(Value' instr l, Value' instr r) -> Value' instr ('TPair l r)
VPair ((Value' instr k, Value' instr v) -> Value' instr ('TPair k v))
-> Maybe (Value' instr k, Value' instr v)
-> Maybe (Value' instr ('TPair k v))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map (Value' instr k) (Value' instr v)
-> Maybe (Value' instr k, Value' instr v)
forall k a. Map k a -> Maybe (k, a)
M.lookupMin Map (Value' instr k) (Value' instr v)
m, Map (Value' instr k) (Value' instr v) -> Value' instr ('TMap k v)
forall (k :: T) (v :: T) (instr :: [T] -> [T] -> *).
(SingI k, SingI v, Comparable k) =>
Map (Value' instr k) (Value' instr v) -> Value' instr ('TMap k v)
VMap (Map (Value' instr k) (Value' instr v) -> Value' instr ('TMap k v))
-> Map (Value' instr k) (Value' instr v)
-> Value' instr ('TMap k v)
forall a b. (a -> b) -> a -> b
$ Map (Value' instr k) (Value' instr v)
-> Map (Value' instr k) (Value' instr v)
forall k a. Map k a -> Map k a
M.deleteMin Map (Value' instr k) (Value' instr v)
m)
  iterOpNotes :: Notes ('TMap k v) -> Notes (IterOpEl ('TMap k v))
iterOpNotes (NTMap TypeAnn
_ Notes k
nk Notes v
nv) = TypeAnn
-> FieldAnn
-> FieldAnn
-> VarAnn
-> VarAnn
-> Notes k
-> Notes v
-> Notes ('TPair k v)
forall (p :: T) (q :: T).
TypeAnn
-> FieldAnn
-> FieldAnn
-> VarAnn
-> VarAnn
-> Notes p
-> Notes q
-> Notes ('TPair p q)
NTPair TypeAnn
forall {k} (a :: k). Annotation a
noAnn FieldAnn
forall {k} (a :: k). Annotation a
noAnn FieldAnn
forall {k} (a :: k). Annotation a
noAnn VarAnn
forall {k} (a :: k). Annotation a
noAnn VarAnn
forall {k} (a :: k). Annotation a
noAnn Notes k
nk Notes v
nv
instance IterOp ('TList e) where
  type IterOpEl ('TList e) = e
  iterOpDetachOne :: forall (instr :: [T] -> [T] -> *).
Value' instr ('TList e)
-> (Maybe (Value' instr (IterOpEl ('TList e))),
    Value' instr ('TList e))
iterOpDetachOne (VList [Value' instr t1]
l) =
    case [Value' instr t1]
l of
      Value' instr t1
x : [Value' instr t1]
xs -> (Value' instr t1 -> Maybe (Value' instr t1)
forall a. a -> Maybe a
Just Value' instr t1
x, [Value' instr t1] -> Value' instr ('TList t1)
forall (t1 :: T) (instr :: [T] -> [T] -> *).
SingI t1 =>
[Value' instr t1] -> Value' instr ('TList t1)
VList [Value' instr t1]
xs)
      [] -> (Maybe (Value' instr (IterOpEl ('TList e)))
forall a. Maybe a
Nothing, [Value' instr e] -> Value' instr ('TList e)
forall (t1 :: T) (instr :: [T] -> [T] -> *).
SingI t1 =>
[Value' instr t1] -> Value' instr ('TList t1)
VList [])
  iterOpNotes :: Notes ('TList e) -> Notes (IterOpEl ('TList e))
iterOpNotes (NTList TypeAnn
_ Notes t1
n) = Notes t1
Notes (IterOpEl ('TList e))
n
instance IterOp ('TSet e) where
  type IterOpEl ('TSet e) = e
  iterOpDetachOne :: forall (instr :: [T] -> [T] -> *).
Value' instr ('TSet e)
-> (Maybe (Value' instr (IterOpEl ('TSet e))),
    Value' instr ('TSet e))
iterOpDetachOne (VSet Set (Value' instr t1)
s) = (Set (Value' instr t1) -> Maybe (Value' instr t1)
forall a. Set a -> Maybe a
S.lookupMin Set (Value' instr t1)
s, Set (Value' instr t1) -> Value' instr ('TSet t1)
forall (t1 :: T) (instr :: [T] -> [T] -> *).
(SingI t1, Comparable t1) =>
Set (Value' instr t1) -> Value' instr ('TSet t1)
VSet (Set (Value' instr t1) -> Value' instr ('TSet t1))
-> Set (Value' instr t1) -> Value' instr ('TSet t1)
forall a b. (a -> b) -> a -> b
$ Set (Value' instr t1) -> Set (Value' instr t1)
forall a. Set a -> Set a
S.deleteMin Set (Value' instr t1)
s)
  iterOpNotes :: Notes ('TSet e) -> Notes (IterOpEl ('TSet e))
iterOpNotes (NTSet TypeAnn
_ Notes t1
n) = Notes t1
Notes (IterOpEl ('TSet e))
n

class SizeOp (c :: T) where
  evalSize :: Value' instr c -> Int
instance SizeOp 'TString where
  evalSize :: forall (instr :: [T] -> [T] -> *). Value' instr 'TString -> Int
evalSize (VString MText
s) = MText -> Int
forall t. Container t => t -> Int
length MText
s
instance SizeOp ('TBytes) where
  evalSize :: forall (instr :: [T] -> [T] -> *). Value' instr 'TBytes -> Int
evalSize (VBytes ByteString
b) = ByteString -> Int
forall t. Container t => t -> Int
length ByteString
b
instance SizeOp ('TSet a) where
  evalSize :: forall (instr :: [T] -> [T] -> *). Value' instr ('TSet a) -> Int
evalSize (VSet Set (Value' instr t1)
s) = Set (Value' instr t1) -> Int
forall a. Set a -> Int
S.size Set (Value' instr t1)
s
instance SizeOp ('TList a) where
  evalSize :: forall (instr :: [T] -> [T] -> *). Value' instr ('TList a) -> Int
evalSize (VList [Value' instr t1]
l) = [Value' instr t1] -> Int
forall t. Container t => t -> Int
length [Value' instr t1]
l
instance SizeOp ('TMap k v) where
  evalSize :: forall (instr :: [T] -> [T] -> *). Value' instr ('TMap k v) -> Int
evalSize (VMap Map (Value' instr k) (Value' instr v)
m) = Map (Value' instr k) (Value' instr v) -> Int
forall k a. Map k a -> Int
M.size Map (Value' instr k) (Value' instr v)
m

class UpdOp (c :: T) where
  type UpdOpKey c :: T
  type UpdOpParams c :: T
  evalUpd
    :: Value' instr (UpdOpKey c)
    -> Value' instr (UpdOpParams c) -> Value' instr c -> Value' instr c
instance UpdOp ('TMap k v) where
  type UpdOpKey ('TMap k v) = k
  type UpdOpParams ('TMap k v) = 'TOption v
  evalUpd :: forall (instr :: [T] -> [T] -> *).
Value' instr (UpdOpKey ('TMap k v))
-> Value' instr (UpdOpParams ('TMap k v))
-> Value' instr ('TMap k v)
-> Value' instr ('TMap k v)
evalUpd Value' instr (UpdOpKey ('TMap k v))
k (VOption Maybe (Value' instr t1)
o) (VMap Map (Value' instr k) (Value' instr v)
m) =
    case Maybe (Value' instr t1)
o of
      Just Value' instr t1
newV -> Map (Value' instr k) (Value' instr t1) -> Value' instr ('TMap k t1)
forall (k :: T) (v :: T) (instr :: [T] -> [T] -> *).
(SingI k, SingI v, Comparable k) =>
Map (Value' instr k) (Value' instr v) -> Value' instr ('TMap k v)
VMap (Map (Value' instr k) (Value' instr t1)
 -> Value' instr ('TMap k t1))
-> Map (Value' instr k) (Value' instr t1)
-> Value' instr ('TMap k t1)
forall a b. (a -> b) -> a -> b
$ Value' instr k
-> Value' instr t1
-> Map (Value' instr k) (Value' instr t1)
-> Map (Value' instr k) (Value' instr t1)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Value' instr k
Value' instr (UpdOpKey ('TMap k v))
k Value' instr t1
newV Map (Value' instr k) (Value' instr t1)
Map (Value' instr k) (Value' instr v)
m
      Maybe (Value' instr t1)
Nothing -> Map (Value' instr k) (Value' instr v) -> Value' instr ('TMap k v)
forall (k :: T) (v :: T) (instr :: [T] -> [T] -> *).
(SingI k, SingI v, Comparable k) =>
Map (Value' instr k) (Value' instr v) -> Value' instr ('TMap k v)
VMap (Map (Value' instr k) (Value' instr v) -> Value' instr ('TMap k v))
-> Map (Value' instr k) (Value' instr v)
-> Value' instr ('TMap k v)
forall a b. (a -> b) -> a -> b
$ Value' instr k
-> Map (Value' instr k) (Value' instr v)
-> Map (Value' instr k) (Value' instr v)
forall k a. Ord k => k -> Map k a -> Map k a
M.delete Value' instr k
Value' instr (UpdOpKey ('TMap k v))
k Map (Value' instr k) (Value' instr v)
m
instance UpdOp ('TBigMap k v) where
  type UpdOpKey ('TBigMap k v) = k
  type UpdOpParams ('TBigMap k v) = 'TOption v
  evalUpd :: forall (instr :: [T] -> [T] -> *).
Value' instr (UpdOpKey ('TBigMap k v))
-> Value' instr (UpdOpParams ('TBigMap k v))
-> Value' instr ('TBigMap k v)
-> Value' instr ('TBigMap k v)
evalUpd Value' instr (UpdOpKey ('TBigMap k v))
k (VOption Maybe (Value' instr t1)
o) (VBigMap Maybe Natural
bmId Map (Value' instr k) (Value' instr v)
m) =
    case Maybe (Value' instr t1)
o of
      Just Value' instr t1
newV -> Maybe Natural
-> Map (Value' instr k) (Value' instr t1)
-> Value' instr ('TBigMap k t1)
forall (k :: T) (v :: T) (instr :: [T] -> [T] -> *).
(SingI k, SingI v, Comparable k, HasNoBigMap v) =>
Maybe Natural
-> Map (Value' instr k) (Value' instr v)
-> Value' instr ('TBigMap k v)
VBigMap Maybe Natural
bmId (Map (Value' instr k) (Value' instr t1)
 -> Value' instr ('TBigMap k t1))
-> Map (Value' instr k) (Value' instr t1)
-> Value' instr ('TBigMap k t1)
forall a b. (a -> b) -> a -> b
$ Value' instr k
-> Value' instr t1
-> Map (Value' instr k) (Value' instr t1)
-> Map (Value' instr k) (Value' instr t1)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Value' instr k
Value' instr (UpdOpKey ('TBigMap k v))
k Value' instr t1
newV Map (Value' instr k) (Value' instr t1)
Map (Value' instr k) (Value' instr v)
m
      Maybe (Value' instr t1)
Nothing -> Maybe Natural
-> Map (Value' instr k) (Value' instr v)
-> Value' instr ('TBigMap k v)
forall (k :: T) (v :: T) (instr :: [T] -> [T] -> *).
(SingI k, SingI v, Comparable k, HasNoBigMap v) =>
Maybe Natural
-> Map (Value' instr k) (Value' instr v)
-> Value' instr ('TBigMap k v)
VBigMap Maybe Natural
bmId (Map (Value' instr k) (Value' instr v)
 -> Value' instr ('TBigMap k v))
-> Map (Value' instr k) (Value' instr v)
-> Value' instr ('TBigMap k v)
forall a b. (a -> b) -> a -> b
$ Value' instr k
-> Map (Value' instr k) (Value' instr v)
-> Map (Value' instr k) (Value' instr v)
forall k a. Ord k => k -> Map k a -> Map k a
M.delete Value' instr k
Value' instr (UpdOpKey ('TBigMap k v))
k Map (Value' instr k) (Value' instr v)
m
instance UpdOp ('TSet a) where
  type UpdOpKey ('TSet a) = a
  type UpdOpParams ('TSet a) = 'TBool
  evalUpd :: forall (instr :: [T] -> [T] -> *).
Value' instr (UpdOpKey ('TSet a))
-> Value' instr (UpdOpParams ('TSet a))
-> Value' instr ('TSet a)
-> Value' instr ('TSet a)
evalUpd Value' instr (UpdOpKey ('TSet a))
k (VBool Bool
b) (VSet Set (Value' instr t1)
s) =
    case Bool
b of
      Bool
True -> Set (Value' instr t1) -> Value' instr ('TSet t1)
forall (t1 :: T) (instr :: [T] -> [T] -> *).
(SingI t1, Comparable t1) =>
Set (Value' instr t1) -> Value' instr ('TSet t1)
VSet (Set (Value' instr t1) -> Value' instr ('TSet t1))
-> Set (Value' instr t1) -> Value' instr ('TSet t1)
forall a b. (a -> b) -> a -> b
$ Value' instr t1 -> Set (Value' instr t1) -> Set (Value' instr t1)
forall a. Ord a => a -> Set a -> Set a
S.insert Value' instr t1
Value' instr (UpdOpKey ('TSet a))
k Set (Value' instr t1)
s
      Bool
False -> Set (Value' instr t1) -> Value' instr ('TSet t1)
forall (t1 :: T) (instr :: [T] -> [T] -> *).
(SingI t1, Comparable t1) =>
Set (Value' instr t1) -> Value' instr ('TSet t1)
VSet (Set (Value' instr t1) -> Value' instr ('TSet t1))
-> Set (Value' instr t1) -> Value' instr ('TSet t1)
forall a b. (a -> b) -> a -> b
$ Value' instr t1 -> Set (Value' instr t1) -> Set (Value' instr t1)
forall a. Ord a => a -> Set a -> Set a
S.delete Value' instr t1
Value' instr (UpdOpKey ('TSet a))
k Set (Value' instr t1)
s

class GetOp (c :: T) where
  type GetOpKey c :: T
  type GetOpVal c :: T
  evalGet :: Value' instr (GetOpKey c) -> Value' instr c -> Maybe (Value' instr (GetOpVal c))
instance GetOp ('TBigMap k v) where
  type GetOpKey ('TBigMap k v) = k
  type GetOpVal ('TBigMap k v) = v
  evalGet :: forall (instr :: [T] -> [T] -> *).
Value' instr (GetOpKey ('TBigMap k v))
-> Value' instr ('TBigMap k v)
-> Maybe (Value' instr (GetOpVal ('TBigMap k v)))
evalGet Value' instr (GetOpKey ('TBigMap k v))
k (VBigMap Maybe Natural
_ Map (Value' instr k) (Value' instr v)
m) = Value' instr k
Value' instr (GetOpKey ('TBigMap k v))
k Value' instr k
-> Map (Value' instr k) (Value' instr v) -> Maybe (Value' instr v)
forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Map (Value' instr k) (Value' instr v)
m
instance GetOp ('TMap k v) where
  type GetOpKey ('TMap k v) = k
  type GetOpVal ('TMap k v) = v
  evalGet :: forall (instr :: [T] -> [T] -> *).
Value' instr (GetOpKey ('TMap k v))
-> Value' instr ('TMap k v)
-> Maybe (Value' instr (GetOpVal ('TMap k v)))
evalGet Value' instr (GetOpKey ('TMap k v))
k (VMap Map (Value' instr k) (Value' instr v)
m) = Value' instr k
Value' instr (GetOpKey ('TMap k v))
k Value' instr k
-> Map (Value' instr k) (Value' instr v) -> Maybe (Value' instr v)
forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Map (Value' instr k) (Value' instr v)
m

class ConcatOp (c :: T) where
  evalConcat :: Value' instr c -> Value' instr c -> Value' instr c
  evalConcat' :: [Value' instr c] -> Value' instr c
instance ConcatOp ('TString) where
  evalConcat :: forall (instr :: [T] -> [T] -> *).
Value' instr 'TString
-> Value' instr 'TString -> Value' instr 'TString
evalConcat (VString MText
s1) (VString MText
s2) = (MText -> Value' instr 'TString
forall (instr :: [T] -> [T] -> *). MText -> Value' instr 'TString
VString) (MText
s1 MText -> MText -> MText
forall a. Semigroup a => a -> a -> a
<> MText
s2)
  evalConcat' :: forall (instr :: [T] -> [T] -> *).
[Value' instr 'TString] -> Value' instr 'TString
evalConcat' [Value' instr 'TString]
l =
    (MText -> Value' instr 'TString
forall (instr :: [T] -> [T] -> *). MText -> Value' instr 'TString
VString) (MText -> Value' instr 'TString) -> MText -> Value' instr 'TString
forall a b. (a -> b) -> a -> b
$ [MText] -> MText
forall a. Monoid a => [a] -> a
mconcat ([MText] -> MText) -> [MText] -> MText
forall a b. (a -> b) -> a -> b
$ (Value' instr 'TString -> MText)
-> [Value' instr 'TString] -> [MText]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\(VString MText
s) -> MText
s) [Value' instr 'TString]
l
instance ConcatOp ('TBytes) where
  evalConcat :: forall (instr :: [T] -> [T] -> *).
Value' instr 'TBytes
-> Value' instr 'TBytes -> Value' instr 'TBytes
evalConcat (VBytes ByteString
b1) (VBytes ByteString
b2) = ByteString -> Value' instr 'TBytes
forall (instr :: [T] -> [T] -> *).
ByteString -> Value' instr 'TBytes
VBytes (ByteString
b1 ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
b2)
  evalConcat' :: forall (instr :: [T] -> [T] -> *).
[Value' instr 'TBytes] -> Value' instr 'TBytes
evalConcat' [Value' instr 'TBytes]
l =
    (ByteString -> Value' instr 'TBytes
forall (instr :: [T] -> [T] -> *).
ByteString -> Value' instr 'TBytes
VBytes) (ByteString -> Value' instr 'TBytes)
-> ByteString -> Value' instr 'TBytes
forall a b. (a -> b) -> a -> b
$ (Element [Value' instr 'TBytes] -> ByteString -> ByteString)
-> ByteString -> [Value' instr 'TBytes] -> ByteString
forall t b. Container t => (Element t -> b -> b) -> b -> t -> b
foldr (ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
(<>) (ByteString -> ByteString -> ByteString)
-> (Value' instr 'TBytes -> ByteString)
-> Value' instr 'TBytes
-> ByteString
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\(VBytes ByteString
b) -> ByteString
b)) ByteString
forall a. Monoid a => a
mempty [Value' instr 'TBytes]
l

class SliceOp (c :: T) where
  evalSlice :: Natural -> Natural -> Value' instr c -> Maybe (Value' instr c)
instance SliceOp 'TString where
  evalSlice :: forall (instr :: [T] -> [T] -> *).
Natural
-> Natural
-> Value' instr 'TString
-> Maybe (Value' instr 'TString)
evalSlice Natural
o Natural
l (VString MText
s) =
    MText -> Value' instr 'TString
forall (instr :: [T] -> [T] -> *). MText -> Value' instr 'TString
VString (MText -> Value' instr 'TString)
-> Maybe MText -> Maybe (Value' instr 'TString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> MText -> MText)
-> (Int -> MText -> MText)
-> Natural
-> Natural
-> MText
-> Maybe MText
forall str.
Container str =>
(Int -> str -> str)
-> (Int -> str -> str) -> Natural -> Natural -> str -> Maybe str
sliceImpl Int -> MText -> MText
dropMText Int -> MText -> MText
takeMText Natural
o Natural
l MText
s
instance SliceOp 'TBytes where
  evalSlice :: forall (instr :: [T] -> [T] -> *).
Natural
-> Natural -> Value' instr 'TBytes -> Maybe (Value' instr 'TBytes)
evalSlice Natural
o Natural
l (VBytes ByteString
b) =
    ByteString -> Value' instr 'TBytes
forall (instr :: [T] -> [T] -> *).
ByteString -> Value' instr 'TBytes
VBytes (ByteString -> Value' instr 'TBytes)
-> Maybe ByteString -> Maybe (Value' instr 'TBytes)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> ByteString -> ByteString)
-> (Int -> ByteString -> ByteString)
-> Natural
-> Natural
-> ByteString
-> Maybe ByteString
forall str.
Container str =>
(Int -> str -> str)
-> (Int -> str -> str) -> Natural -> Natural -> str -> Maybe str
sliceImpl Int -> ByteString -> ByteString
B.drop Int -> ByteString -> ByteString
B.take Natural
o Natural
l ByteString
b

sliceImpl ::
  Container str
  => (Int -> str -> str)
  -> (Int -> str -> str)
  -> Natural
  -> Natural
  -> str
  -> Maybe str
sliceImpl :: forall str.
Container str =>
(Int -> str -> str)
-> (Int -> str -> str) -> Natural -> Natural -> str -> Maybe str
sliceImpl Int -> str -> str
dropF Int -> str -> str
takeF Natural
offset Natural
l str
s
  | Natural
offset Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
>= forall a b. (HasCallStack, Integral a, Integral b) => a -> b
Unsafe.fromIntegral @Int @Natural (str -> Int
forall t. Container t => t -> Int
length str
s) Bool -> Bool -> Bool
forall a. Boolean a => a -> a -> a
|| Natural
offset Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+ Natural
l Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
> forall a b. (HasCallStack, Integral a, Integral b) => a -> b
Unsafe.fromIntegral @Int @Natural (str -> Int
forall t. Container t => t -> Int
length str
s) =
    Maybe str
forall a. Maybe a
Nothing
  | Bool
otherwise
  -- Drop offset and then take requested number of items.
   = str -> Maybe str
forall a. a -> Maybe a
Just (str -> Maybe str) -> (str -> str) -> str -> Maybe str
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> str -> str
takeF (forall a b. (HasCallStack, Integral a, Integral b) => a -> b
Unsafe.fromIntegral @Natural @Int Natural
l) (str -> str) -> (str -> str) -> str -> str
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> str -> str
dropF (forall a b. (HasCallStack, Integral a, Integral b) => a -> b
Unsafe.fromIntegral @Natural @Int Natural
offset) (str -> Maybe str) -> str -> Maybe str
forall a b. (a -> b) -> a -> b
$ str
s

class EDivOp (n :: T) (m :: T) where
  type EDivOpRes n m :: T
  type EModOpRes n m :: T

  evalEDivOp
    :: Value' instr n
    -> Value' instr m
    -> Value' instr ('TOption ('TPair (EDivOpRes n m)
                                     (EModOpRes n m)))

instance EDivOp 'TInt 'TInt where
  type EDivOpRes 'TInt 'TInt = 'TInt
  type EModOpRes 'TInt 'TInt = 'TNat
  evalEDivOp :: forall (instr :: [T] -> [T] -> *).
Value' instr 'TInt
-> Value' instr 'TInt
-> Value'
     instr
     ('TOption ('TPair (EDivOpRes 'TInt 'TInt) (EModOpRes 'TInt 'TInt)))
evalEDivOp (VInt Integer
i) (VInt Integer
j) =
    if Integer
j Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0
      then Maybe (Value' instr ('TPair 'TInt 'TNat))
-> Value' instr ('TOption ('TPair 'TInt 'TNat))
forall (t1 :: T) (instr :: [T] -> [T] -> *).
SingI t1 =>
Maybe (Value' instr t1) -> Value' instr ('TOption t1)
VOption (Maybe (Value' instr ('TPair 'TInt 'TNat))
 -> Value' instr ('TOption ('TPair 'TInt 'TNat)))
-> Maybe (Value' instr ('TPair 'TInt 'TNat))
-> Value' instr ('TOption ('TPair 'TInt 'TNat))
forall a b. (a -> b) -> a -> b
$ Maybe (Value' instr ('TPair 'TInt 'TNat))
forall a. Maybe a
Nothing
      else Maybe (Value' instr ('TPair 'TInt 'TNat))
-> Value' instr ('TOption ('TPair 'TInt 'TNat))
forall (t1 :: T) (instr :: [T] -> [T] -> *).
SingI t1 =>
Maybe (Value' instr t1) -> Value' instr ('TOption t1)
VOption (Maybe (Value' instr ('TPair 'TInt 'TNat))
 -> Value' instr ('TOption ('TPair 'TInt 'TNat)))
-> Maybe (Value' instr ('TPair 'TInt 'TNat))
-> Value' instr ('TOption ('TPair 'TInt 'TNat))
forall a b. (a -> b) -> a -> b
$ Value' instr ('TPair 'TInt 'TNat)
-> Maybe (Value' instr ('TPair 'TInt 'TNat))
forall a. a -> Maybe a
Just (Value' instr ('TPair 'TInt 'TNat)
 -> Maybe (Value' instr ('TPair 'TInt 'TNat)))
-> Value' instr ('TPair 'TInt 'TNat)
-> Maybe (Value' instr ('TPair 'TInt 'TNat))
forall a b. (a -> b) -> a -> b
$
        (Value' instr 'TInt, Value' instr 'TNat)
-> Value' instr ('TPair 'TInt 'TNat)
forall (l :: T) (r :: T) (instr :: [T] -> [T] -> *).
(Value' instr l, Value' instr r) -> Value' instr ('TPair l r)
VPair (Integer -> Value' instr 'TInt
forall (instr :: [T] -> [T] -> *). Integer -> Value' instr 'TInt
VInt (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
divMich Integer
i Integer
j), Natural -> Value' instr 'TNat
forall (instr :: [T] -> [T] -> *). Natural -> Value' instr 'TNat
VNat (Natural -> Value' instr 'TNat) -> Natural -> Value' instr 'TNat
forall a b. (a -> b) -> a -> b
$ Integer -> Natural
forall a. (HasCallStack, Integral a) => Integer -> a
fromInteger (Integer -> Natural) -> Integer -> Natural
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
modMich Integer
i Integer
j)

instance EDivOp 'TInt 'TNat where
  type EDivOpRes 'TInt 'TNat = 'TInt
  type EModOpRes 'TInt 'TNat = 'TNat
  evalEDivOp :: forall (instr :: [T] -> [T] -> *).
Value' instr 'TInt
-> Value' instr 'TNat
-> Value'
     instr
     ('TOption ('TPair (EDivOpRes 'TInt 'TNat) (EModOpRes 'TInt 'TNat)))
evalEDivOp (VInt Integer
i) (VNat Natural
j) =
    if Natural
j Natural -> Natural -> Bool
forall a. Eq a => a -> a -> Bool
== Natural
0
      then Maybe (Value' instr ('TPair 'TInt 'TNat))
-> Value' instr ('TOption ('TPair 'TInt 'TNat))
forall (t1 :: T) (instr :: [T] -> [T] -> *).
SingI t1 =>
Maybe (Value' instr t1) -> Value' instr ('TOption t1)
VOption (Maybe (Value' instr ('TPair 'TInt 'TNat))
 -> Value' instr ('TOption ('TPair 'TInt 'TNat)))
-> Maybe (Value' instr ('TPair 'TInt 'TNat))
-> Value' instr ('TOption ('TPair 'TInt 'TNat))
forall a b. (a -> b) -> a -> b
$ Maybe (Value' instr ('TPair 'TInt 'TNat))
forall a. Maybe a
Nothing
      else Maybe (Value' instr ('TPair 'TInt 'TNat))
-> Value' instr ('TOption ('TPair 'TInt 'TNat))
forall (t1 :: T) (instr :: [T] -> [T] -> *).
SingI t1 =>
Maybe (Value' instr t1) -> Value' instr ('TOption t1)
VOption (Maybe (Value' instr ('TPair 'TInt 'TNat))
 -> Value' instr ('TOption ('TPair 'TInt 'TNat)))
-> Maybe (Value' instr ('TPair 'TInt 'TNat))
-> Value' instr ('TOption ('TPair 'TInt 'TNat))
forall a b. (a -> b) -> a -> b
$ Value' instr ('TPair 'TInt 'TNat)
-> Maybe (Value' instr ('TPair 'TInt 'TNat))
forall a. a -> Maybe a
Just (Value' instr ('TPair 'TInt 'TNat)
 -> Maybe (Value' instr ('TPair 'TInt 'TNat)))
-> Value' instr ('TPair 'TInt 'TNat)
-> Maybe (Value' instr ('TPair 'TInt 'TNat))
forall a b. (a -> b) -> a -> b
$
        (Value' instr 'TInt, Value' instr 'TNat)
-> Value' instr ('TPair 'TInt 'TNat)
forall (l :: T) (r :: T) (instr :: [T] -> [T] -> *).
(Value' instr l, Value' instr r) -> Value' instr ('TPair l r)
VPair (Integer -> Value' instr 'TInt
forall (instr :: [T] -> [T] -> *). Integer -> Value' instr 'TInt
VInt (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
divMich Integer
i (Natural -> Integer
forall a. Integral a => a -> Integer
toInteger Natural
j)), Natural -> Value' instr 'TNat
forall (instr :: [T] -> [T] -> *). Natural -> Value' instr 'TNat
VNat (Natural -> Value' instr 'TNat) -> Natural -> Value' instr 'TNat
forall a b. (a -> b) -> a -> b
$ Integer -> Natural
forall a. (HasCallStack, Integral a) => Integer -> a
fromInteger (Integer -> Natural) -> Integer -> Natural
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
modMich Integer
i (Natural -> Integer
forall a. Integral a => a -> Integer
toInteger Natural
j))

instance EDivOp 'TNat 'TInt where
  type EDivOpRes 'TNat 'TInt = 'TInt
  type EModOpRes 'TNat 'TInt = 'TNat
  evalEDivOp :: forall (instr :: [T] -> [T] -> *).
Value' instr 'TNat
-> Value' instr 'TInt
-> Value'
     instr
     ('TOption ('TPair (EDivOpRes 'TNat 'TInt) (EModOpRes 'TNat 'TInt)))
evalEDivOp (VNat Natural
i) (VInt Integer
j) =
    if Integer
j Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0
      then Maybe (Value' instr ('TPair 'TInt 'TNat))
-> Value' instr ('TOption ('TPair 'TInt 'TNat))
forall (t1 :: T) (instr :: [T] -> [T] -> *).
SingI t1 =>
Maybe (Value' instr t1) -> Value' instr ('TOption t1)
VOption (Maybe (Value' instr ('TPair 'TInt 'TNat))
 -> Value' instr ('TOption ('TPair 'TInt 'TNat)))
-> Maybe (Value' instr ('TPair 'TInt 'TNat))
-> Value' instr ('TOption ('TPair 'TInt 'TNat))
forall a b. (a -> b) -> a -> b
$ Maybe (Value' instr ('TPair 'TInt 'TNat))
forall a. Maybe a
Nothing
      else Maybe (Value' instr ('TPair 'TInt 'TNat))
-> Value' instr ('TOption ('TPair 'TInt 'TNat))
forall (t1 :: T) (instr :: [T] -> [T] -> *).
SingI t1 =>
Maybe (Value' instr t1) -> Value' instr ('TOption t1)
VOption (Maybe (Value' instr ('TPair 'TInt 'TNat))
 -> Value' instr ('TOption ('TPair 'TInt 'TNat)))
-> Maybe (Value' instr ('TPair 'TInt 'TNat))
-> Value' instr ('TOption ('TPair 'TInt 'TNat))
forall a b. (a -> b) -> a -> b
$ Value' instr ('TPair 'TInt 'TNat)
-> Maybe (Value' instr ('TPair 'TInt 'TNat))
forall a. a -> Maybe a
Just (Value' instr ('TPair 'TInt 'TNat)
 -> Maybe (Value' instr ('TPair 'TInt 'TNat)))
-> Value' instr ('TPair 'TInt 'TNat)
-> Maybe (Value' instr ('TPair 'TInt 'TNat))
forall a b. (a -> b) -> a -> b
$
        (Value' instr 'TInt, Value' instr 'TNat)
-> Value' instr ('TPair 'TInt 'TNat)
forall (l :: T) (r :: T) (instr :: [T] -> [T] -> *).
(Value' instr l, Value' instr r) -> Value' instr ('TPair l r)
VPair (Integer -> Value' instr 'TInt
forall (instr :: [T] -> [T] -> *). Integer -> Value' instr 'TInt
VInt (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
divMich (Natural -> Integer
forall a. Integral a => a -> Integer
toInteger Natural
i) Integer
j), Natural -> Value' instr 'TNat
forall (instr :: [T] -> [T] -> *). Natural -> Value' instr 'TNat
VNat (Natural -> Value' instr 'TNat) -> Natural -> Value' instr 'TNat
forall a b. (a -> b) -> a -> b
$ Integer -> Natural
forall a. (HasCallStack, Integral a) => Integer -> a
fromInteger (Integer -> Natural) -> Integer -> Natural
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
modMich (Natural -> Integer
forall a. Integral a => a -> Integer
toInteger Natural
i) Integer
j)

instance EDivOp 'TNat 'TNat where
  type EDivOpRes 'TNat 'TNat = 'TNat
  type EModOpRes 'TNat 'TNat = 'TNat
  evalEDivOp :: forall (instr :: [T] -> [T] -> *).
Value' instr 'TNat
-> Value' instr 'TNat
-> Value'
     instr
     ('TOption ('TPair (EDivOpRes 'TNat 'TNat) (EModOpRes 'TNat 'TNat)))
evalEDivOp (VNat Natural
i) (VNat Natural
j) =
    if Natural
j Natural -> Natural -> Bool
forall a. Eq a => a -> a -> Bool
== Natural
0
      then Maybe (Value' instr ('TPair 'TNat 'TNat))
-> Value' instr ('TOption ('TPair 'TNat 'TNat))
forall (t1 :: T) (instr :: [T] -> [T] -> *).
SingI t1 =>
Maybe (Value' instr t1) -> Value' instr ('TOption t1)
VOption (Maybe (Value' instr ('TPair 'TNat 'TNat))
 -> Value' instr ('TOption ('TPair 'TNat 'TNat)))
-> Maybe (Value' instr ('TPair 'TNat 'TNat))
-> Value' instr ('TOption ('TPair 'TNat 'TNat))
forall a b. (a -> b) -> a -> b
$ Maybe (Value' instr ('TPair 'TNat 'TNat))
forall a. Maybe a
Nothing
      else Maybe (Value' instr ('TPair 'TNat 'TNat))
-> Value' instr ('TOption ('TPair 'TNat 'TNat))
forall (t1 :: T) (instr :: [T] -> [T] -> *).
SingI t1 =>
Maybe (Value' instr t1) -> Value' instr ('TOption t1)
VOption (Maybe (Value' instr ('TPair 'TNat 'TNat))
 -> Value' instr ('TOption ('TPair 'TNat 'TNat)))
-> Maybe (Value' instr ('TPair 'TNat 'TNat))
-> Value' instr ('TOption ('TPair 'TNat 'TNat))
forall a b. (a -> b) -> a -> b
$ Value' instr ('TPair 'TNat 'TNat)
-> Maybe (Value' instr ('TPair 'TNat 'TNat))
forall a. a -> Maybe a
Just (Value' instr ('TPair 'TNat 'TNat)
 -> Maybe (Value' instr ('TPair 'TNat 'TNat)))
-> Value' instr ('TPair 'TNat 'TNat)
-> Maybe (Value' instr ('TPair 'TNat 'TNat))
forall a b. (a -> b) -> a -> b
$
        (Value' instr 'TNat, Value' instr 'TNat)
-> Value' instr ('TPair 'TNat 'TNat)
forall (l :: T) (r :: T) (instr :: [T] -> [T] -> *).
(Value' instr l, Value' instr r) -> Value' instr ('TPair l r)
VPair (Natural -> Value' instr 'TNat
forall (instr :: [T] -> [T] -> *). Natural -> Value' instr 'TNat
VNat (Natural -> Natural -> Natural
forall a. Integral a => a -> a -> a
divMich Natural
i Natural
j), Natural -> Value' instr 'TNat
forall (instr :: [T] -> [T] -> *). Natural -> Value' instr 'TNat
VNat (Natural -> Value' instr 'TNat) -> Natural -> Value' instr 'TNat
forall a b. (a -> b) -> a -> b
$ (Natural -> Natural -> Natural
forall a. Integral a => a -> a -> a
modMich Natural
i Natural
j))

instance EDivOp 'TMutez 'TMutez where
  type EDivOpRes 'TMutez 'TMutez = 'TNat
  type EModOpRes 'TMutez 'TMutez = 'TMutez
  evalEDivOp :: forall (instr :: [T] -> [T] -> *).
Value' instr 'TMutez
-> Value' instr 'TMutez
-> Value'
     instr
     ('TOption
        ('TPair (EDivOpRes 'TMutez 'TMutez) (EModOpRes 'TMutez 'TMutez)))
evalEDivOp (VMutez Mutez
i) (VMutez Mutez
j) =
    Maybe (Value' instr ('TPair 'TNat 'TMutez))
-> Value' instr ('TOption ('TPair 'TNat 'TMutez))
forall (t1 :: T) (instr :: [T] -> [T] -> *).
SingI t1 =>
Maybe (Value' instr t1) -> Value' instr ('TOption t1)
VOption (Maybe (Value' instr ('TPair 'TNat 'TMutez))
 -> Value' instr ('TOption ('TPair 'TNat 'TMutez)))
-> Maybe (Value' instr ('TPair 'TNat 'TMutez))
-> Value' instr ('TOption ('TPair 'TNat 'TMutez))
forall a b. (a -> b) -> a -> b
$
    Mutez
i Mutez -> Mutez -> Maybe (Word63, Mutez)
`divModMutez` Mutez
j Maybe (Word63, Mutez)
-> ((Word63, Mutez) -> Value' instr ('TPair 'TNat 'TMutez))
-> Maybe (Value' instr ('TPair 'TNat 'TMutez))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
      (Word63
quotient, Mutez
remainder) ->
        (Value' instr 'TNat, Value' instr 'TMutez)
-> Value' instr ('TPair 'TNat 'TMutez)
forall (l :: T) (r :: T) (instr :: [T] -> [T] -> *).
(Value' instr l, Value' instr r) -> Value' instr ('TPair l r)
VPair (Natural -> Value' instr 'TNat
forall (instr :: [T] -> [T] -> *). Natural -> Value' instr 'TNat
VNat (Word63 -> Natural
forall a b. (Integral a, Integral b, CheckIntSubType a b) => a -> b
fromIntegral Word63
quotient), Mutez -> Value' instr 'TMutez
forall (instr :: [T] -> [T] -> *). Mutez -> Value' instr 'TMutez
VMutez Mutez
remainder)

instance EDivOp 'TMutez 'TNat where
  type EDivOpRes 'TMutez 'TNat = 'TMutez
  type EModOpRes 'TMutez 'TNat = 'TMutez
  evalEDivOp :: forall (instr :: [T] -> [T] -> *).
Value' instr 'TMutez
-> Value' instr 'TNat
-> Value'
     instr
     ('TOption
        ('TPair (EDivOpRes 'TMutez 'TNat) (EModOpRes 'TMutez 'TNat)))
evalEDivOp (VMutez Mutez
i) (VNat Natural
j) =
    Maybe (Value' instr ('TPair 'TMutez 'TMutez))
-> Value' instr ('TOption ('TPair 'TMutez 'TMutez))
forall (t1 :: T) (instr :: [T] -> [T] -> *).
SingI t1 =>
Maybe (Value' instr t1) -> Value' instr ('TOption t1)
VOption (Maybe (Value' instr ('TPair 'TMutez 'TMutez))
 -> Value' instr ('TOption ('TPair 'TMutez 'TMutez)))
-> Maybe (Value' instr ('TPair 'TMutez 'TMutez))
-> Value' instr ('TOption ('TPair 'TMutez 'TMutez))
forall a b. (a -> b) -> a -> b
$
    Mutez
i Mutez -> Natural -> Maybe (Mutez, Mutez)
forall a. Integral a => Mutez -> a -> Maybe (Mutez, Mutez)
`divModMutezInt` Natural
j Maybe (Mutez, Mutez)
-> ((Mutez, Mutez) -> Value' instr ('TPair 'TMutez 'TMutez))
-> Maybe (Value' instr ('TPair 'TMutez 'TMutez))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
      (Mutez
quotient, Mutez
remainder) ->
        (Value' instr 'TMutez, Value' instr 'TMutez)
-> Value' instr ('TPair 'TMutez 'TMutez)
forall (l :: T) (r :: T) (instr :: [T] -> [T] -> *).
(Value' instr l, Value' instr r) -> Value' instr ('TPair l r)
VPair (Mutez -> Value' instr 'TMutez
forall (instr :: [T] -> [T] -> *). Mutez -> Value' instr 'TMutez
VMutez Mutez
quotient, Mutez -> Value' instr 'TMutez
forall (instr :: [T] -> [T] -> *). Mutez -> Value' instr 'TMutez
VMutez Mutez
remainder)

-- | Computing 'div' function in Michelson style.
-- When divisor is negative, Haskell gives x as integer part,
-- while Michelson gives x+1.
divMich :: Integral a => a -> a -> a
divMich :: forall a. Integral a => a -> a -> a
divMich a
divisible a
divisor = a
divisible a -> a -> a
forall a. Integral a => a -> a -> a
`div` a
divisor a -> a -> a
forall a. Num a => a -> a -> a
+ a
extra
  where
    extra :: a
extra =
      if a
divisor a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
0 Bool -> Bool -> Bool
forall a. Boolean a => a -> a -> a
||
         a
divisible a -> a -> a
forall a. Integral a => a -> a -> a
`mod` a
divisor a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0
      then a
0
      else a
1

-- | Computing 'mod' function in Michelson style.
-- When divisor is negative, Haskell gives a negative modulo,
-- while there is a positive modulo in Michelson.
modMich :: Integral a => a -> a -> a
modMich :: forall a. Integral a => a -> a -> a
modMich a
divisible a
divisor = a
divisible a -> a -> a
forall a. Num a => a -> a -> a
- a
divisor a -> a -> a
forall a. Num a => a -> a -> a
* a
intPart
  where intPart :: a
intPart = a -> a -> a
forall a. Integral a => a -> a -> a
divMich a
divisible a
divisor