module Michelson.Preprocess
( transformStrings
, transformBytes
) where
import Data.Default (def)
import qualified Data.Map.Strict as Map
import qualified Data.Set as Set
import Michelson.Text (MText)
import Michelson.Typed
transformStrings :: Bool -> (MText -> MText) -> Instr inp out -> Instr inp out
transformStrings :: Bool -> (MText -> MText) -> Instr inp out -> Instr inp out
transformStrings goToValues :: Bool
goToValues f :: MText -> MText
f = Bool
-> (forall (t :: T). Value t -> Value t)
-> Instr inp out
-> Instr inp out
forall (inp :: [T]) (out :: [T]).
Bool
-> (forall (t :: T). Value t -> Value t)
-> Instr inp out
-> Instr inp out
transformConstants Bool
goToValues forall (t :: T). Value t -> Value t
valF
where
valF :: Value t -> Value t
valF :: Value t -> Value t
valF = \case
VString str :: MText
str -> MText -> Value t
forall (instr :: [T] -> [T] -> *). MText -> Value' instr 'TString
VString (MText -> Value t) -> MText -> Value t
forall a b. (a -> b) -> a -> b
$ MText -> MText
f MText
str
VOption mv :: Maybe (Value' Instr t)
mv -> Maybe (Value' Instr t) -> Value' Instr ('TOption t)
forall (t :: T) (instr :: [T] -> [T] -> *).
Maybe (Value' instr t) -> Value' instr ('TOption t)
VOption (Value' Instr t -> Value' Instr t
forall (t :: T). Value t -> Value t
valF (Value' Instr t -> Value' Instr t)
-> Maybe (Value' Instr t) -> Maybe (Value' Instr t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Value' Instr t)
mv)
VList vs :: [Value' Instr t]
vs -> [Value' Instr t] -> Value' Instr ('TList t)
forall (t :: T) (instr :: [T] -> [T] -> *).
[Value' instr t] -> Value' instr ('TList t)
VList (Value' Instr t -> Value' Instr t
forall (t :: T). Value t -> Value t
valF (Value' Instr t -> Value' Instr t)
-> [Value' Instr t] -> [Value' Instr t]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Value' Instr t]
vs)
VSet vSet :: Set (Value' Instr t)
vSet -> Set (Value' Instr t) -> Value' Instr ('TSet t)
forall (t :: T) (instr :: [T] -> [T] -> *).
Comparable t =>
Set (Value' instr t) -> Value' instr ('TSet t)
VSet ((Value' Instr t -> Value' Instr t)
-> Set (Value' Instr t) -> Set (Value' Instr t)
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map Value' Instr t -> Value' Instr t
forall (t :: T). Value t -> Value t
valF Set (Value' Instr t)
vSet)
VPair (v1 :: Value' Instr l
v1, v2 :: Value' Instr r
v2) -> (Value' Instr l, Value' Instr r) -> Value' Instr ('TPair l r)
forall (l :: T) (r :: T) (instr :: [T] -> [T] -> *).
(Value' instr l, Value' instr r) -> Value' instr ('TPair l r)
VPair (Value' Instr l -> Value' Instr l
forall (t :: T). Value t -> Value t
valF Value' Instr l
v1, Value' Instr r -> Value' Instr r
forall (t :: T). Value t -> Value t
valF Value' Instr r
v2)
VOr eith :: Either (Value' Instr l) (Value' Instr r)
eith -> Either (Value' Instr l) (Value' Instr r) -> Value' Instr ('TOr l r)
forall (l :: T) (r :: T) (instr :: [T] -> [T] -> *).
Either (Value' instr l) (Value' instr r) -> Value' instr ('TOr l r)
VOr ((Value' Instr l -> Value' Instr l)
-> (Value' Instr r -> Value' Instr r)
-> Either (Value' Instr l) (Value' Instr r)
-> Either (Value' Instr l) (Value' Instr r)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Value' Instr l -> Value' Instr l
forall (t :: T). Value t -> Value t
valF Value' Instr r -> Value' Instr r
forall (t :: T). Value t -> Value t
valF Either (Value' Instr l) (Value' Instr r)
eith)
VMap m :: 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] -> *).
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)
-> Map (Value' Instr k) (Value' Instr v))
-> Map (Value' Instr k) (Value' Instr v)
-> Value' Instr ('TMap k v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value' Instr v -> Value' Instr v)
-> Map (Value' Instr k) (Value' Instr v)
-> Map (Value' Instr k) (Value' Instr v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value' Instr v -> Value' Instr v
forall (t :: T). Value t -> Value t
valF (Map (Value' Instr k) (Value' Instr v)
-> Map (Value' Instr k) (Value' Instr v))
-> (Map (Value' Instr k) (Value' Instr v)
-> Map (Value' Instr k) (Value' Instr v))
-> Map (Value' Instr k) (Value' Instr v)
-> Map (Value' Instr k) (Value' Instr v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value' Instr k -> Value' Instr k)
-> Map (Value' Instr k) (Value' Instr v)
-> Map (Value' Instr k) (Value' Instr v)
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys Value' Instr k -> Value' Instr k
forall (t :: T). Value t -> Value t
valF (Map (Value' Instr k) (Value' Instr v) -> Value t)
-> Map (Value' Instr k) (Value' Instr v) -> Value t
forall a b. (a -> b) -> a -> b
$ Map (Value' Instr k) (Value' Instr v)
m
VBigMap m :: Map (Value' Instr k) (Value' Instr v)
m -> Map (Value' Instr k) (Value' Instr v)
-> Value' Instr ('TBigMap k v)
forall (k :: T) (v :: T) (instr :: [T] -> [T] -> *).
Comparable k =>
Map (Value' instr k) (Value' instr v)
-> Value' instr ('TBigMap k v)
VBigMap (Map (Value' Instr k) (Value' Instr v)
-> Value' Instr ('TBigMap k v))
-> (Map (Value' Instr k) (Value' Instr v)
-> Map (Value' Instr k) (Value' Instr v))
-> Map (Value' Instr k) (Value' Instr v)
-> Value' Instr ('TBigMap k v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value' Instr v -> Value' Instr v)
-> Map (Value' Instr k) (Value' Instr v)
-> Map (Value' Instr k) (Value' Instr v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value' Instr v -> Value' Instr v
forall (t :: T). Value t -> Value t
valF (Map (Value' Instr k) (Value' Instr v)
-> Map (Value' Instr k) (Value' Instr v))
-> (Map (Value' Instr k) (Value' Instr v)
-> Map (Value' Instr k) (Value' Instr v))
-> Map (Value' Instr k) (Value' Instr v)
-> Map (Value' Instr k) (Value' Instr v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value' Instr k -> Value' Instr k)
-> Map (Value' Instr k) (Value' Instr v)
-> Map (Value' Instr k) (Value' Instr v)
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys Value' Instr k -> Value' Instr k
forall (t :: T). Value t -> Value t
valF (Map (Value' Instr k) (Value' Instr v) -> Value t)
-> Map (Value' Instr k) (Value' Instr v) -> Value t
forall a b. (a -> b) -> a -> b
$ Map (Value' Instr k) (Value' Instr v)
m
v :: Value t
v -> Value t
v
transformBytes :: Bool -> (ByteString -> ByteString) -> Instr inp out -> Instr inp out
transformBytes :: Bool
-> (ByteString -> ByteString) -> Instr inp out -> Instr inp out
transformBytes goToValues :: Bool
goToValues f :: ByteString -> ByteString
f = Bool
-> (forall (t :: T). Value t -> Value t)
-> Instr inp out
-> Instr inp out
forall (inp :: [T]) (out :: [T]).
Bool
-> (forall (t :: T). Value t -> Value t)
-> Instr inp out
-> Instr inp out
transformConstants Bool
goToValues forall (t :: T). Value t -> Value t
valF
where
valF :: Value t -> Value t
valF :: Value t -> Value t
valF = \case
VBytes str :: ByteString
str -> ByteString -> Value t
forall (instr :: [T] -> [T] -> *).
ByteString -> Value' instr 'TBytes
VBytes (ByteString -> Value t) -> ByteString -> Value t
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
f ByteString
str
VOption mv :: Maybe (Value' Instr t)
mv -> Maybe (Value' Instr t) -> Value' Instr ('TOption t)
forall (t :: T) (instr :: [T] -> [T] -> *).
Maybe (Value' instr t) -> Value' instr ('TOption t)
VOption (Value' Instr t -> Value' Instr t
forall (t :: T). Value t -> Value t
valF (Value' Instr t -> Value' Instr t)
-> Maybe (Value' Instr t) -> Maybe (Value' Instr t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Value' Instr t)
mv)
VList vs :: [Value' Instr t]
vs -> [Value' Instr t] -> Value' Instr ('TList t)
forall (t :: T) (instr :: [T] -> [T] -> *).
[Value' instr t] -> Value' instr ('TList t)
VList (Value' Instr t -> Value' Instr t
forall (t :: T). Value t -> Value t
valF (Value' Instr t -> Value' Instr t)
-> [Value' Instr t] -> [Value' Instr t]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Value' Instr t]
vs)
VSet vSet :: Set (Value' Instr t)
vSet -> Set (Value' Instr t) -> Value' Instr ('TSet t)
forall (t :: T) (instr :: [T] -> [T] -> *).
Comparable t =>
Set (Value' instr t) -> Value' instr ('TSet t)
VSet ((Value' Instr t -> Value' Instr t)
-> Set (Value' Instr t) -> Set (Value' Instr t)
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map Value' Instr t -> Value' Instr t
forall (t :: T). Value t -> Value t
valF Set (Value' Instr t)
vSet)
VPair (v1 :: Value' Instr l
v1, v2 :: Value' Instr r
v2) -> (Value' Instr l, Value' Instr r) -> Value' Instr ('TPair l r)
forall (l :: T) (r :: T) (instr :: [T] -> [T] -> *).
(Value' instr l, Value' instr r) -> Value' instr ('TPair l r)
VPair (Value' Instr l -> Value' Instr l
forall (t :: T). Value t -> Value t
valF Value' Instr l
v1, Value' Instr r -> Value' Instr r
forall (t :: T). Value t -> Value t
valF Value' Instr r
v2)
VOr eith :: Either (Value' Instr l) (Value' Instr r)
eith -> Either (Value' Instr l) (Value' Instr r) -> Value' Instr ('TOr l r)
forall (l :: T) (r :: T) (instr :: [T] -> [T] -> *).
Either (Value' instr l) (Value' instr r) -> Value' instr ('TOr l r)
VOr ((Value' Instr l -> Value' Instr l)
-> (Value' Instr r -> Value' Instr r)
-> Either (Value' Instr l) (Value' Instr r)
-> Either (Value' Instr l) (Value' Instr r)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Value' Instr l -> Value' Instr l
forall (t :: T). Value t -> Value t
valF Value' Instr r -> Value' Instr r
forall (t :: T). Value t -> Value t
valF Either (Value' Instr l) (Value' Instr r)
eith)
VMap m :: 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] -> *).
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)
-> Map (Value' Instr k) (Value' Instr v))
-> Map (Value' Instr k) (Value' Instr v)
-> Value' Instr ('TMap k v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value' Instr v -> Value' Instr v)
-> Map (Value' Instr k) (Value' Instr v)
-> Map (Value' Instr k) (Value' Instr v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value' Instr v -> Value' Instr v
forall (t :: T). Value t -> Value t
valF (Map (Value' Instr k) (Value' Instr v)
-> Map (Value' Instr k) (Value' Instr v))
-> (Map (Value' Instr k) (Value' Instr v)
-> Map (Value' Instr k) (Value' Instr v))
-> Map (Value' Instr k) (Value' Instr v)
-> Map (Value' Instr k) (Value' Instr v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value' Instr k -> Value' Instr k)
-> Map (Value' Instr k) (Value' Instr v)
-> Map (Value' Instr k) (Value' Instr v)
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys Value' Instr k -> Value' Instr k
forall (t :: T). Value t -> Value t
valF (Map (Value' Instr k) (Value' Instr v) -> Value t)
-> Map (Value' Instr k) (Value' Instr v) -> Value t
forall a b. (a -> b) -> a -> b
$ Map (Value' Instr k) (Value' Instr v)
m
VBigMap m :: Map (Value' Instr k) (Value' Instr v)
m -> Map (Value' Instr k) (Value' Instr v)
-> Value' Instr ('TBigMap k v)
forall (k :: T) (v :: T) (instr :: [T] -> [T] -> *).
Comparable k =>
Map (Value' instr k) (Value' instr v)
-> Value' instr ('TBigMap k v)
VBigMap (Map (Value' Instr k) (Value' Instr v)
-> Value' Instr ('TBigMap k v))
-> (Map (Value' Instr k) (Value' Instr v)
-> Map (Value' Instr k) (Value' Instr v))
-> Map (Value' Instr k) (Value' Instr v)
-> Value' Instr ('TBigMap k v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value' Instr v -> Value' Instr v)
-> Map (Value' Instr k) (Value' Instr v)
-> Map (Value' Instr k) (Value' Instr v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value' Instr v -> Value' Instr v
forall (t :: T). Value t -> Value t
valF (Map (Value' Instr k) (Value' Instr v)
-> Map (Value' Instr k) (Value' Instr v))
-> (Map (Value' Instr k) (Value' Instr v)
-> Map (Value' Instr k) (Value' Instr v))
-> Map (Value' Instr k) (Value' Instr v)
-> Map (Value' Instr k) (Value' Instr v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value' Instr k -> Value' Instr k)
-> Map (Value' Instr k) (Value' Instr v)
-> Map (Value' Instr k) (Value' Instr v)
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys Value' Instr k -> Value' Instr k
forall (t :: T). Value t -> Value t
valF (Map (Value' Instr k) (Value' Instr v) -> Value t)
-> Map (Value' Instr k) (Value' Instr v) -> Value t
forall a b. (a -> b) -> a -> b
$ Map (Value' Instr k) (Value' Instr v)
m
v :: Value t
v -> Value t
v
transformConstants ::
forall inp out.
Bool
-> (forall t. Value t -> Value t)
-> Instr inp out
-> Instr inp out
transformConstants :: Bool
-> (forall (t :: T). Value t -> Value t)
-> Instr inp out
-> Instr inp out
transformConstants dsGoToValues :: Bool
dsGoToValues f :: forall (t :: T). Value t -> Value t
f = (Instr inp out, ()) -> Instr inp out
forall a b. (a, b) -> a
fst ((Instr inp out, ()) -> Instr inp out)
-> (Instr inp out -> (Instr inp out, ()))
-> Instr inp out
-> Instr inp out
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DfsSettings ()
-> (forall (i :: [T]) (o :: [T]). Instr i o -> (Instr i o, ()))
-> Instr inp out
-> (Instr inp out, ())
forall x (inp :: [T]) (out :: [T]).
Semigroup x =>
DfsSettings x
-> (forall (i :: [T]) (o :: [T]). Instr i o -> (Instr i o, x))
-> Instr inp out
-> (Instr inp out, x)
dfsInstr DfsSettings ()
forall a. Default a => a
def{ Bool
dsGoToValues :: Bool
dsGoToValues :: Bool
dsGoToValues } forall (i :: [T]) (o :: [T]). Instr i o -> (Instr i o, ())
step
where
step :: forall i o. Instr i o -> (Instr i o, ())
step :: Instr i o -> (Instr i o, ())
step = (,()) (Instr i o -> (Instr i o, ()))
-> (Instr i o -> Instr i o) -> Instr i o -> (Instr i o, ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
PUSH v :: Value' Instr t
v -> Value' Instr t -> Instr i (t : i)
forall (t :: T) (s :: [T]).
ConstantScope t =>
Value' Instr t -> Instr s (t : s)
PUSH (Value' Instr t -> Value' Instr t
forall (t :: T). Value t -> Value t
f Value' Instr t
v)
i :: Instr i o
i -> Instr i o
i