{-# OPTIONS_GHC -Wno-redundant-constraints #-}
module Lorentz.Base
( (:->) (..)
, type (%>)
, type (&)
, (#)
, pattern I
, pattern FI
, iGenericIf
, iAnyCode
, iNonFailingCode
, iMapAnyCode
, iForceNotFail
, parseLorentzValue
, transformStringsLorentz
, transformBytesLorentz
, optimizeLorentz
, optimizeLorentzWithConf
, MapLorentzInstr (..)
, ContractOut
, ContractCode (..)
, mkContractCode
, IsNotInView
, SomeContractCode (..)
, ViewCode
, Contract (..)
, toMichelsonContract
, Fn
) where
import Data.Constraint (Bottom(..))
import Data.Default (def)
import Fmt (Buildable(..))
import Type.Errors (DelayError, ErrorMessage(..))
import Lorentz.Annotation (HasAnnotation(..))
import Lorentz.Constraints
import Morley.Micheline (ToExpression(..))
import Morley.Michelson.Optimizer (OptimizerConf, optimizeWithConf)
import Morley.Michelson.Parser (MichelsonSource, ParserException, parseExpandValue)
import Morley.Michelson.Preprocess (transformBytes, transformStrings)
import Morley.Michelson.Printer.Util (RenderDoc(..), buildRenderDocExtended)
import Morley.Michelson.Text (MText)
import Morley.Michelson.TypeCheck (TcError, typeCheckValue, typeCheckingWith)
import Morley.Michelson.Typed
(Instr(..), IsNotInView, IsoValue(..), Operation, RemFail(..), ToT, ToTs, Value, WellTyped,
rfAnyInstr, rfMapAnyInstr, rfMerge)
import Morley.Michelson.Typed qualified as M (Contract)
import Morley.Michelson.Typed.Contract (giveNotInView)
import Morley.Michelson.Untyped qualified as U
newtype (inp :: [Type]) :-> (out :: [Type]) = LorentzInstr
{ forall (inp :: [*]) (out :: [*]).
(inp :-> out) -> RemFail Instr (ToTs inp) (ToTs out)
unLorentzInstr :: RemFail Instr (ToTs inp) (ToTs out)
} deriving newtype (Int -> (inp :-> out) -> ShowS
[inp :-> out] -> ShowS
(inp :-> out) -> String
(Int -> (inp :-> out) -> ShowS)
-> ((inp :-> out) -> String)
-> ([inp :-> out] -> ShowS)
-> Show (inp :-> out)
forall (inp :: [*]) (out :: [*]). Int -> (inp :-> out) -> ShowS
forall (inp :: [*]) (out :: [*]). [inp :-> out] -> ShowS
forall (inp :: [*]) (out :: [*]). (inp :-> out) -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [inp :-> out] -> ShowS
$cshowList :: forall (inp :: [*]) (out :: [*]). [inp :-> out] -> ShowS
show :: (inp :-> out) -> String
$cshow :: forall (inp :: [*]) (out :: [*]). (inp :-> out) -> String
showsPrec :: Int -> (inp :-> out) -> ShowS
$cshowsPrec :: forall (inp :: [*]) (out :: [*]). Int -> (inp :-> out) -> ShowS
Show, (inp :-> out) -> (inp :-> out) -> Bool
((inp :-> out) -> (inp :-> out) -> Bool)
-> ((inp :-> out) -> (inp :-> out) -> Bool) -> Eq (inp :-> out)
forall (inp :: [*]) (out :: [*]).
(inp :-> out) -> (inp :-> out) -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: (inp :-> out) -> (inp :-> out) -> Bool
$c/= :: forall (inp :: [*]) (out :: [*]).
(inp :-> out) -> (inp :-> out) -> Bool
== :: (inp :-> out) -> (inp :-> out) -> Bool
$c== :: forall (inp :: [*]) (out :: [*]).
(inp :-> out) -> (inp :-> out) -> Bool
Eq)
infixr 1 :->
instance Buildable (inp :-> out) where
build :: (inp :-> out) -> Builder
build = (inp :-> out) -> Builder
forall a. RenderDoc a => a -> Builder
buildRenderDocExtended
instance RenderDoc (inp :-> out) where
renderDoc :: RenderContext -> (inp :-> out) -> Doc
renderDoc RenderContext
context = RenderContext -> Instr (ToTs inp) (ToTs out) -> Doc
forall a. RenderDoc a => RenderContext -> a -> Doc
renderDoc RenderContext
context (Instr (ToTs inp) (ToTs out) -> Doc)
-> ((inp :-> out) -> Instr (ToTs inp) (ToTs out))
-> (inp :-> out)
-> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (inp :-> out) -> Instr (ToTs inp) (ToTs out)
forall (inp :: [*]) (out :: [*]).
(inp :-> out) -> Instr (ToTs inp) (ToTs out)
iAnyCode
instance NFData (i :-> o) where
rnf :: (i :-> o) -> ()
rnf (LorentzInstr RemFail Instr (ToTs i) (ToTs o)
i) = RemFail Instr (ToTs i) (ToTs o) -> ()
forall a. NFData a => a -> ()
rnf RemFail Instr (ToTs i) (ToTs o)
i
instance Semigroup (s :-> s) where
<> :: (s :-> s) -> (s :-> s) -> s :-> s
(<>) = (s :-> s) -> (s :-> s) -> s :-> s
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
(#)
instance Monoid (s :-> s) where
mempty :: s :-> s
mempty = Instr (ToTs s) (ToTs s) -> s :-> s
forall (inp :: [*]) (out :: [*]).
Instr (ToTs inp) (ToTs out) -> inp :-> out
I Instr (ToTs s) (ToTs s)
forall (inp :: [T]). Instr inp inp
Nop
pattern I :: Instr (ToTs inp) (ToTs out) -> inp :-> out
pattern $bI :: forall (inp :: [*]) (out :: [*]).
Instr (ToTs inp) (ToTs out) -> inp :-> out
$mI :: forall {r} {inp :: [*]} {out :: [*]}.
(inp :-> out)
-> (Instr (ToTs inp) (ToTs out) -> r) -> (Void# -> r) -> r
I i = LorentzInstr (RfNormal i)
pattern FI :: (forall out'. Instr (ToTs inp) out') -> inp :-> out
pattern $bFI :: forall (inp :: [*]) (out :: [*]).
(forall (out' :: [T]). Instr (ToTs inp) out') -> inp :-> out
$mFI :: forall {r} {inp :: [*]} {out :: [*]}.
(inp :-> out)
-> ((forall (out' :: [T]). Instr (ToTs inp) out') -> r)
-> (Void# -> r)
-> r
FI i = LorentzInstr (RfAlwaysFails i)
{-# COMPLETE I, FI #-}
type NoLambdaCodeIsomorphismError :: Constraint
type NoLambdaCodeIsomorphismError =
( Bottom
, DelayError
( 'Text "Since the introduction of recursive lambdas in the Lima protocol,"
':$$: 'Text "Lorentz code (:->) is no longer isomorphic to lambdas."
':$$: 'Text "Construct a lambda value explicitly using mkLambda or mkLambdaRec."
)
)
type family LorentzCodeIsNotIsomorphicToMichelsonValues :: k where {}
instance (NoLambdaCodeIsomorphismError, WellTyped LorentzCodeIsNotIsomorphicToMichelsonValues)
=> IsoValue (inp :-> out) where
type ToT (inp :-> out) = LorentzCodeIsNotIsomorphicToMichelsonValues
toVal :: (inp :-> out) -> Value (ToT (inp :-> out))
toVal = forall a. Bottom => a
(inp :-> out) -> Value (ToT (inp :-> out))
no
fromVal :: Value (ToT (inp :-> out)) -> inp :-> out
fromVal = forall a. Bottom => a
Value (ToT (inp :-> out)) -> inp :-> out
no
instance NoLambdaCodeIsomorphismError => HasAnnotation (i :-> o) where
getAnnotation :: FollowEntrypointFlag -> Notes (ToT (i :-> o))
getAnnotation = forall a. Bottom => a
FollowEntrypointFlag -> Notes (ToT (i :-> o))
no
iGenericIf
:: (forall s'. Instr (ToTs a) s' -> Instr (ToTs b) s' -> Instr (ToTs c) s')
-> (a :-> s) -> (b :-> s) -> (c :-> s)
iGenericIf :: forall (a :: [*]) (b :: [*]) (c :: [*]) (s :: [*]).
(forall (s' :: [T]).
Instr (ToTs a) s' -> Instr (ToTs b) s' -> Instr (ToTs c) s')
-> (a :-> s) -> (b :-> s) -> c :-> s
iGenericIf forall (s' :: [T]).
Instr (ToTs a) s' -> Instr (ToTs b) s' -> Instr (ToTs c) s'
merger (LorentzInstr RemFail Instr (ToTs a) (ToTs s)
instr1) (LorentzInstr RemFail Instr (ToTs b) (ToTs s)
instr2) =
RemFail Instr (ToTs c) (ToTs s) -> c :-> s
forall (inp :: [*]) (out :: [*]).
RemFail Instr (ToTs inp) (ToTs out) -> inp :-> out
LorentzInstr ((forall (s' :: [T]).
Instr (ToTs a) s' -> Instr (ToTs b) s' -> Instr (ToTs c) s')
-> RemFail Instr (ToTs a) (ToTs s)
-> RemFail Instr (ToTs b) (ToTs s)
-> RemFail Instr (ToTs c) (ToTs s)
forall {k} (instr :: k -> k -> *) (i1 :: k) (i2 :: k) (i3 :: k)
(o :: k).
(forall (o' :: k). instr i1 o' -> instr i2 o' -> instr i3 o')
-> RemFail instr i1 o -> RemFail instr i2 o -> RemFail instr i3 o
rfMerge forall (s' :: [T]).
Instr (ToTs a) s' -> Instr (ToTs b) s' -> Instr (ToTs c) s'
merger RemFail Instr (ToTs a) (ToTs s)
instr1 RemFail Instr (ToTs b) (ToTs s)
instr2)
iAnyCode :: inp :-> out -> Instr (ToTs inp) (ToTs out)
iAnyCode :: forall (inp :: [*]) (out :: [*]).
(inp :-> out) -> Instr (ToTs inp) (ToTs out)
iAnyCode = RemFail Instr (ToTs inp) (ToTs out) -> Instr (ToTs inp) (ToTs out)
forall {k} (instr :: k -> k -> *) (i :: k) (o :: k).
RemFail instr i o -> instr i o
rfAnyInstr (RemFail Instr (ToTs inp) (ToTs out)
-> Instr (ToTs inp) (ToTs out))
-> ((inp :-> out) -> RemFail Instr (ToTs inp) (ToTs out))
-> (inp :-> out)
-> Instr (ToTs inp) (ToTs out)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (inp :-> out) -> RemFail Instr (ToTs inp) (ToTs out)
forall (inp :: [*]) (out :: [*]).
(inp :-> out) -> RemFail Instr (ToTs inp) (ToTs out)
unLorentzInstr
iNonFailingCode :: HasCallStack => inp :-> out -> Instr (ToTs inp) (ToTs out)
iNonFailingCode :: forall (inp :: [*]) (out :: [*]).
HasCallStack =>
(inp :-> out) -> Instr (ToTs inp) (ToTs out)
iNonFailingCode (I Instr (ToTs inp) (ToTs out)
i) = Instr (ToTs inp) (ToTs out)
i
iNonFailingCode (FI forall (out' :: [T]). Instr (ToTs inp) out'
_) = Text -> Instr (ToTs inp) (ToTs out)
forall a. HasCallStack => Text -> a
error Text
"Always failing code cannot appear here"
iMapAnyCode
:: (forall o'. Instr (ToTs i1) o' -> Instr (ToTs i2) o')
-> (i1 :-> o)
-> (i2 :-> o)
iMapAnyCode :: forall (i1 :: [*]) (i2 :: [*]) (o :: [*]).
(forall (o' :: [T]). Instr (ToTs i1) o' -> Instr (ToTs i2) o')
-> (i1 :-> o) -> i2 :-> o
iMapAnyCode forall (o' :: [T]). Instr (ToTs i1) o' -> Instr (ToTs i2) o'
f (LorentzInstr RemFail Instr (ToTs i1) (ToTs o)
i) = RemFail Instr (ToTs i2) (ToTs o) -> i2 :-> o
forall (inp :: [*]) (out :: [*]).
RemFail Instr (ToTs inp) (ToTs out) -> inp :-> out
LorentzInstr (RemFail Instr (ToTs i2) (ToTs o) -> i2 :-> o)
-> RemFail Instr (ToTs i2) (ToTs o) -> i2 :-> o
forall a b. (a -> b) -> a -> b
$ (forall (o' :: [T]). Instr (ToTs i1) o' -> Instr (ToTs i2) o')
-> RemFail Instr (ToTs i1) (ToTs o)
-> RemFail Instr (ToTs i2) (ToTs o)
forall {k} (instr :: k -> k -> *) (i1 :: k) (i2 :: k) (o :: k).
(forall (o' :: k). instr i1 o' -> instr i2 o')
-> RemFail instr i1 o -> RemFail instr i2 o
rfMapAnyInstr forall (o' :: [T]). Instr (ToTs i1) o' -> Instr (ToTs i2) o'
f RemFail Instr (ToTs i1) (ToTs o)
i
iForceNotFail :: (i :-> o) -> (i :-> o)
iForceNotFail :: forall (i :: [*]) (o :: [*]). (i :-> o) -> i :-> o
iForceNotFail = Instr (ToTs i) (ToTs o) -> i :-> o
forall (inp :: [*]) (out :: [*]).
Instr (ToTs inp) (ToTs out) -> inp :-> out
I (Instr (ToTs i) (ToTs o) -> i :-> o)
-> ((i :-> o) -> Instr (ToTs i) (ToTs o)) -> (i :-> o) -> i :-> o
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (i :-> o) -> Instr (ToTs i) (ToTs o)
forall (inp :: [*]) (out :: [*]).
(inp :-> out) -> Instr (ToTs inp) (ToTs out)
iAnyCode
type (%>) = (:->)
infixr 1 %>
type ContractOut st = '[([Operation], st)]
newtype ContractCode cp st = ContractCode
{ forall cp st. ContractCode cp st -> '[(cp, st)] :-> ContractOut st
unContractCode :: '[(cp, st)] :-> ContractOut st }
deriving stock (Int -> ContractCode cp st -> ShowS
[ContractCode cp st] -> ShowS
ContractCode cp st -> String
(Int -> ContractCode cp st -> ShowS)
-> (ContractCode cp st -> String)
-> ([ContractCode cp st] -> ShowS)
-> Show (ContractCode cp st)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall cp st. Int -> ContractCode cp st -> ShowS
forall cp st. [ContractCode cp st] -> ShowS
forall cp st. ContractCode cp st -> String
showList :: [ContractCode cp st] -> ShowS
$cshowList :: forall cp st. [ContractCode cp st] -> ShowS
show :: ContractCode cp st -> String
$cshow :: forall cp st. ContractCode cp st -> String
showsPrec :: Int -> ContractCode cp st -> ShowS
$cshowsPrec :: forall cp st. Int -> ContractCode cp st -> ShowS
Show, ContractCode cp st -> ContractCode cp st -> Bool
(ContractCode cp st -> ContractCode cp st -> Bool)
-> (ContractCode cp st -> ContractCode cp st -> Bool)
-> Eq (ContractCode cp st)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall cp st. ContractCode cp st -> ContractCode cp st -> Bool
/= :: ContractCode cp st -> ContractCode cp st -> Bool
$c/= :: forall cp st. ContractCode cp st -> ContractCode cp st -> Bool
== :: ContractCode cp st -> ContractCode cp st -> Bool
$c== :: forall cp st. ContractCode cp st -> ContractCode cp st -> Bool
Eq)
deriving newtype ContractCode cp st -> ()
(ContractCode cp st -> ()) -> NFData (ContractCode cp st)
forall a. (a -> ()) -> NFData a
forall cp st. ContractCode cp st -> ()
rnf :: ContractCode cp st -> ()
$crnf :: forall cp st. ContractCode cp st -> ()
NFData
data SomeContractCode where
SomeContractCode
:: (NiceParameter cp, NiceStorage st)
=> ContractCode cp st
-> SomeContractCode
type ViewCode arg st ret = '[(arg, st)] :-> '[ret]
mkContractCode :: (IsNotInView => '[(cp, st)] :-> ContractOut st) -> ContractCode cp st
mkContractCode :: forall cp st.
(IsNotInView => '[(cp, st)] :-> ContractOut st)
-> ContractCode cp st
mkContractCode IsNotInView => '[(cp, st)] :-> ContractOut st
x = ('[(cp, st)] :-> ContractOut st) -> ContractCode cp st
forall cp st.
('[(cp, st)] :-> ContractOut st) -> ContractCode cp st
ContractCode (('[(cp, st)] :-> ContractOut st) -> ContractCode cp st)
-> ('[(cp, st)] :-> ContractOut st) -> ContractCode cp st
forall a b. (a -> b) -> a -> b
$ (IsNotInView => '[(cp, st)] :-> ContractOut st)
-> '[(cp, st)] :-> ContractOut st
forall r. (IsNotInView => r) -> r
giveNotInView IsNotInView => '[(cp, st)] :-> ContractOut st
x
data Contract cp st vd =
(NiceParameter cp, NiceStorage st, NiceViewsDescriptor vd) =>
Contract
{
forall cp st vd. Contract cp st vd -> Contract (ToT cp) (ToT st)
cMichelsonContract :: M.Contract (ToT cp) (ToT st)
, forall cp st vd. Contract cp st vd -> ContractCode cp st
cDocumentedCode :: ~(ContractCode cp st)
}
deriving stock instance Show (Contract cp st vd)
deriving stock instance Eq (Contract cp st vd)
instance NFData (Contract cp st vd) where
rnf :: Contract cp st vd -> ()
rnf (Contract Contract (ToT cp) (ToT st)
c ContractCode cp st
d) = Contract (ToT cp) (ToT st) -> ()
forall a. NFData a => a -> ()
rnf Contract (ToT cp) (ToT st)
c () -> () -> ()
`seq` ContractCode cp st -> ()
forall a. NFData a => a -> ()
rnf ContractCode cp st
d
instance ToExpression (Contract cp st vd) where
toExpression :: Contract cp st vd -> Expression
toExpression = Contract (ToT cp) (ToT st) -> Expression
forall a. ToExpression a => a -> Expression
toExpression (Contract (ToT cp) (ToT st) -> Expression)
-> (Contract cp st vd -> Contract (ToT cp) (ToT st))
-> Contract cp st vd
-> Expression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Contract cp st vd -> Contract (ToT cp) (ToT st)
forall cp st vd. Contract cp st vd -> Contract (ToT cp) (ToT st)
toMichelsonContract
toMichelsonContract :: Contract cp st vd -> M.Contract (ToT cp) (ToT st)
toMichelsonContract :: forall cp st vd. Contract cp st vd -> Contract (ToT cp) (ToT st)
toMichelsonContract = Contract cp st vd -> Contract (ToT cp) (ToT st)
forall cp st vd. Contract cp st vd -> Contract (ToT cp) (ToT st)
cMichelsonContract
type (&) (a :: Type) (b :: [Type]) = a ': b
infixr 2 &
(#) :: (a :-> b) -> (b :-> c) -> a :-> c
I Instr (ToTs a) (ToTs b)
l # :: forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# I Instr (ToTs b) (ToTs c)
r = Instr (ToTs a) (ToTs c) -> a :-> c
forall (inp :: [*]) (out :: [*]).
Instr (ToTs inp) (ToTs out) -> inp :-> out
I (Instr (ToTs a) (ToTs b)
l Instr (ToTs a) (ToTs b)
-> Instr (ToTs b) (ToTs c) -> Instr (ToTs a) (ToTs c)
forall (inp :: [T]) (b :: [T]) (out :: [T]).
Instr inp b -> Instr b out -> Instr inp out
`Seq` Instr (ToTs b) (ToTs c)
r)
I Instr (ToTs a) (ToTs b)
l # FI forall (out' :: [T]). Instr (ToTs b) out'
r = (forall (out' :: [T]). Instr (ToTs a) out') -> a :-> c
forall (inp :: [*]) (out :: [*]).
(forall (out' :: [T]). Instr (ToTs inp) out') -> inp :-> out
FI (Instr (ToTs a) (ToTs b)
l Instr (ToTs a) (ToTs b)
-> Instr (ToTs b) out' -> Instr (ToTs a) out'
forall (inp :: [T]) (b :: [T]) (out :: [T]).
Instr inp b -> Instr b out -> Instr inp out
`Seq` Instr (ToTs b) out'
forall (out' :: [T]). Instr (ToTs b) out'
r)
FI forall (out' :: [T]). Instr (ToTs a) out'
l # b :-> c
_ = (forall (out' :: [T]). Instr (ToTs a) out') -> a :-> c
forall (inp :: [*]) (out :: [*]).
(forall (out' :: [T]). Instr (ToTs inp) out') -> inp :-> out
FI forall (out' :: [T]). Instr (ToTs a) out'
l
infixl 8 #
type Fn a b = '[a] :-> '[b]
data ParseLorentzError
= ParseLorentzParseError ParserException
| ParseLorentzTypecheckError TcError
deriving stock (Int -> ParseLorentzError -> ShowS
[ParseLorentzError] -> ShowS
ParseLorentzError -> String
(Int -> ParseLorentzError -> ShowS)
-> (ParseLorentzError -> String)
-> ([ParseLorentzError] -> ShowS)
-> Show ParseLorentzError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParseLorentzError] -> ShowS
$cshowList :: [ParseLorentzError] -> ShowS
show :: ParseLorentzError -> String
$cshow :: ParseLorentzError -> String
showsPrec :: Int -> ParseLorentzError -> ShowS
$cshowsPrec :: Int -> ParseLorentzError -> ShowS
Show, ParseLorentzError -> ParseLorentzError -> Bool
(ParseLorentzError -> ParseLorentzError -> Bool)
-> (ParseLorentzError -> ParseLorentzError -> Bool)
-> Eq ParseLorentzError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParseLorentzError -> ParseLorentzError -> Bool
$c/= :: ParseLorentzError -> ParseLorentzError -> Bool
== :: ParseLorentzError -> ParseLorentzError -> Bool
$c== :: ParseLorentzError -> ParseLorentzError -> Bool
Eq)
instance Buildable ParseLorentzError where
build :: ParseLorentzError -> Builder
build =
\case
ParseLorentzParseError ParserException
e -> ParserException -> Builder
forall p. Buildable p => p -> Builder
build ParserException
e
ParseLorentzTypecheckError TcError
e -> TcError -> Builder
forall p. Buildable p => p -> Builder
build TcError
e
parseLorentzValue
:: forall v. KnownValue v
=> MichelsonSource
-> Text
-> Either ParseLorentzError v
parseLorentzValue :: forall v.
KnownValue v =>
MichelsonSource -> Text -> Either ParseLorentzError v
parseLorentzValue MichelsonSource
src =
(Value (ToT v) -> v)
-> Either ParseLorentzError (Value (ToT v))
-> Either ParseLorentzError v
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value (ToT v) -> v
forall a. IsoValue a => Value (ToT a) -> a
fromVal (Either ParseLorentzError (Value (ToT v))
-> Either ParseLorentzError v)
-> (Text -> Either ParseLorentzError (Value (ToT v)))
-> Text
-> Either ParseLorentzError v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Either ParseLorentzError (Value (ToT v))
toTyped (Value -> Either ParseLorentzError (Value (ToT v)))
-> (Text -> Either ParseLorentzError Value)
-> Text
-> Either ParseLorentzError (Value (ToT v))
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< (ParserException -> ParseLorentzError)
-> Either ParserException Value -> Either ParseLorentzError Value
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ParserException -> ParseLorentzError
ParseLorentzParseError (Either ParserException Value -> Either ParseLorentzError Value)
-> (Text -> Either ParserException Value)
-> Text
-> Either ParseLorentzError Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MichelsonSource -> Text -> Either ParserException Value
parseExpandValue MichelsonSource
src)
where
toTyped :: U.Value -> Either ParseLorentzError (Value (ToT v))
toTyped :: Value -> Either ParseLorentzError (Value (ToT v))
toTyped =
(TcError -> ParseLorentzError)
-> Either TcError (Value (ToT v))
-> Either ParseLorentzError (Value (ToT v))
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first TcError -> ParseLorentzError
ParseLorentzTypecheckError (Either TcError (Value (ToT v))
-> Either ParseLorentzError (Value (ToT v)))
-> (Value -> Either TcError (Value (ToT v)))
-> Value
-> Either ParseLorentzError (Value (ToT v))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
TypeCheckOptions
-> TypeCheckResult ExpandedOp (Value (ToT v))
-> Either TcError (Value (ToT v))
forall op a.
TypeCheckOptions -> TypeCheckResult op a -> Either (TcError' op) a
typeCheckingWith TypeCheckOptions
forall a. Default a => a
def (TypeCheckResult ExpandedOp (Value (ToT v))
-> Either TcError (Value (ToT v)))
-> (Value -> TypeCheckResult ExpandedOp (Value (ToT v)))
-> Value
-> Either TcError (Value (ToT v))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Value -> TypeCheckResult ExpandedOp (Value (ToT v))
forall (t :: T).
SingI t =>
Value -> TypeCheckResult ExpandedOp (Value t)
typeCheckValue
transformStringsLorentz ::
Bool -> (MText -> MText) -> inp :-> out -> inp :-> out
transformStringsLorentz :: forall (inp :: [*]) (out :: [*]).
Bool -> (MText -> MText) -> (inp :-> out) -> inp :-> out
transformStringsLorentz Bool
goToValues MText -> MText
f =
(forall (o' :: [T]). Instr (ToTs inp) o' -> Instr (ToTs inp) o')
-> (inp :-> out) -> inp :-> out
forall (i1 :: [*]) (i2 :: [*]) (o :: [*]).
(forall (o' :: [T]). Instr (ToTs i1) o' -> Instr (ToTs i2) o')
-> (i1 :-> o) -> i2 :-> o
iMapAnyCode ((forall (o' :: [T]). Instr (ToTs inp) o' -> Instr (ToTs inp) o')
-> (inp :-> out) -> inp :-> out)
-> (forall (o' :: [T]). Instr (ToTs inp) o' -> Instr (ToTs inp) o')
-> (inp :-> out)
-> inp :-> out
forall a b. (a -> b) -> a -> b
$ Bool
-> (MText -> MText) -> Instr (ToTs inp) o' -> Instr (ToTs inp) o'
forall (inp :: [T]) (out :: [T]).
Bool -> (MText -> MText) -> Instr inp out -> Instr inp out
transformStrings Bool
goToValues MText -> MText
f
transformBytesLorentz ::
Bool -> (ByteString -> ByteString) -> inp :-> out -> inp :-> out
transformBytesLorentz :: forall (inp :: [*]) (out :: [*]).
Bool -> (ByteString -> ByteString) -> (inp :-> out) -> inp :-> out
transformBytesLorentz Bool
goToValues ByteString -> ByteString
f =
(forall (o' :: [T]). Instr (ToTs inp) o' -> Instr (ToTs inp) o')
-> (inp :-> out) -> inp :-> out
forall (i1 :: [*]) (i2 :: [*]) (o :: [*]).
(forall (o' :: [T]). Instr (ToTs i1) o' -> Instr (ToTs i2) o')
-> (i1 :-> o) -> i2 :-> o
iMapAnyCode ((forall (o' :: [T]). Instr (ToTs inp) o' -> Instr (ToTs inp) o')
-> (inp :-> out) -> inp :-> out)
-> (forall (o' :: [T]). Instr (ToTs inp) o' -> Instr (ToTs inp) o')
-> (inp :-> out)
-> inp :-> out
forall a b. (a -> b) -> a -> b
$ Bool
-> (ByteString -> ByteString)
-> Instr (ToTs inp) o'
-> Instr (ToTs inp) o'
forall (inp :: [T]) (out :: [T]).
Bool
-> (ByteString -> ByteString) -> Instr inp out -> Instr inp out
transformBytes Bool
goToValues ByteString -> ByteString
f
optimizeLorentzWithConf
:: OptimizerConf
-> inp :-> out
-> inp :-> out
optimizeLorentzWithConf :: forall (inp :: [*]) (out :: [*]).
OptimizerConf -> (inp :-> out) -> inp :-> out
optimizeLorentzWithConf OptimizerConf
conf =
(forall (o' :: [T]). Instr (ToTs inp) o' -> Instr (ToTs inp) o')
-> (inp :-> out) -> inp :-> out
forall (i1 :: [*]) (i2 :: [*]) (o :: [*]).
(forall (o' :: [T]). Instr (ToTs i1) o' -> Instr (ToTs i2) o')
-> (i1 :-> o) -> i2 :-> o
iMapAnyCode (OptimizerConf -> Instr (ToTs inp) o' -> Instr (ToTs inp) o'
forall (inp :: [T]) (out :: [T]).
OptimizerConf -> Instr inp out -> Instr inp out
optimizeWithConf OptimizerConf
conf)
optimizeLorentz
:: inp :-> out
-> inp :-> out
optimizeLorentz :: forall (i :: [*]) (o :: [*]). (i :-> o) -> i :-> o
optimizeLorentz = OptimizerConf -> (inp :-> out) -> inp :-> out
forall (inp :: [*]) (out :: [*]).
OptimizerConf -> (inp :-> out) -> inp :-> out
optimizeLorentzWithConf OptimizerConf
forall a. Default a => a
def
class MapLorentzInstr instr where
mapLorentzInstr :: (forall i o. (i :-> o) -> (i :-> o)) -> instr -> instr
instance MapLorentzInstr (i :-> o) where
mapLorentzInstr :: (forall (i :: [*]) (o :: [*]). (i :-> o) -> i :-> o)
-> (i :-> o) -> i :-> o
mapLorentzInstr forall (i :: [*]) (o :: [*]). (i :-> o) -> i :-> o
f = (i :-> o) -> i :-> o
forall (i :: [*]) (o :: [*]). (i :-> o) -> i :-> o
f