module Indigo.Compilation
( CommentSettings (..)
, CommentsVerbosity (..)
, defaultCommentSettings
, compileIndigo
, compileIndigoContractFull
, compileIndigoContract
) where
import Data.Map qualified as M
import Prelude
import Indigo.Backend.Expr.Decompose (deepDecomposeCompose)
import Indigo.Common.Object (IsObject, SomeObject(SomeObject))
import Indigo.Common.SIS (SomeGenCode(SomeGenCode))
import Indigo.Common.State (GenCode(GenCode), MetaData(MetaData))
import Indigo.Common.Var
import Indigo.Compilation.Field
import Indigo.Compilation.Hooks
(CommentHooks(..), CommentSettings(..), CommentsVerbosity(..), defaultCommentSettings,
settingsToHooks)
import Indigo.Compilation.Lambda
import Indigo.Compilation.Params
import Indigo.Compilation.Sequential
import Indigo.Frontend.Program (IndigoContract)
import Indigo.Lorentz
import Lorentz.Instr qualified as L
compileIndigoImpl
:: forall n inp a. (AreIndigoParams n inp, KnownValue a, Default (StackVars inp))
=> SequentialHooks
-> IndigoWithParams n inp a
-> ((Block, RefId) -> StackVars inp -> (inp :-> inp))
-> inp :-> inp
compileIndigoImpl :: forall (n :: Nat) (inp :: [*]) a.
(AreIndigoParams n inp, KnownValue a, Default (StackVars inp)) =>
SequentialHooks
-> IndigoWithParams n inp a
-> ((Block, RefId) -> StackVars inp -> inp :-> inp)
-> inp :-> inp
compileIndigoImpl SequentialHooks
seqHooks IndigoWithParams n inp a
paramCode (Block, RefId) -> StackVars inp -> inp :-> inp
runner =
(Block, RefId) -> StackVars inp -> inp :-> inp
runner (Block, RefId)
optimized StackVars inp
initMd
where
(IndigoM a
code, StackVars inp
initMd, RefId
nextRef) = forall (n :: Nat) a (inp :: [*]).
(AreIndigoParams n inp, KnownValue a, Default (StackVars inp)) =>
IndigoWithParams n inp a -> (IndigoM a, StackVars inp, RefId)
fromIndigoWithParams @n @a IndigoWithParams n inp a
paramCode
optimized :: (Block, RefId)
optimized = RefId -> SequentialHooks -> IndigoM a -> (Block, RefId)
forall a. RefId -> SequentialHooks -> IndigoM a -> (Block, RefId)
indigoMtoSequential RefId
nextRef SequentialHooks
seqHooks IndigoM a
code
(Block, RefId)
-> ((Block, RefId) -> (Block, RefId)) -> (Block, RefId)
forall a b. a -> (a -> b) -> b
& (Block, RefId) -> (Block, RefId)
compileLambdas
(Block, RefId)
-> ((Block, RefId) -> (Block, RefId)) -> (Block, RefId)
forall a b. a -> (a -> b) -> b
& (Block, RefId) -> (Block, RefId)
optimizeFields
compileIndigoFull
:: forall n inp a. (AreIndigoParams n inp, KnownValue a, Default (StackVars inp))
=> CommentSettings
-> IndigoWithParams n inp a
-> inp :-> inp
compileIndigoFull :: forall (n :: Nat) (inp :: [*]) a.
(AreIndigoParams n inp, KnownValue a, Default (StackVars inp)) =>
CommentSettings -> IndigoWithParams n inp a -> inp :-> inp
compileIndigoFull (CommentSettings -> CommentHooks
settingsToHooks -> CommentHooks{GenCodeHooks
SequentialHooks
chBackendHooks :: CommentHooks -> GenCodeHooks
chFrontendHooks :: CommentHooks -> SequentialHooks
chBackendHooks :: GenCodeHooks
chFrontendHooks :: SequentialHooks
..}) IndigoWithParams n inp a
paramCode =
forall (n :: Nat) (inp :: [*]) a.
(AreIndigoParams n inp, KnownValue a, Default (StackVars inp)) =>
SequentialHooks
-> IndigoWithParams n inp a
-> ((Block, RefId) -> StackVars inp -> inp :-> inp)
-> inp :-> inp
compileIndigoImpl @n @inp @a SequentialHooks
chFrontendHooks IndigoWithParams n inp a
paramCode (((Block, RefId) -> StackVars inp -> inp :-> inp) -> inp :-> inp)
-> ((Block, RefId) -> StackVars inp -> inp :-> inp) -> inp :-> inp
forall a b. (a -> b) -> a -> b
$
\(Block, RefId)
block StackVars inp
stk -> MetaData inp -> (Block, RefId) -> inp :-> inp
forall (inp :: [*]). MetaData inp -> (Block, RefId) -> inp :-> inp
sequentialToLorentz (StackVars inp -> DecomposedObjects -> GenCodeHooks -> MetaData inp
forall (inp :: [*]).
StackVars inp -> DecomposedObjects -> GenCodeHooks -> MetaData inp
MetaData StackVars inp
stk DecomposedObjects
forall a. Monoid a => a
mempty GenCodeHooks
chBackendHooks) (Block, RefId)
block
compileIndigo
:: forall n inp a. (AreIndigoParams n inp, KnownValue a, Default (StackVars inp))
=> IndigoWithParams n inp a
-> inp :-> inp
compileIndigo :: forall (n :: Nat) (inp :: [*]) a.
(AreIndigoParams n inp, KnownValue a, Default (StackVars inp)) =>
IndigoWithParams n inp a -> inp :-> inp
compileIndigo = forall (n :: Nat) (inp :: [*]) a.
(AreIndigoParams n inp, KnownValue a, Default (StackVars inp)) =>
CommentSettings -> IndigoWithParams n inp a -> inp :-> inp
compileIndigoFull @n @inp @a (CommentsVerbosity -> CommentSettings
defaultCommentSettings CommentsVerbosity
NoComments)
compileIndigoContractFull
:: forall param st .
( KnownValue param
, IsObject st
)
=> CommentSettings
-> IndigoContract param st
-> ContractCode param st
compileIndigoContractFull :: forall param st.
(KnownValue param, IsObject st) =>
CommentSettings -> IndigoContract param st -> ContractCode param st
compileIndigoContractFull (CommentSettings -> CommentHooks
settingsToHooks -> CommentHooks{GenCodeHooks
SequentialHooks
chBackendHooks :: GenCodeHooks
chFrontendHooks :: SequentialHooks
chBackendHooks :: CommentHooks -> GenCodeHooks
chFrontendHooks :: CommentHooks -> SequentialHooks
..}) IndigoContract param st
code = (IsNotInView => '[(param, st)] :-> ContractOut st)
-> ContractCode param st
forall cp st.
(IsNotInView => '[(cp, st)] :-> ContractOut st)
-> ContractCode cp st
mkContractCode ((IsNotInView => '[(param, st)] :-> ContractOut st)
-> ContractCode param st)
-> (IsNotInView => '[(param, st)] :-> ContractOut st)
-> ContractCode param st
forall a b. (a -> b) -> a -> b
$
('[param, st, Ops] :-> '[param, st, Ops])
-> '[(param, st)] :-> ContractOut st
prepare (('[param, st, Ops] :-> '[param, st, Ops])
-> '[(param, st)] :-> ContractOut st)
-> ('[param, st, Ops] :-> '[param, st, Ops])
-> '[(param, st)] :-> ContractOut st
forall a b. (a -> b) -> a -> b
$ forall (n :: Nat) (inp :: [*]) a.
(AreIndigoParams n inp, KnownValue a, Default (StackVars inp)) =>
SequentialHooks
-> IndigoWithParams n inp a
-> ((Block, RefId) -> StackVars inp -> inp :-> inp)
-> inp :-> inp
compileIndigoImpl @3 @'[param, st, Ops] SequentialHooks
chFrontendHooks (IndigoContract param st -> IndigoWithParams 3 '[param, st, Ops] ()
forall param st.
KnownValue st =>
IndigoContract param st -> IndigoWithParams 3 '[param, st, Ops] ()
contractToIndigoWithParams IndigoContract param st
code) (((Block, RefId)
-> StackVars '[param, st, Ops]
-> '[param, st, Ops] :-> '[param, st, Ops])
-> '[param, st, Ops] :-> '[param, st, Ops])
-> ((Block, RefId)
-> StackVars '[param, st, Ops]
-> '[param, st, Ops] :-> '[param, st, Ops])
-> '[param, st, Ops] :-> '[param, st, Ops]
forall a b. (a -> b) -> a -> b
$ \(Block
block, RefId
nextRef) ->
\case
(StkElements (Ref RefId
parRef :& Ref RefId
stRef :& Rec StkEl rs
opsStack)) ->
let (Object st
storageObj, RefId
nextRef', SomeGenCode (st : rs)
someGen) = SIS' (st : rs) (Object st)
forall a (inp :: [*]). IsObject a => SIS' (a : inp) (Object a)
deepDecomposeCompose RefId
nextRef (StackVars rs -> StackVars (st : rs)
forall a (inp :: [*]).
KnownValue a =>
StackVars inp -> StackVars (a : inp)
pushNoRef (StackVars rs -> StackVars (st : rs))
-> StackVars rs -> StackVars (st : rs)
forall a b. (a -> b) -> a -> b
$ Rec StkEl rs -> StackVars rs
forall (stk :: [*]). Rec StkEl stk -> StackVars stk
StkElements Rec StkEl rs
opsStack) in
case SomeGenCode (st : rs)
someGen of
SomeGenCode (GenCode StackVars out
decompStk (st : rs) :-> out
decompose out :-> (st : rs)
composeBack) ->
let md :: MetaData (param : out)
md = StackVars (param : out)
-> DecomposedObjects -> GenCodeHooks -> MetaData (param : out)
forall (inp :: [*]).
StackVars inp -> DecomposedObjects -> GenCodeHooks -> MetaData inp
MetaData (Var param -> StackVars out -> StackVars (param : out)
forall a (inp :: [*]).
KnownValue a =>
Var a -> StackVars inp -> StackVars (a : inp)
pushRef (RefId -> Var param
forall {k} (a :: k). RefId -> Var a
Var RefId
parRef) StackVars out
decompStk) (RefId -> SomeObject -> DecomposedObjects
forall k a. k -> a -> Map k a
M.singleton RefId
stRef (Object st -> SomeObject
forall a. IsObject a => Object a -> SomeObject
SomeObject Object st
storageObj)) GenCodeHooks
chBackendHooks
indigoCode :: (param : out) :-> (param : out)
indigoCode = MetaData (param : out)
-> (Block, RefId) -> (param : out) :-> (param : out)
forall (inp :: [*]). MetaData inp -> (Block, RefId) -> inp :-> inp
sequentialToLorentz MetaData (param : out)
md (Block
block, RefId
nextRef') in
((st : rs) :-> out) -> (param : st : rs) :-> (param : out)
forall a (s :: [*]) (s' :: [*]).
HasCallStack =>
(s :-> s') -> (a : s) :-> (a : s')
L.dip (st : rs) :-> out
decompose ((param : st : rs) :-> (param : out))
-> ((param : out) :-> (param : out))
-> (param : st : rs) :-> (param : out)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#
(param : out) :-> (param : out)
indigoCode ((param : st : rs) :-> (param : out))
-> ((param : out) :-> (param : st : rs))
-> (param : st : rs) :-> (param : st : rs)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#
(out :-> (st : rs)) -> (param : out) :-> (param : st : rs)
forall a (s :: [*]) (s' :: [*]).
HasCallStack =>
(s :-> s') -> (a : s) :-> (a : s')
L.dip out :-> (st : rs)
composeBack
StackVars '[param, st, Ops]
_ -> Text -> '[param, st, Ops] :-> '[param, st, Ops]
forall a. HasCallStack => Text -> a
error Text
"invalid initial stack during contract compilation"
where
prepare :: ('[param, st, Ops] :-> '[param, st, Ops]) -> ('[(param, st)] :-> '[(Ops, st)])
prepare :: ('[param, st, Ops] :-> '[param, st, Ops])
-> '[(param, st)] :-> ContractOut st
prepare '[param, st, Ops] :-> '[param, st, Ops]
cd =
'[(param, st)] :-> '[Ops, (param, st)]
forall p (s :: [*]). KnownValue p => s :-> (List p : s)
L.nil ('[(param, st)] :-> '[Ops, (param, st)])
-> ('[Ops, (param, st)] :-> '[(param, st), Ops])
-> '[(param, st)] :-> '[(param, st), Ops]
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# '[Ops, (param, st)] :-> '[(param, st), Ops]
forall a b (s :: [*]). (a : b : s) :-> (b : a : s)
L.swap ('[(param, st)] :-> '[(param, st), Ops])
-> ('[(param, st), Ops] :-> '[param, st, Ops])
-> '[(param, st)] :-> '[param, st, Ops]
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# '[(param, st), Ops] :-> '[param, st, Ops]
forall a b (s :: [*]). ((a, b) : s) :-> (a : b : s)
L.unpair ('[(param, st)] :-> '[param, st, Ops])
-> ('[param, st, Ops] :-> '[param, st, Ops])
-> '[(param, st)] :-> '[param, st, Ops]
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#
'[param, st, Ops] :-> '[param, st, Ops]
cd ('[(param, st)] :-> '[param, st, Ops])
-> ('[param, st, Ops] :-> '[st, Ops])
-> '[(param, st)] :-> '[st, Ops]
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#
'[param, st, Ops] :-> '[st, Ops]
forall a (s :: [*]). (a : s) :-> s
L.drop ('[(param, st)] :-> '[st, Ops])
-> ('[st, Ops] :-> '[Ops, st]) -> '[(param, st)] :-> '[Ops, st]
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#
'[st, Ops] :-> '[Ops, st]
forall a b (s :: [*]). (a : b : s) :-> (b : a : s)
L.swap ('[(param, st)] :-> '[Ops, st])
-> ('[Ops, st] :-> ContractOut st)
-> '[(param, st)] :-> ContractOut st
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# '[Ops, st] :-> ContractOut st
forall a b (s :: [*]). (a : b : s) :-> ((a, b) : s)
L.pair
compileIndigoContract
:: forall param st .
( KnownValue param
, IsObject st
)
=> IndigoContract param st
-> ContractCode param st
compileIndigoContract :: forall param st.
(KnownValue param, IsObject st) =>
IndigoContract param st -> ContractCode param st
compileIndigoContract = CommentSettings -> IndigoContract param st -> ContractCode param st
forall param st.
(KnownValue param, IsObject st) =>
CommentSettings -> IndigoContract param st -> ContractCode param st
compileIndigoContractFull (CommentsVerbosity -> CommentSettings
defaultCommentSettings CommentsVerbosity
NoComments)