module Indigo.Compilation
( compileIndigo
, compileIndigoContract
) where
import qualified Data.Map as M
import Indigo.Compilation.Field
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 Indigo.Prelude
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))
=> IndigoWithParams n inp a
-> (StackVars inp -> (Block, RefId) -> (inp :-> inp))
-> inp :-> inp
compileIndigoImpl :: IndigoWithParams n inp a
-> (StackVars inp -> (Block, RefId) -> inp :-> inp) -> inp :-> inp
compileIndigoImpl paramCode :: IndigoWithParams n inp a
paramCode runner :: StackVars inp -> (Block, RefId) -> inp :-> inp
runner =
StackVars inp -> (Block, RefId) -> inp :-> inp
runner StackVars inp
initMd (Block, RefId)
optimized
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 -> IndigoM a -> (Block, RefId)
forall a. RefId -> IndigoM a -> (Block, RefId)
indigoMtoSequential RefId
nextRef 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
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 paramCode :: IndigoWithParams n inp a
paramCode =
IndigoWithParams n inp a
-> (StackVars inp -> (Block, RefId) -> inp :-> inp) -> inp :-> inp
forall (n :: Nat) (inp :: [*]) a.
(AreIndigoParams n inp, KnownValue a, Default (StackVars inp)) =>
IndigoWithParams n inp a
-> (StackVars inp -> (Block, RefId) -> inp :-> inp) -> inp :-> inp
compileIndigoImpl @n @inp @a IndigoWithParams n inp a
paramCode (\stk :: StackVars inp
stk block :: (Block, RefId)
block -> MetaData inp -> (Block, RefId) -> inp :-> inp
forall (inp :: [*]). MetaData inp -> (Block, RefId) -> inp :-> inp
sequentialToLorentz (StackVars inp -> DecomposedObjects -> MetaData inp
forall (inp :: [*]).
StackVars inp -> DecomposedObjects -> MetaData inp
MetaData StackVars inp
stk DecomposedObjects
forall a. Monoid a => a
mempty) (Block, RefId)
block)
compileIndigoContract
:: forall param st .
( KnownValue param
, IsObject st
)
=> IndigoContract param st
-> ContractCode param st
compileIndigoContract :: IndigoContract param st -> ContractCode param st
compileIndigoContract 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
$ IndigoWithParams 3 '[param, st, Ops] ()
-> (StackVars '[param, st, Ops]
-> (Block, RefId) -> '[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)) =>
IndigoWithParams n inp a
-> (StackVars inp -> (Block, RefId) -> inp :-> inp) -> inp :-> inp
compileIndigoImpl @3 @'[param, st, Ops] (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) ((StackVars '[param, st, Ops]
-> (Block, RefId) -> '[param, st, Ops] :-> '[param, st, Ops])
-> '[param, st, Ops] :-> '[param, st, Ops])
-> (StackVars '[param, st, Ops]
-> (Block, RefId) -> '[param, st, Ops] :-> '[param, st, Ops])
-> '[param, st, Ops] :-> '[param, st, Ops]
forall a b. (a -> b) -> a -> b
$
\(parRef :: StkEl r
parRef :& storageRef :: StkEl r
storageRef :& opsStack :: Rec StkEl rs
opsStack) (block :: Block
block, nextRef :: RefId
nextRef) ->
let stRef :: RefId
stRef = case StkEl r
storageRef of
NoRef -> Text -> RefId
forall a. HasCallStack => Text -> a
error "Storage variable hasn't been assigned"
Ref r :: RefId
r -> RefId
r in
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 (StkEl st
forall a. KnownValue a => StkEl a
NoRef StkEl st -> Rec StkEl rs -> Rec StkEl (st & rs)
forall u (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& 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 (r : out)
md = StackVars (r : out) -> DecomposedObjects -> MetaData (r : out)
forall (inp :: [*]).
StackVars inp -> DecomposedObjects -> MetaData inp
MetaData (StkEl r
parRef StkEl r -> StackVars out -> StackVars (r : out)
forall u (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& StackVars out
decompStk) (DecomposedObjects -> MetaData (r : out))
-> DecomposedObjects -> MetaData (r : out)
forall a b. (a -> b) -> a -> b
$ 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)
indigoCode :: (r : out) :-> (r : out)
indigoCode = MetaData (r : out) -> (Block, RefId) -> (r : out) :-> (r : out)
forall (inp :: [*]). MetaData inp -> (Block, RefId) -> inp :-> inp
sequentialToLorentz MetaData (r : out)
md (Block
block, RefId
nextRef') in
((st & rs) :-> out) -> (r & (st & rs)) :-> (r : out)
forall a (s :: [*]) (s' :: [*]).
HasCallStack =>
(s :-> s') -> (a & s) :-> (a & s')
L.dip (st & rs) :-> out
decompose ((r & (st & rs)) :-> (r : out))
-> ((r : out) :-> (r : out)) -> (r & (st & rs)) :-> (r : out)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#
(r : out) :-> (r : out)
indigoCode ((r & (st & rs)) :-> (r : out))
-> ((r : out) :-> (r & (st & rs)))
-> (r & (st & rs)) :-> (r & (st & rs))
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#
(out :-> (st & rs)) -> (r : out) :-> (r & (st & rs))
forall a (s :: [*]) (s' :: [*]).
HasCallStack =>
(s :-> s') -> (a & s) :-> (a & s')
L.dip out :-> (st & rs)
composeBack
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