module Indigo.Compilation
( CommentSettings (..)
, CommentsVerbosity (..)
, defaultCommentSettings
, compileIndigo
, compileIndigoContractFull
, compileIndigoContract
) where
import qualified Data.Map as M
import Prelude
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.Internal hiding (SetField, (<>), (==), (>>))
import Indigo.Lorentz
import qualified Lorentz.Instr as L
import qualified Lorentz.Macro 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 :: SequentialHooks
-> IndigoWithParams n inp a
-> ((Block, RefId) -> StackVars inp -> inp :-> inp)
-> inp :-> inp
compileIndigoImpl seqHooks :: SequentialHooks
seqHooks paramCode :: IndigoWithParams n inp a
paramCode runner :: (Block, RefId) -> StackVars inp -> inp :-> inp
runner =
(Block, RefId) -> StackVars inp -> inp :-> inp
runner (Block, RefId)
optimized StackVars inp
initMd
where
(code :: IndigoM a
code, initMd :: StackVars inp
initMd, nextRef :: RefId
nextRef) = IndigoWithParams n inp a -> (IndigoM a, StackVars inp, RefId)
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 :: CommentSettings -> IndigoWithParams n inp a -> inp :-> inp
compileIndigoFull (CommentSettings -> CommentHooks
settingsToHooks -> CommentHooks{..}) paramCode :: IndigoWithParams n inp a
paramCode =
SequentialHooks
-> IndigoWithParams n inp a
-> ((Block, RefId) -> StackVars inp -> inp :-> inp)
-> inp :-> inp
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 :: (Block, RefId)
block stk :: 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 :: IndigoWithParams n inp a -> inp :-> inp
compileIndigo = CommentSettings -> IndigoWithParams n inp a -> inp :-> inp
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 :: CommentSettings -> IndigoContract param st -> ContractCode param st
compileIndigoContractFull (CommentSettings -> CommentHooks
settingsToHooks -> CommentHooks{..}) code :: IndigoContract param st
code =
('[param, st, Ops] :-> '[param, st, Ops]) -> ContractCode param st
prepare (('[param, st, Ops] :-> '[param, st, Ops])
-> ContractCode param st)
-> ('[param, st, Ops] :-> '[param, st, Ops])
-> ContractCode param st
forall a b. (a -> b) -> a -> b
$ SequentialHooks
-> IndigoWithParams 3 '[param, st, Ops] ()
-> ((Block, RefId)
-> StackVars '[param, st, Ops]
-> '[param, st, Ops] :-> '[param, st, Ops])
-> '[param, st, Ops] :-> '[param, st, Ops]
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
block, nextRef :: RefId
nextRef) ->
\case
(StkElements (Ref parRef :: RefId
parRef :& Ref stRef :: RefId
stRef :& opsStack :: Rec StkEl rs
opsStack)) ->
let (storageObj :: Object st
storageObj, nextRef' :: RefId
nextRef', someGen :: 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 decompStk :: StackVars out
decompStk decompose :: (st : rs) :-> out
decompose composeBack :: 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
_ -> Text -> '[param, st, Ops] :-> '[param, st, Ops]
forall a. HasCallStack => Text -> a
error "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]) -> ContractCode param st
prepare cd :: '[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] :-> '[(Ops, st)]) -> ContractCode param st
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# '[Ops, st] :-> '[(Ops, 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 :: 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)