{-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE ViewPatterns #-}
module Cubix.Language.Lua.Parametric.Common.Cfg () where
import Control.Monad
import Control.Monad.State ( State, MonadState )
import qualified Data.List as List
import Data.Map ( Map )
import qualified Data.Map as Map
import Data.Proxy
import Data.Typeable ( Typeable )
import Control.Lens ( (%=), makeLenses, Lens', to, use, (^..), (^.), (&), (%~), (.=), over )
import Data.Comp.Multi ( project, project', stripA, remA, (:-<:) )
import Data.Comp.Multi.Ops ( Sum, (:*:)(..), ffst )
import Cubix.Language.Info
import Cubix.Language.Lua.Parametric.Common.Types as C
import Cubix.Language.Lua.Parametric.Full.Types as F
import Cubix.Language.Parametric.Semantics.Cfg
import Cubix.Language.Parametric.Syntax as P
data LuaLabelMap = Fun
| BlockLabelMap { LuaLabelMap -> LabelMap
_block_label_map :: LabelMap }
deriving ( LuaLabelMap -> LuaLabelMap -> Bool
(LuaLabelMap -> LuaLabelMap -> Bool)
-> (LuaLabelMap -> LuaLabelMap -> Bool) -> Eq LuaLabelMap
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LuaLabelMap -> LuaLabelMap -> Bool
$c/= :: LuaLabelMap -> LuaLabelMap -> Bool
== :: LuaLabelMap -> LuaLabelMap -> Bool
$c== :: LuaLabelMap -> LuaLabelMap -> Bool
Eq, Eq LuaLabelMap
Eq LuaLabelMap =>
(LuaLabelMap -> LuaLabelMap -> Ordering)
-> (LuaLabelMap -> LuaLabelMap -> Bool)
-> (LuaLabelMap -> LuaLabelMap -> Bool)
-> (LuaLabelMap -> LuaLabelMap -> Bool)
-> (LuaLabelMap -> LuaLabelMap -> Bool)
-> (LuaLabelMap -> LuaLabelMap -> LuaLabelMap)
-> (LuaLabelMap -> LuaLabelMap -> LuaLabelMap)
-> Ord LuaLabelMap
LuaLabelMap -> LuaLabelMap -> Bool
LuaLabelMap -> LuaLabelMap -> Ordering
LuaLabelMap -> LuaLabelMap -> LuaLabelMap
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: LuaLabelMap -> LuaLabelMap -> LuaLabelMap
$cmin :: LuaLabelMap -> LuaLabelMap -> LuaLabelMap
max :: LuaLabelMap -> LuaLabelMap -> LuaLabelMap
$cmax :: LuaLabelMap -> LuaLabelMap -> LuaLabelMap
>= :: LuaLabelMap -> LuaLabelMap -> Bool
$c>= :: LuaLabelMap -> LuaLabelMap -> Bool
> :: LuaLabelMap -> LuaLabelMap -> Bool
$c> :: LuaLabelMap -> LuaLabelMap -> Bool
<= :: LuaLabelMap -> LuaLabelMap -> Bool
$c<= :: LuaLabelMap -> LuaLabelMap -> Bool
< :: LuaLabelMap -> LuaLabelMap -> Bool
$c< :: LuaLabelMap -> LuaLabelMap -> Bool
compare :: LuaLabelMap -> LuaLabelMap -> Ordering
$ccompare :: LuaLabelMap -> LuaLabelMap -> Ordering
$cp1Ord :: Eq LuaLabelMap
Ord, Int -> LuaLabelMap -> ShowS
[LuaLabelMap] -> ShowS
LuaLabelMap -> String
(Int -> LuaLabelMap -> ShowS)
-> (LuaLabelMap -> String)
-> ([LuaLabelMap] -> ShowS)
-> Show LuaLabelMap
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LuaLabelMap] -> ShowS
$cshowList :: [LuaLabelMap] -> ShowS
show :: LuaLabelMap -> String
$cshow :: LuaLabelMap -> String
showsPrec :: Int -> LuaLabelMap -> ShowS
$cshowsPrec :: Int -> LuaLabelMap -> ShowS
Show)
data LuaLabelMapStack = LuaLabelMapStack { LuaLabelMapStack -> [LuaLabelMap]
_label_map_stack :: [LuaLabelMap]
} deriving ( LuaLabelMapStack -> LuaLabelMapStack -> Bool
(LuaLabelMapStack -> LuaLabelMapStack -> Bool)
-> (LuaLabelMapStack -> LuaLabelMapStack -> Bool)
-> Eq LuaLabelMapStack
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LuaLabelMapStack -> LuaLabelMapStack -> Bool
$c/= :: LuaLabelMapStack -> LuaLabelMapStack -> Bool
== :: LuaLabelMapStack -> LuaLabelMapStack -> Bool
$c== :: LuaLabelMapStack -> LuaLabelMapStack -> Bool
Eq, Eq LuaLabelMapStack
Eq LuaLabelMapStack =>
(LuaLabelMapStack -> LuaLabelMapStack -> Ordering)
-> (LuaLabelMapStack -> LuaLabelMapStack -> Bool)
-> (LuaLabelMapStack -> LuaLabelMapStack -> Bool)
-> (LuaLabelMapStack -> LuaLabelMapStack -> Bool)
-> (LuaLabelMapStack -> LuaLabelMapStack -> Bool)
-> (LuaLabelMapStack -> LuaLabelMapStack -> LuaLabelMapStack)
-> (LuaLabelMapStack -> LuaLabelMapStack -> LuaLabelMapStack)
-> Ord LuaLabelMapStack
LuaLabelMapStack -> LuaLabelMapStack -> Bool
LuaLabelMapStack -> LuaLabelMapStack -> Ordering
LuaLabelMapStack -> LuaLabelMapStack -> LuaLabelMapStack
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: LuaLabelMapStack -> LuaLabelMapStack -> LuaLabelMapStack
$cmin :: LuaLabelMapStack -> LuaLabelMapStack -> LuaLabelMapStack
max :: LuaLabelMapStack -> LuaLabelMapStack -> LuaLabelMapStack
$cmax :: LuaLabelMapStack -> LuaLabelMapStack -> LuaLabelMapStack
>= :: LuaLabelMapStack -> LuaLabelMapStack -> Bool
$c>= :: LuaLabelMapStack -> LuaLabelMapStack -> Bool
> :: LuaLabelMapStack -> LuaLabelMapStack -> Bool
$c> :: LuaLabelMapStack -> LuaLabelMapStack -> Bool
<= :: LuaLabelMapStack -> LuaLabelMapStack -> Bool
$c<= :: LuaLabelMapStack -> LuaLabelMapStack -> Bool
< :: LuaLabelMapStack -> LuaLabelMapStack -> Bool
$c< :: LuaLabelMapStack -> LuaLabelMapStack -> Bool
compare :: LuaLabelMapStack -> LuaLabelMapStack -> Ordering
$ccompare :: LuaLabelMapStack -> LuaLabelMapStack -> Ordering
$cp1Ord :: Eq LuaLabelMapStack
Ord, Int -> LuaLabelMapStack -> ShowS
[LuaLabelMapStack] -> ShowS
LuaLabelMapStack -> String
(Int -> LuaLabelMapStack -> ShowS)
-> (LuaLabelMapStack -> String)
-> ([LuaLabelMapStack] -> ShowS)
-> Show LuaLabelMapStack
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LuaLabelMapStack] -> ShowS
$cshowList :: [LuaLabelMapStack] -> ShowS
show :: LuaLabelMapStack -> String
$cshow :: LuaLabelMapStack -> String
showsPrec :: Int -> LuaLabelMapStack -> ShowS
$cshowsPrec :: Int -> LuaLabelMapStack -> ShowS
Show)
makeLenses ''LuaLabelMapStack
data LuaCfgState = LuaCfgState {
LuaCfgState -> Cfg MLuaSig
_lcs_cfg :: Cfg MLuaSig
, LuaCfgState -> LabelGen
_lcs_labeler :: LabelGen
, LuaCfgState -> LoopStack
_lcs_stack :: LoopStack
, LuaCfgState -> LuaLabelMapStack
_lcs_goto_labs :: LuaLabelMapStack
}
makeLenses ''LuaCfgState
withBlockLabelMap :: (MonadState LuaCfgState m) => m a -> m a
withBlockLabelMap :: m a -> m a
withBlockLabelMap mee :: m a
mee = do
LabelMap -> m ()
forall (m :: * -> *). MonadState LuaCfgState m => LabelMap -> m ()
pushBlockLabelMapStack LabelMap
emptyLabelMap
a
ee <- m a
mee
LabelMap
lm <- Getting LabelMap LuaCfgState LabelMap -> m LabelMap
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting LabelMap LuaCfgState LabelMap
forall c. HasLabelMap c => Lens' c LabelMap
labelMap
m ()
forall (m :: * -> *). MonadState LuaCfgState m => m ()
popLabelMapStack
LabelMap -> m ()
forall (m :: * -> *). MonadState LuaCfgState m => LabelMap -> m ()
mergeLabelMap LabelMap
lm
a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
ee
pushFunLabelMapStack :: (MonadState LuaCfgState m) => m ()
pushFunLabelMapStack :: m ()
pushFunLabelMapStack =
(LuaLabelMapStack -> Identity LuaLabelMapStack)
-> LuaCfgState -> Identity LuaCfgState
Lens' LuaCfgState LuaLabelMapStack
lcs_goto_labs((LuaLabelMapStack -> Identity LuaLabelMapStack)
-> LuaCfgState -> Identity LuaCfgState)
-> (([LuaLabelMap] -> Identity [LuaLabelMap])
-> LuaLabelMapStack -> Identity LuaLabelMapStack)
-> ([LuaLabelMap] -> Identity [LuaLabelMap])
-> LuaCfgState
-> Identity LuaCfgState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.([LuaLabelMap] -> Identity [LuaLabelMap])
-> LuaLabelMapStack -> Identity LuaLabelMapStack
Iso' LuaLabelMapStack [LuaLabelMap]
label_map_stack (([LuaLabelMap] -> Identity [LuaLabelMap])
-> LuaCfgState -> Identity LuaCfgState)
-> ([LuaLabelMap] -> [LuaLabelMap]) -> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (LuaLabelMap
Fun LuaLabelMap -> [LuaLabelMap] -> [LuaLabelMap]
forall a. a -> [a] -> [a]
:)
pushBlockLabelMapStack :: (MonadState LuaCfgState m) => LabelMap -> m ()
pushBlockLabelMapStack :: LabelMap -> m ()
pushBlockLabelMapStack m :: LabelMap
m =
(LuaLabelMapStack -> Identity LuaLabelMapStack)
-> LuaCfgState -> Identity LuaCfgState
Lens' LuaCfgState LuaLabelMapStack
lcs_goto_labs((LuaLabelMapStack -> Identity LuaLabelMapStack)
-> LuaCfgState -> Identity LuaCfgState)
-> (([LuaLabelMap] -> Identity [LuaLabelMap])
-> LuaLabelMapStack -> Identity LuaLabelMapStack)
-> ([LuaLabelMap] -> Identity [LuaLabelMap])
-> LuaCfgState
-> Identity LuaCfgState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.([LuaLabelMap] -> Identity [LuaLabelMap])
-> LuaLabelMapStack -> Identity LuaLabelMapStack
Iso' LuaLabelMapStack [LuaLabelMap]
label_map_stack (([LuaLabelMap] -> Identity [LuaLabelMap])
-> LuaCfgState -> Identity LuaCfgState)
-> ([LuaLabelMap] -> [LuaLabelMap]) -> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (:) (LabelMap -> LuaLabelMap
BlockLabelMap LabelMap
m)
popLabelMapStack :: (MonadState LuaCfgState m) => m ()
popLabelMapStack :: m ()
popLabelMapStack =
(LuaLabelMapStack -> Identity LuaLabelMapStack)
-> LuaCfgState -> Identity LuaCfgState
Lens' LuaCfgState LuaLabelMapStack
lcs_goto_labs((LuaLabelMapStack -> Identity LuaLabelMapStack)
-> LuaCfgState -> Identity LuaCfgState)
-> (([LuaLabelMap] -> Identity [LuaLabelMap])
-> LuaLabelMapStack -> Identity LuaLabelMapStack)
-> ([LuaLabelMap] -> Identity [LuaLabelMap])
-> LuaCfgState
-> Identity LuaCfgState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.([LuaLabelMap] -> Identity [LuaLabelMap])
-> LuaLabelMapStack -> Identity LuaLabelMapStack
Iso' LuaLabelMapStack [LuaLabelMap]
label_map_stack (([LuaLabelMap] -> Identity [LuaLabelMap])
-> LuaCfgState -> Identity LuaCfgState)
-> ([LuaLabelMap] -> [LuaLabelMap]) -> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= [LuaLabelMap] -> [LuaLabelMap]
forall a. [a] -> [a]
tail
emptyLabelMapStack :: LuaLabelMapStack
emptyLabelMapStack :: LuaLabelMapStack
emptyLabelMapStack = [LuaLabelMap] -> LuaLabelMapStack
LuaLabelMapStack []
mergeLabelMap :: (MonadState LuaCfgState m) => LabelMap -> m ()
mergeLabelMap :: LabelMap -> m ()
mergeLabelMap x :: LabelMap
x = do
[LuaLabelMap]
lmstack <- Getting [LuaLabelMap] LuaCfgState [LuaLabelMap] -> m [LuaLabelMap]
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((LuaLabelMapStack -> Const [LuaLabelMap] LuaLabelMapStack)
-> LuaCfgState -> Const [LuaLabelMap] LuaCfgState
Lens' LuaCfgState LuaLabelMapStack
lcs_goto_labs((LuaLabelMapStack -> Const [LuaLabelMap] LuaLabelMapStack)
-> LuaCfgState -> Const [LuaLabelMap] LuaCfgState)
-> (([LuaLabelMap] -> Const [LuaLabelMap] [LuaLabelMap])
-> LuaLabelMapStack -> Const [LuaLabelMap] LuaLabelMapStack)
-> Getting [LuaLabelMap] LuaCfgState [LuaLabelMap]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.([LuaLabelMap] -> Const [LuaLabelMap] [LuaLabelMap])
-> LuaLabelMapStack -> Const [LuaLabelMap] LuaLabelMapStack
Iso' LuaLabelMapStack [LuaLabelMap]
label_map_stack)
case [LuaLabelMap]
lmstack of
(y :: LuaLabelMap
y : _) -> do
case LuaLabelMap
y of
BlockLabelMap y0 :: LabelMap
y0 -> do
Map String (Label, [Label])
y1 <- Map String (Label, [Label])
-> LabelMap -> m (Map String (Label, [Label]))
forall s (m :: * -> *) s.
(MonadState s m, HasCurCfg s MLuaSig, HasLabelMap s) =>
Map String (Label, [Label]) -> s -> m (Map String (Label, [Label]))
go (LabelMap
x LabelMap
-> Getting
(Map String (Label, [Label]))
LabelMap
(Map String (Label, [Label]))
-> Map String (Label, [Label])
forall s a. s -> Getting a s a -> a
^. Getting
(Map String (Label, [Label]))
LabelMap
(Map String (Label, [Label]))
forall c. HasLabelMap c => Lens' c (Map String (Label, [Label]))
label_map) LabelMap
y0
(LabelMap -> Identity LabelMap)
-> LuaCfgState -> Identity LuaCfgState
forall c. HasLabelMap c => Lens' c LabelMap
labelMap((LabelMap -> Identity LabelMap)
-> LuaCfgState -> Identity LuaCfgState)
-> ((Map String (Label, [Label])
-> Identity (Map String (Label, [Label])))
-> LabelMap -> Identity LabelMap)
-> (Map String (Label, [Label])
-> Identity (Map String (Label, [Label])))
-> LuaCfgState
-> Identity LuaCfgState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Map String (Label, [Label])
-> Identity (Map String (Label, [Label])))
-> LabelMap -> Identity LabelMap
forall c. HasLabelMap c => Lens' c (Map String (Label, [Label]))
label_map ((Map String (Label, [Label])
-> Identity (Map String (Label, [Label])))
-> LuaCfgState -> Identity LuaCfgState)
-> Map String (Label, [Label]) -> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Map String (Label, [Label])
y1
Fun -> () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
[] -> () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
where go :: Map String (Label, [Label]) -> s -> m (Map String (Label, [Label]))
go x0 :: Map String (Label, [Label])
x0 y0 :: s
y0 =
(String
-> (Label, [Label])
-> m (Map String (Label, [Label]))
-> m (Map String (Label, [Label])))
-> m (Map String (Label, [Label]))
-> Map String (Label, [Label])
-> m (Map String (Label, [Label]))
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
Map.foldrWithKey String
-> (Label, [Label])
-> m (Map String (Label, [Label]))
-> m (Map String (Label, [Label]))
forall (m :: * -> *) k s.
(Ord k, MonadState s m, HasCurCfg s MLuaSig) =>
k
-> (Label, [Label])
-> m (Map k (Label, [Label]))
-> m (Map k (Label, [Label]))
go0 (Map String (Label, [Label]) -> m (Map String (Label, [Label]))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (s
y0 s
-> Getting
(Map String (Label, [Label])) s (Map String (Label, [Label]))
-> Map String (Label, [Label])
forall s a. s -> Getting a s a -> a
^. Getting
(Map String (Label, [Label])) s (Map String (Label, [Label]))
forall c. HasLabelMap c => Lens' c (Map String (Label, [Label]))
label_map)) Map String (Label, [Label])
x0
go0 :: k
-> (Label, [Label])
-> m (Map k (Label, [Label]))
-> m (Map k (Label, [Label]))
go0 _ (_, []) b :: m (Map k (Label, [Label]))
b = m (Map k (Label, [Label]))
b
go0 k :: k
k (a :: Label
a, vs :: [Label]
vs) b :: m (Map k (Label, [Label]))
b = do
Map k (Label, [Label])
b0 <- m (Map k (Label, [Label]))
b
case k -> Map k (Label, [Label]) -> Maybe (Label, [Label])
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
k Map k (Label, [Label])
b0 of
Nothing -> Map k (Label, [Label]) -> m (Map k (Label, [Label]))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (k
-> (Label, [Label])
-> Map k (Label, [Label])
-> Map k (Label, [Label])
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert k
k (Label
a, [Label]
vs) Map k (Label, [Label])
b0)
Just (a0 :: Label
a0, vs0 :: [Label]
vs0) -> case [Label]
vs0 of
[] -> do
[Label] -> (Label -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Label]
vs ((Label -> m ()) -> m ()) -> (Label -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \p :: Label
p -> (Cfg MLuaSig -> Identity (Cfg MLuaSig)) -> s -> Identity s
forall c (fs :: [(* -> *) -> * -> *]).
HasCurCfg c fs =>
Lens' c (Cfg fs)
cur_cfg ((Cfg MLuaSig -> Identity (Cfg MLuaSig)) -> s -> Identity s)
-> (Cfg MLuaSig -> Cfg MLuaSig) -> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Proxy MLuaSig -> Label -> Label -> Cfg MLuaSig -> Cfg MLuaSig
forall (fs :: [(* -> *) -> * -> *]).
Proxy fs -> Label -> Label -> Cfg fs -> Cfg fs
addEdgeLab (Proxy MLuaSig
forall k (t :: k). Proxy t
Proxy :: Proxy MLuaSig) Label
p Label
a0
Map k (Label, [Label]) -> m (Map k (Label, [Label]))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map k (Label, [Label])
b0
_ -> do
Map k (Label, [Label]) -> m (Map k (Label, [Label]))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (((Label, [Label]) -> (Label, [Label]) -> (Label, [Label]))
-> k
-> (Label, [Label])
-> Map k (Label, [Label])
-> Map k (Label, [Label])
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith (Label, [Label]) -> (Label, [Label]) -> (Label, [Label])
forall a a a. (a, [a]) -> (a, [a]) -> (a, [a])
go2 k
k (Label
a, [Label]
vs) Map k (Label, [Label])
b0)
go2 :: (a, [a]) -> (a, [a]) -> (a, [a])
go2 (_, vs0 :: [a]
vs0) (a1 :: a
a1, vs1 :: [a]
vs1) = (a
a1, [a]
vs0 [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
vs1)
_head :: Lens' [a] a
_head :: (a -> f a) -> [a] -> f [a]
_head _ [] = String -> f [a]
forall a. HasCallStack => String -> a
error "_head: empty list"
_head f :: a -> f a
f (a :: a
a:as :: [a]
as) = (a -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
as) (a -> [a]) -> f a -> f [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f a
f a
a
{-# INLINE _head #-}
block_label_map :: Lens' LuaLabelMap LabelMap
block_label_map :: (LabelMap -> f LabelMap) -> LuaLabelMap -> f LuaLabelMap
block_label_map _ Fun = String -> f LuaLabelMap
forall a. HasCallStack => String -> a
error "block_label_map: unexpected Fun"
block_label_map f :: LabelMap -> f LabelMap
f (BlockLabelMap a :: LabelMap
a) = LabelMap -> LuaLabelMap
BlockLabelMap (LabelMap -> LuaLabelMap) -> f LabelMap -> f LuaLabelMap
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LabelMap -> f LabelMap
f LabelMap
a
{-# INLINE block_label_map #-}
instance HasCurCfg LuaCfgState MLuaSig where cur_cfg :: (Cfg MLuaSig -> f (Cfg MLuaSig)) -> LuaCfgState -> f LuaCfgState
cur_cfg = (Cfg MLuaSig -> f (Cfg MLuaSig)) -> LuaCfgState -> f LuaCfgState
Lens' LuaCfgState (Cfg MLuaSig)
lcs_cfg
instance HasLabelGen LuaCfgState where labelGen :: (LabelGen -> f LabelGen) -> LuaCfgState -> f LuaCfgState
labelGen = (LabelGen -> f LabelGen) -> LuaCfgState -> f LuaCfgState
Lens' LuaCfgState LabelGen
lcs_labeler
instance HasLoopStack LuaCfgState where loopStack :: (LoopStack -> f LoopStack) -> LuaCfgState -> f LuaCfgState
loopStack = (LoopStack -> f LoopStack) -> LuaCfgState -> f LuaCfgState
Lens' LuaCfgState LoopStack
lcs_stack
instance HasLabelMap LuaCfgState where labelMap :: (LabelMap -> f LabelMap) -> LuaCfgState -> f LuaCfgState
labelMap = (LuaLabelMapStack -> f LuaLabelMapStack)
-> LuaCfgState -> f LuaCfgState
Lens' LuaCfgState LuaLabelMapStack
lcs_goto_labs((LuaLabelMapStack -> f LuaLabelMapStack)
-> LuaCfgState -> f LuaCfgState)
-> ((LabelMap -> f LabelMap)
-> LuaLabelMapStack -> f LuaLabelMapStack)
-> (LabelMap -> f LabelMap)
-> LuaCfgState
-> f LuaCfgState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.([LuaLabelMap] -> f [LuaLabelMap])
-> LuaLabelMapStack -> f LuaLabelMapStack
Iso' LuaLabelMapStack [LuaLabelMap]
label_map_stack(([LuaLabelMap] -> f [LuaLabelMap])
-> LuaLabelMapStack -> f LuaLabelMapStack)
-> ((LabelMap -> f LabelMap) -> [LuaLabelMap] -> f [LuaLabelMap])
-> (LabelMap -> f LabelMap)
-> LuaLabelMapStack
-> f LuaLabelMapStack
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(LuaLabelMap -> f LuaLabelMap) -> [LuaLabelMap] -> f [LuaLabelMap]
forall a. Lens' [a] a
_head((LuaLabelMap -> f LuaLabelMap)
-> [LuaLabelMap] -> f [LuaLabelMap])
-> ((LabelMap -> f LabelMap) -> LuaLabelMap -> f LuaLabelMap)
-> (LabelMap -> f LabelMap)
-> [LuaLabelMap]
-> f [LuaLabelMap]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(LabelMap -> f LabelMap) -> LuaLabelMap -> f LuaLabelMap
Lens' LuaLabelMap LabelMap
block_label_map
type instance ComputationSorts MLuaSig = '[StatL, ExpL, PrefixExpL, VarL, TableFieldL, FunCallL, [BlockItemL], AssignL]
type instance SuspendedComputationSorts MLuaSig = '[P.FunctionDefL]
type instance ContainerFunctors MLuaSig = '[PairF, ListF, MaybeF]
type instance CfgState MLuaSig = LuaCfgState
nameString :: MLuaTermLab NameL -> String
nameString :: MLuaTermLab NameL -> String
nameString (MLuaTermLab NameL -> Cxt NoHole (Sum MLuaSig) (K ()) NameL
forall (g :: (* -> *) -> * -> *) (f :: (* -> *) -> * -> *).
(RemA g f, HFunctor g) =>
CxtFun g f
stripA -> Cxt NoHole (Sum MLuaSig) (K ()) NameL
-> Maybe (IdentIsName (Cxt NoHole (Sum MLuaSig) (K ())) NameL)
forall (g :: (* -> *) -> * -> *) (f :: (* -> *) -> * -> *) h
(a :: * -> *).
(g :<: f) =>
NatM Maybe (Cxt h f a) (g (Cxt h f a))
project -> Just (IdentIsName (Ident' s))) = String
s
extractClauses ::
forall fs s a b.
( ListF :-<: fs
, KExtractF2' (,) (Sum fs)
, Typeable a
, Typeable b
) => HState s (EnterExitPair fs) [(a, b)]
-> State s [(EnterExitPair fs a, EnterExitPair fs b)]
hs :: HState s (EnterExitPair fs) [(a, b)]
hs = do
(EnterExitPair fs [(a, b)] -> [EnterExitPair fs (a, b)]
forall (fs :: [(* -> *) -> * -> *]) l.
(ListF :-<: fs, Typeable l) =>
EnterExitPair fs [l] -> [EnterExitPair fs l]
extractEEPList -> [EnterExitPair fs (a, b)]
cs) <- HState s (EnterExitPair fs) [(a, b)]
-> State s (EnterExitPair fs [(a, b)])
forall s (f :: * -> *) l. HState s f l -> State s (f l)
unHState HState s (EnterExitPair fs) [(a, b)]
hs
[(EnterExitPair fs a, EnterExitPair fs b)]
-> State s [(EnterExitPair fs a, EnterExitPair fs b)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(EnterExitPair fs a, EnterExitPair fs b)]
-> State s [(EnterExitPair fs a, EnterExitPair fs b)])
-> [(EnterExitPair fs a, EnterExitPair fs b)]
-> State s [(EnterExitPair fs a, EnterExitPair fs b)]
forall a b. (a -> b) -> a -> b
$ (EnterExitPair fs (a, b)
-> (EnterExitPair fs a, EnterExitPair fs b))
-> [EnterExitPair fs (a, b)]
-> [(EnterExitPair fs a, EnterExitPair fs b)]
forall a b. (a -> b) -> [a] -> [b]
map EnterExitPair fs (a, b) -> (EnterExitPair fs a, EnterExitPair fs b)
extractClause [EnterExitPair fs (a, b)]
cs
where
extractClause :: EnterExitPair fs (a, b) -> (EnterExitPair fs a, EnterExitPair fs b)
extractClause :: EnterExitPair fs (a, b) -> (EnterExitPair fs a, EnterExitPair fs b)
extractClause (SubPairs p :: Sum fs (EnterExitPair fs) (a, b)
p) = Sum fs (EnterExitPair fs) (a, b)
-> (EnterExitPair fs a, EnterExitPair fs b)
forall (f :: * -> * -> *) (g :: (* -> *) -> * -> *) (e :: * -> *) l
l'.
KExtractF2' f g =>
g e (f l l') -> f (e l) (e l')
kextractF2' Sum fs (EnterExitPair fs) (a, b)
p
constructCfgLuaForRange :: MLuaTermLab h -> State LuaCfgState (EnterExitPair MLuaSig i)
-> State LuaCfgState (EnterExitPair MLuaSig j)
-> State LuaCfgState (EnterExitPair MLuaSig k)
-> State LuaCfgState (EnterExitPair MLuaSig l)
-> State LuaCfgState (EnterExitPair MLuaSig m)
constructCfgLuaForRange :: MLuaTermLab h
-> State LuaCfgState (EnterExitPair MLuaSig i)
-> State LuaCfgState (EnterExitPair MLuaSig j)
-> State LuaCfgState (EnterExitPair MLuaSig k)
-> State LuaCfgState (EnterExitPair MLuaSig l)
-> State LuaCfgState (EnterExitPair MLuaSig m)
constructCfgLuaForRange t :: MLuaTermLab h
t mInit :: State LuaCfgState (EnterExitPair MLuaSig i)
mInit mFinal :: State LuaCfgState (EnterExitPair MLuaSig j)
mFinal mOptStep :: State LuaCfgState (EnterExitPair MLuaSig k)
mOptStep mBody :: State LuaCfgState (EnterExitPair MLuaSig l)
mBody = do
CfgNode MLuaSig
enterNode <- MLuaTermLab h
-> CfgNodeType -> StateT LuaCfgState Identity (CfgNode MLuaSig)
forall s (fs :: [(* -> *) -> * -> *]) (m :: * -> *) l.
(HasCurCfg s fs, HasLabelGen s, MonadState s m) =>
TermLab fs l -> CfgNodeType -> m (CfgNode fs)
addCfgNode MLuaTermLab h
t CfgNodeType
EnterNode
CfgNode MLuaSig
exitNode <- MLuaTermLab h
-> CfgNodeType -> StateT LuaCfgState Identity (CfgNode MLuaSig)
forall s (fs :: [(* -> *) -> * -> *]) (m :: * -> *) l.
(HasCurCfg s fs, HasLabelGen s, MonadState s m) =>
TermLab fs l -> CfgNodeType -> m (CfgNode fs)
addCfgNode MLuaTermLab h
t CfgNodeType
ExitNode
EnterExitPair MLuaSig i
init <- State LuaCfgState (EnterExitPair MLuaSig i)
mInit
EnterExitPair MLuaSig j
final <- State LuaCfgState (EnterExitPair MLuaSig j)
mFinal
EnterExitPair MLuaSig k
step <- State LuaCfgState (EnterExitPair MLuaSig k)
mOptStep
CfgNode MLuaSig
-> CfgNode MLuaSig -> StateT LuaCfgState Identity ()
forall s (m :: * -> *) (fs :: [(* -> *) -> * -> *]).
(MonadState s m, HasLoopStack s) =>
CfgNode fs -> CfgNode fs -> m ()
pushLoopNode CfgNode MLuaSig
enterNode CfgNode MLuaSig
exitNode
EnterExitPair MLuaSig l
body <- State LuaCfgState (EnterExitPair MLuaSig l)
mBody
StateT LuaCfgState Identity ()
forall s (m :: * -> *). (MonadState s m, HasLoopStack s) => m ()
popLoopNode
EnterExitPair MLuaSig Any
p <- EnterExitPair MLuaSig i
-> EnterExitPair MLuaSig j
-> StateT LuaCfgState Identity (EnterExitPair MLuaSig Any)
forall s (fs :: [(* -> *) -> * -> *]) (m :: * -> *) i j k.
(HasCurCfg s fs, All HTraversable fs, All HFoldable fs,
All HFunctor fs, MonadState s m) =>
EnterExitPair fs i -> EnterExitPair fs j -> m (EnterExitPair fs k)
combineEnterExit EnterExitPair MLuaSig i
init EnterExitPair MLuaSig j
final
EnterExitPair MLuaSig Any
p' <- EnterExitPair MLuaSig Any
-> EnterExitPair MLuaSig k
-> StateT LuaCfgState Identity (EnterExitPair MLuaSig Any)
forall s (fs :: [(* -> *) -> * -> *]) (m :: * -> *) i j k.
(HasCurCfg s fs, All HTraversable fs, All HFoldable fs,
All HFunctor fs, MonadState s m) =>
EnterExitPair fs i -> EnterExitPair fs j -> m (EnterExitPair fs k)
combineEnterExit EnterExitPair MLuaSig Any
p EnterExitPair MLuaSig k
step
let setupExit :: CfgNode MLuaSig
setupExit = EnterExitPair MLuaSig Any -> CfgNode MLuaSig
forall (fs :: [(* -> *) -> * -> *]) l.
EnterExitPair fs l -> CfgNode fs
exit EnterExitPair MLuaSig Any
p'
(Cfg MLuaSig -> Identity (Cfg MLuaSig))
-> LuaCfgState -> Identity LuaCfgState
forall c (fs :: [(* -> *) -> * -> *]).
HasCurCfg c fs =>
Lens' c (Cfg fs)
cur_cfg ((Cfg MLuaSig -> Identity (Cfg MLuaSig))
-> LuaCfgState -> Identity LuaCfgState)
-> (Cfg MLuaSig -> Cfg MLuaSig) -> StateT LuaCfgState Identity ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= CfgNode MLuaSig -> CfgNode MLuaSig -> Cfg MLuaSig -> Cfg MLuaSig
forall (fs :: [(* -> *) -> * -> *]).
CfgNode fs -> CfgNode fs -> Cfg fs -> Cfg fs
addEdge CfgNode MLuaSig
enterNode (EnterExitPair MLuaSig i -> CfgNode MLuaSig
forall (fs :: [(* -> *) -> * -> *]) l.
EnterExitPair fs l -> CfgNode fs
enter EnterExitPair MLuaSig i
init)
(Cfg MLuaSig -> Identity (Cfg MLuaSig))
-> LuaCfgState -> Identity LuaCfgState
forall c (fs :: [(* -> *) -> * -> *]).
HasCurCfg c fs =>
Lens' c (Cfg fs)
cur_cfg ((Cfg MLuaSig -> Identity (Cfg MLuaSig))
-> LuaCfgState -> Identity LuaCfgState)
-> (Cfg MLuaSig -> Cfg MLuaSig) -> StateT LuaCfgState Identity ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= CfgNode MLuaSig -> CfgNode MLuaSig -> Cfg MLuaSig -> Cfg MLuaSig
forall (fs :: [(* -> *) -> * -> *]).
CfgNode fs -> CfgNode fs -> Cfg fs -> Cfg fs
addEdge CfgNode MLuaSig
setupExit (EnterExitPair MLuaSig l -> CfgNode MLuaSig
forall (fs :: [(* -> *) -> * -> *]) l.
EnterExitPair fs l -> CfgNode fs
enter EnterExitPair MLuaSig l
body)
(Cfg MLuaSig -> Identity (Cfg MLuaSig))
-> LuaCfgState -> Identity LuaCfgState
forall c (fs :: [(* -> *) -> * -> *]).
HasCurCfg c fs =>
Lens' c (Cfg fs)
cur_cfg ((Cfg MLuaSig -> Identity (Cfg MLuaSig))
-> LuaCfgState -> Identity LuaCfgState)
-> (Cfg MLuaSig -> Cfg MLuaSig) -> StateT LuaCfgState Identity ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= CfgNode MLuaSig -> CfgNode MLuaSig -> Cfg MLuaSig -> Cfg MLuaSig
forall (fs :: [(* -> *) -> * -> *]).
CfgNode fs -> CfgNode fs -> Cfg fs -> Cfg fs
addEdge CfgNode MLuaSig
setupExit CfgNode MLuaSig
exitNode
(Cfg MLuaSig -> Identity (Cfg MLuaSig))
-> LuaCfgState -> Identity LuaCfgState
forall c (fs :: [(* -> *) -> * -> *]).
HasCurCfg c fs =>
Lens' c (Cfg fs)
cur_cfg ((Cfg MLuaSig -> Identity (Cfg MLuaSig))
-> LuaCfgState -> Identity LuaCfgState)
-> (Cfg MLuaSig -> Cfg MLuaSig) -> StateT LuaCfgState Identity ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= CfgNode MLuaSig -> CfgNode MLuaSig -> Cfg MLuaSig -> Cfg MLuaSig
forall (fs :: [(* -> *) -> * -> *]).
CfgNode fs -> CfgNode fs -> Cfg fs -> Cfg fs
addEdge (EnterExitPair MLuaSig l -> CfgNode MLuaSig
forall (fs :: [(* -> *) -> * -> *]) l.
EnterExitPair fs l -> CfgNode fs
exit EnterExitPair MLuaSig l
body) (EnterExitPair MLuaSig l -> CfgNode MLuaSig
forall (fs :: [(* -> *) -> * -> *]) l.
EnterExitPair fs l -> CfgNode fs
enter EnterExitPair MLuaSig l
body)
EnterExitPair MLuaSig m
-> State LuaCfgState (EnterExitPair MLuaSig m)
forall (m :: * -> *) a. Monad m => a -> m a
return (EnterExitPair MLuaSig m
-> State LuaCfgState (EnterExitPair MLuaSig m))
-> EnterExitPair MLuaSig m
-> State LuaCfgState (EnterExitPair MLuaSig m)
forall a b. (a -> b) -> a -> b
$ CfgNode MLuaSig -> CfgNode MLuaSig -> EnterExitPair MLuaSig m
forall (fs :: [(* -> *) -> * -> *]) l.
CfgNode fs -> CfgNode fs -> EnterExitPair fs l
EnterExitPair CfgNode MLuaSig
enterNode CfgNode MLuaSig
exitNode
instance ConstructCfg MLuaSig LuaCfgState Stat where
constructCfg :: (:&:)
Stat
Label
(HFix (Sum MLuaSig :&: Label)
:*: HState LuaCfgState (EnterExitPair MLuaSig))
i
-> HState LuaCfgState (EnterExitPair MLuaSig) i
constructCfg ((:&:)
Stat
Label
(HFix (Sum MLuaSig :&: Label)
:*: HState LuaCfgState (EnterExitPair MLuaSig))
i
-> (:*:)
(HFix (Sum MLuaSig :&: Label))
(Stat (HState LuaCfgState (EnterExitPair MLuaSig)))
i
forall (f :: (* -> *) -> * -> *) (gs :: [(* -> *) -> * -> *]) a
(t :: * -> *).
(HFunctor f, f :-<: gs) =>
(:&:) f a (AnnTerm a gs :*: t) :-> (AnnTerm a gs :*: f t)
collapseFProd' -> (t :: AnnTerm Label MLuaSig i
t :*: Break)) = State LuaCfgState (EnterExitPair MLuaSig i)
-> HState LuaCfgState (EnterExitPair MLuaSig) i
forall s (f :: * -> *) l. State s (f l) -> HState s f l
HState (State LuaCfgState (EnterExitPair MLuaSig i)
-> HState LuaCfgState (EnterExitPair MLuaSig) i)
-> State LuaCfgState (EnterExitPair MLuaSig i)
-> HState LuaCfgState (EnterExitPair MLuaSig) i
forall a b. (a -> b) -> a -> b
$ AnnTerm Label MLuaSig i
-> State LuaCfgState (EnterExitPair MLuaSig i)
forall s (m :: * -> *) (gs :: [(* -> *) -> * -> *]) l i.
(HasLoopStack s, MonadState s m, CfgComponent gs s) =>
TermLab gs l -> m (EnterExitPair gs i)
constructCfgBreak AnnTerm Label MLuaSig i
t
constructCfg ((:&:)
Stat
Label
(HFix (Sum MLuaSig :&: Label)
:*: HState LuaCfgState (EnterExitPair MLuaSig))
i
-> (:*:)
(HFix (Sum MLuaSig :&: Label))
(Stat (HState LuaCfgState (EnterExitPair MLuaSig)))
i
forall (f :: (* -> *) -> * -> *) (gs :: [(* -> *) -> * -> *]) a
(t :: * -> *).
(HFunctor f, f :-<: gs) =>
(:&:) f a (AnnTerm a gs :*: t) :-> (AnnTerm a gs :*: f t)
collapseFProd' -> (t :: AnnTerm Label MLuaSig i
t :*: (While e :: HState LuaCfgState (EnterExitPair MLuaSig) ExpL
e b :: HState LuaCfgState (EnterExitPair MLuaSig) BlockL
b))) = State LuaCfgState (EnterExitPair MLuaSig i)
-> HState LuaCfgState (EnterExitPair MLuaSig) i
forall s (f :: * -> *) l. State s (f l) -> HState s f l
HState (State LuaCfgState (EnterExitPair MLuaSig i)
-> HState LuaCfgState (EnterExitPair MLuaSig) i)
-> State LuaCfgState (EnterExitPair MLuaSig i)
-> HState LuaCfgState (EnterExitPair MLuaSig) i
forall a b. (a -> b) -> a -> b
$ AnnTerm Label MLuaSig i
-> StateT LuaCfgState Identity (EnterExitPair MLuaSig ExpL)
-> StateT LuaCfgState Identity (EnterExitPair MLuaSig BlockL)
-> State LuaCfgState (EnterExitPair MLuaSig i)
forall s (m :: * -> *) (gs :: [(* -> *) -> * -> *]) l i j k.
(HasLoopStack s, MonadState s m, CfgComponent gs s) =>
TermLab gs l
-> m (EnterExitPair gs i)
-> m (EnterExitPair gs j)
-> m (EnterExitPair gs k)
constructCfgWhile AnnTerm Label MLuaSig i
t (HState LuaCfgState (EnterExitPair MLuaSig) ExpL
-> StateT LuaCfgState Identity (EnterExitPair MLuaSig ExpL)
forall s (f :: * -> *) l. HState s f l -> State s (f l)
unHState HState LuaCfgState (EnterExitPair MLuaSig) ExpL
e) (HState LuaCfgState (EnterExitPair MLuaSig) BlockL
-> StateT LuaCfgState Identity (EnterExitPair MLuaSig BlockL)
forall s (f :: * -> *) l. HState s f l -> State s (f l)
unHState HState LuaCfgState (EnterExitPair MLuaSig) BlockL
b)
constructCfg ((:&:)
Stat
Label
(HFix (Sum MLuaSig :&: Label)
:*: HState LuaCfgState (EnterExitPair MLuaSig))
i
-> (:*:)
(HFix (Sum MLuaSig :&: Label))
(Stat (HState LuaCfgState (EnterExitPair MLuaSig)))
i
forall (f :: (* -> *) -> * -> *) (gs :: [(* -> *) -> * -> *]) a
(t :: * -> *).
(HFunctor f, f :-<: gs) =>
(:&:) f a (AnnTerm a gs :*: t) :-> (AnnTerm a gs :*: f t)
collapseFProd' -> (t :: AnnTerm Label MLuaSig i
t :*: (Repeat b :: HState LuaCfgState (EnterExitPair MLuaSig) BlockL
b e :: HState LuaCfgState (EnterExitPair MLuaSig) ExpL
e))) = State LuaCfgState (EnterExitPair MLuaSig i)
-> HState LuaCfgState (EnterExitPair MLuaSig) i
forall s (f :: * -> *) l. State s (f l) -> HState s f l
HState (State LuaCfgState (EnterExitPair MLuaSig i)
-> HState LuaCfgState (EnterExitPair MLuaSig) i)
-> State LuaCfgState (EnterExitPair MLuaSig i)
-> HState LuaCfgState (EnterExitPair MLuaSig) i
forall a b. (a -> b) -> a -> b
$ AnnTerm Label MLuaSig i
-> StateT LuaCfgState Identity (EnterExitPair MLuaSig ExpL)
-> StateT LuaCfgState Identity (EnterExitPair MLuaSig BlockL)
-> State LuaCfgState (EnterExitPair MLuaSig i)
forall s (m :: * -> *) (gs :: [(* -> *) -> * -> *]) l i j k.
(HasLoopStack s, MonadState s m, CfgComponent gs s) =>
TermLab gs l
-> m (EnterExitPair gs i)
-> m (EnterExitPair gs j)
-> m (EnterExitPair gs k)
constructCfgDoWhile AnnTerm Label MLuaSig i
t (HState LuaCfgState (EnterExitPair MLuaSig) ExpL
-> StateT LuaCfgState Identity (EnterExitPair MLuaSig ExpL)
forall s (f :: * -> *) l. HState s f l -> State s (f l)
unHState HState LuaCfgState (EnterExitPair MLuaSig) ExpL
e) (HState LuaCfgState (EnterExitPair MLuaSig) BlockL
-> StateT LuaCfgState Identity (EnterExitPair MLuaSig BlockL)
forall s (f :: * -> *) l. HState s f l -> State s (f l)
unHState HState LuaCfgState (EnterExitPair MLuaSig) BlockL
b)
constructCfg ((:&:)
Stat
Label
(HFix (Sum MLuaSig :&: Label)
:*: HState LuaCfgState (EnterExitPair MLuaSig))
i
-> (:*:)
(HFix (Sum MLuaSig :&: Label))
(Stat (HState LuaCfgState (EnterExitPair MLuaSig)))
i
forall (f :: (* -> *) -> * -> *) (gs :: [(* -> *) -> * -> *]) a
(t :: * -> *).
(HFunctor f, f :-<: gs) =>
(:&:) f a (AnnTerm a gs :*: t) :-> (AnnTerm a gs :*: f t)
collapseFProd' -> (t :: AnnTerm Label MLuaSig i
t :*: (ForIn _ e :: HState LuaCfgState (EnterExitPair MLuaSig) [ExpL]
e b :: HState LuaCfgState (EnterExitPair MLuaSig) BlockL
b))) = State LuaCfgState (EnterExitPair MLuaSig i)
-> HState LuaCfgState (EnterExitPair MLuaSig) i
forall s (f :: * -> *) l. State s (f l) -> HState s f l
HState (State LuaCfgState (EnterExitPair MLuaSig i)
-> HState LuaCfgState (EnterExitPair MLuaSig) i)
-> State LuaCfgState (EnterExitPair MLuaSig i)
-> HState LuaCfgState (EnterExitPair MLuaSig) i
forall a b. (a -> b) -> a -> b
$ AnnTerm Label MLuaSig i
-> StateT LuaCfgState Identity (EnterExitPair MLuaSig [ExpL])
-> StateT LuaCfgState Identity (EnterExitPair MLuaSig BlockL)
-> State LuaCfgState (EnterExitPair MLuaSig i)
forall s (m :: * -> *) (gs :: [(* -> *) -> * -> *]) l i j k.
(HasLoopStack s, MonadState s m, CfgComponent gs s) =>
TermLab gs l
-> m (EnterExitPair gs i)
-> m (EnterExitPair gs j)
-> m (EnterExitPair gs k)
constructCfgWhile AnnTerm Label MLuaSig i
t (HState LuaCfgState (EnterExitPair MLuaSig) [ExpL]
-> StateT LuaCfgState Identity (EnterExitPair MLuaSig [ExpL])
forall s (f :: * -> *) l. HState s f l -> State s (f l)
unHState HState LuaCfgState (EnterExitPair MLuaSig) [ExpL]
e) (HState LuaCfgState (EnterExitPair MLuaSig) BlockL
-> StateT LuaCfgState Identity (EnterExitPair MLuaSig BlockL)
forall s (f :: * -> *) l. HState s f l -> State s (f l)
unHState HState LuaCfgState (EnterExitPair MLuaSig) BlockL
b)
constructCfg t :: (:&:)
Stat
Label
(HFix (Sum MLuaSig :&: Label)
:*: HState LuaCfgState (EnterExitPair MLuaSig))
i
t@((:&:)
Stat
Label
(HFix (Sum MLuaSig :&: Label)
:*: HState LuaCfgState (EnterExitPair MLuaSig))
i
-> Stat
(HFix (Sum MLuaSig :&: Label)
:*: HState LuaCfgState (EnterExitPair MLuaSig))
i
forall (s :: (* -> *) -> * -> *) (s' :: (* -> *) -> * -> *)
(a :: * -> *).
RemA s s' =>
s a :-> s' a
remA -> Goto (nam :: MLuaTermLab NameL
nam :*: _)) = State LuaCfgState (EnterExitPair MLuaSig i)
-> HState LuaCfgState (EnterExitPair MLuaSig) i
forall s (f :: * -> *) l. State s (f l) -> HState s f l
HState (State LuaCfgState (EnterExitPair MLuaSig i)
-> HState LuaCfgState (EnterExitPair MLuaSig) i)
-> State LuaCfgState (EnterExitPair MLuaSig i)
-> HState LuaCfgState (EnterExitPair MLuaSig) i
forall a b. (a -> b) -> a -> b
$ AnnTerm Label MLuaSig i
-> String -> State LuaCfgState (EnterExitPair MLuaSig i)
forall s (m :: * -> *) (gs :: [(* -> *) -> * -> *]) l i.
(MonadState s m, HasLabelMap s, CfgComponent gs s) =>
TermLab gs l -> String -> m (EnterExitPair gs i)
constructCfgGoto ((:*:)
(HFix (Sum MLuaSig :&: Label))
(Stat (HState LuaCfgState (EnterExitPair MLuaSig)))
i
-> AnnTerm Label MLuaSig i
forall k (f :: k -> *) (g :: k -> *) (a :: k). (:*:) f g a -> f a
ffst ((:*:)
(HFix (Sum MLuaSig :&: Label))
(Stat (HState LuaCfgState (EnterExitPair MLuaSig)))
i
-> AnnTerm Label MLuaSig i)
-> (:*:)
(HFix (Sum MLuaSig :&: Label))
(Stat (HState LuaCfgState (EnterExitPair MLuaSig)))
i
-> AnnTerm Label MLuaSig i
forall a b. (a -> b) -> a -> b
$ (:&:)
Stat
Label
(HFix (Sum MLuaSig :&: Label)
:*: HState LuaCfgState (EnterExitPair MLuaSig))
i
-> (:*:)
(HFix (Sum MLuaSig :&: Label))
(Stat (HState LuaCfgState (EnterExitPair MLuaSig)))
i
forall (f :: (* -> *) -> * -> *) (gs :: [(* -> *) -> * -> *]) a
(t :: * -> *).
(HFunctor f, f :-<: gs) =>
(:&:) f a (AnnTerm a gs :*: t) :-> (AnnTerm a gs :*: f t)
collapseFProd' (:&:)
Stat
Label
(HFix (Sum MLuaSig :&: Label)
:*: HState LuaCfgState (EnterExitPair MLuaSig))
i
t) (MLuaTermLab NameL -> String
nameString MLuaTermLab NameL
nam)
constructCfg t :: (:&:)
Stat
Label
(HFix (Sum MLuaSig :&: Label)
:*: HState LuaCfgState (EnterExitPair MLuaSig))
i
t@((:&:)
Stat
Label
(HFix (Sum MLuaSig :&: Label)
:*: HState LuaCfgState (EnterExitPair MLuaSig))
i
-> Stat
(HFix (Sum MLuaSig :&: Label)
:*: HState LuaCfgState (EnterExitPair MLuaSig))
i
forall (s :: (* -> *) -> * -> *) (s' :: (* -> *) -> * -> *)
(a :: * -> *).
RemA s s' =>
s a :-> s' a
remA -> Label (nam :: MLuaTermLab NameL
nam :*: _)) = State LuaCfgState (EnterExitPair MLuaSig i)
-> HState LuaCfgState (EnterExitPair MLuaSig) i
forall s (f :: * -> *) l. State s (f l) -> HState s f l
HState (State LuaCfgState (EnterExitPair MLuaSig i)
-> HState LuaCfgState (EnterExitPair MLuaSig) i)
-> State LuaCfgState (EnterExitPair MLuaSig i)
-> HState LuaCfgState (EnterExitPair MLuaSig) i
forall a b. (a -> b) -> a -> b
$ AnnTerm Label MLuaSig i
-> String -> State LuaCfgState (EnterExitPair MLuaSig i)
forall (gs :: [(* -> *) -> * -> *]) s (m :: * -> *) l i.
(MonadState s m, HasLabelMap s, CfgComponent gs s) =>
TermLab gs l -> String -> m (EnterExitPair gs i)
constructCfgLabel ((:*:)
(HFix (Sum MLuaSig :&: Label))
(Stat (HState LuaCfgState (EnterExitPair MLuaSig)))
i
-> AnnTerm Label MLuaSig i
forall k (f :: k -> *) (g :: k -> *) (a :: k). (:*:) f g a -> f a
ffst ((:*:)
(HFix (Sum MLuaSig :&: Label))
(Stat (HState LuaCfgState (EnterExitPair MLuaSig)))
i
-> AnnTerm Label MLuaSig i)
-> (:*:)
(HFix (Sum MLuaSig :&: Label))
(Stat (HState LuaCfgState (EnterExitPair MLuaSig)))
i
-> AnnTerm Label MLuaSig i
forall a b. (a -> b) -> a -> b
$ (:&:)
Stat
Label
(HFix (Sum MLuaSig :&: Label)
:*: HState LuaCfgState (EnterExitPair MLuaSig))
i
-> (:*:)
(HFix (Sum MLuaSig :&: Label))
(Stat (HState LuaCfgState (EnterExitPair MLuaSig)))
i
forall (f :: (* -> *) -> * -> *) (gs :: [(* -> *) -> * -> *]) a
(t :: * -> *).
(HFunctor f, f :-<: gs) =>
(:&:) f a (AnnTerm a gs :*: t) :-> (AnnTerm a gs :*: f t)
collapseFProd' (:&:)
Stat
Label
(HFix (Sum MLuaSig :&: Label)
:*: HState LuaCfgState (EnterExitPair MLuaSig))
i
t) (MLuaTermLab NameL -> String
nameString MLuaTermLab NameL
nam)
constructCfg ((:&:)
Stat
Label
(HFix (Sum MLuaSig :&: Label)
:*: HState LuaCfgState (EnterExitPair MLuaSig))
i
-> (:*:)
(HFix (Sum MLuaSig :&: Label))
(Stat (HState LuaCfgState (EnterExitPair MLuaSig)))
i
forall (f :: (* -> *) -> * -> *) (gs :: [(* -> *) -> * -> *]) a
(t :: * -> *).
(HFunctor f, f :-<: gs) =>
(:&:) f a (AnnTerm a gs :*: t) :-> (AnnTerm a gs :*: f t)
collapseFProd' -> (t :: AnnTerm Label MLuaSig i
t :*: (ForRange _ init :: HState LuaCfgState (EnterExitPair MLuaSig) ExpL
init final :: HState LuaCfgState (EnterExitPair MLuaSig) ExpL
final optStep :: HState LuaCfgState (EnterExitPair MLuaSig) (Maybe ExpL)
optStep body :: HState LuaCfgState (EnterExitPair MLuaSig) BlockL
body))) = State LuaCfgState (EnterExitPair MLuaSig i)
-> HState LuaCfgState (EnterExitPair MLuaSig) i
forall s (f :: * -> *) l. State s (f l) -> HState s f l
HState (State LuaCfgState (EnterExitPair MLuaSig i)
-> HState LuaCfgState (EnterExitPair MLuaSig) i)
-> State LuaCfgState (EnterExitPair MLuaSig i)
-> HState LuaCfgState (EnterExitPair MLuaSig) i
forall a b. (a -> b) -> a -> b
$ AnnTerm Label MLuaSig i
-> StateT LuaCfgState Identity (EnterExitPair MLuaSig ExpL)
-> StateT LuaCfgState Identity (EnterExitPair MLuaSig ExpL)
-> State LuaCfgState (EnterExitPair MLuaSig (Maybe ExpL))
-> StateT LuaCfgState Identity (EnterExitPair MLuaSig BlockL)
-> State LuaCfgState (EnterExitPair MLuaSig i)
forall h i j k l m.
MLuaTermLab h
-> State LuaCfgState (EnterExitPair MLuaSig i)
-> State LuaCfgState (EnterExitPair MLuaSig j)
-> State LuaCfgState (EnterExitPair MLuaSig k)
-> State LuaCfgState (EnterExitPair MLuaSig l)
-> State LuaCfgState (EnterExitPair MLuaSig m)
constructCfgLuaForRange AnnTerm Label MLuaSig i
t (HState LuaCfgState (EnterExitPair MLuaSig) ExpL
-> StateT LuaCfgState Identity (EnterExitPair MLuaSig ExpL)
forall s (f :: * -> *) l. HState s f l -> State s (f l)
unHState HState LuaCfgState (EnterExitPair MLuaSig) ExpL
init) (HState LuaCfgState (EnterExitPair MLuaSig) ExpL
-> StateT LuaCfgState Identity (EnterExitPair MLuaSig ExpL)
forall s (f :: * -> *) l. HState s f l -> State s (f l)
unHState HState LuaCfgState (EnterExitPair MLuaSig) ExpL
final) (HState LuaCfgState (EnterExitPair MLuaSig) (Maybe ExpL)
-> State LuaCfgState (EnterExitPair MLuaSig (Maybe ExpL))
forall s (f :: * -> *) l. HState s f l -> State s (f l)
unHState HState LuaCfgState (EnterExitPair MLuaSig) (Maybe ExpL)
optStep) (HState LuaCfgState (EnterExitPair MLuaSig) BlockL
-> StateT LuaCfgState Identity (EnterExitPair MLuaSig BlockL)
forall s (f :: * -> *) l. HState s f l -> State s (f l)
unHState HState LuaCfgState (EnterExitPair MLuaSig) BlockL
body)
constructCfg ((:&:)
Stat
Label
(HFix (Sum MLuaSig :&: Label)
:*: HState LuaCfgState (EnterExitPair MLuaSig))
i
-> (:*:)
(HFix (Sum MLuaSig :&: Label))
(Stat (HState LuaCfgState (EnterExitPair MLuaSig)))
i
forall (f :: (* -> *) -> * -> *) (gs :: [(* -> *) -> * -> *]) a
(t :: * -> *).
(HFunctor f, f :-<: gs) =>
(:&:) f a (AnnTerm a gs :*: t) :-> (AnnTerm a gs :*: f t)
collapseFProd' -> (t :: AnnTerm Label MLuaSig i
t :*: (If clauses :: HState LuaCfgState (EnterExitPair MLuaSig) [(ExpL, BlockL)]
clauses optElse :: HState LuaCfgState (EnterExitPair MLuaSig) (Maybe BlockL)
optElse))) = State LuaCfgState (EnterExitPair MLuaSig i)
-> HState LuaCfgState (EnterExitPair MLuaSig) i
forall s (f :: * -> *) l. State s (f l) -> HState s f l
HState (State LuaCfgState (EnterExitPair MLuaSig i)
-> HState LuaCfgState (EnterExitPair MLuaSig) i)
-> State LuaCfgState (EnterExitPair MLuaSig i)
-> HState LuaCfgState (EnterExitPair MLuaSig) i
forall a b. (a -> b) -> a -> b
$ AnnTerm Label MLuaSig i
-> StateT
LuaCfgState
Identity
[(EnterExitPair MLuaSig ExpL, EnterExitPair MLuaSig BlockL)]
-> StateT
LuaCfgState Identity (Maybe (EnterExitPair MLuaSig BlockL))
-> State LuaCfgState (EnterExitPair MLuaSig i)
forall s (m :: * -> *) (gs :: [(* -> *) -> * -> *]) l i j k.
(MonadState s m, CfgComponent gs s) =>
TermLab gs l
-> m [(EnterExitPair gs i, EnterExitPair gs j)]
-> m (Maybe (EnterExitPair gs k))
-> m (EnterExitPair gs l)
constructCfgIfElseIfElse AnnTerm Label MLuaSig i
t (HState LuaCfgState (EnterExitPair MLuaSig) [(ExpL, BlockL)]
-> StateT
LuaCfgState
Identity
[(EnterExitPair MLuaSig ExpL, EnterExitPair MLuaSig BlockL)]
forall (fs :: [(* -> *) -> * -> *]) s a b.
(ListF :-<: fs, KExtractF2' (,) (Sum fs), Typeable a,
Typeable b) =>
HState s (EnterExitPair fs) [(a, b)]
-> State s [(EnterExitPair fs a, EnterExitPair fs b)]
extractClauses HState LuaCfgState (EnterExitPair MLuaSig) [(ExpL, BlockL)]
clauses) (StateT LuaCfgState Identity (EnterExitPair MLuaSig (Maybe BlockL))
-> StateT
LuaCfgState Identity (Maybe (EnterExitPair MLuaSig BlockL))
forall (fs :: [(* -> *) -> * -> *]) (m :: * -> *) l.
(All (KExtractF' Maybe) fs, Monad m) =>
m (EnterExitPair fs (Maybe l)) -> m (Maybe (EnterExitPair fs l))
extractEEPMaybe (StateT LuaCfgState Identity (EnterExitPair MLuaSig (Maybe BlockL))
-> StateT
LuaCfgState Identity (Maybe (EnterExitPair MLuaSig BlockL)))
-> StateT
LuaCfgState Identity (EnterExitPair MLuaSig (Maybe BlockL))
-> StateT
LuaCfgState Identity (Maybe (EnterExitPair MLuaSig BlockL))
forall a b. (a -> b) -> a -> b
$ HState LuaCfgState (EnterExitPair MLuaSig) (Maybe BlockL)
-> StateT
LuaCfgState Identity (EnterExitPair MLuaSig (Maybe BlockL))
forall s (f :: * -> *) l. HState s f l -> State s (f l)
unHState HState LuaCfgState (EnterExitPair MLuaSig) (Maybe BlockL)
optElse)
constructCfg t :: (:&:)
Stat
Label
(HFix (Sum MLuaSig :&: Label)
:*: HState LuaCfgState (EnterExitPair MLuaSig))
i
t = (:&:)
Stat
Label
(HFix (Sum MLuaSig :&: Label)
:*: HState LuaCfgState (EnterExitPair MLuaSig))
i
-> HState LuaCfgState (EnterExitPair MLuaSig) i
forall (f :: (* -> *) -> * -> *) (gs :: [(* -> *) -> * -> *]) s.
(f :-<: gs, HTraversable f, CfgComponent gs s, SortChecks gs) =>
PreRAlg
(f :&: Label) (Sum gs :&: Label) (HState s (EnterExitPair gs))
constructCfgDefault (:&:)
Stat
Label
(HFix (Sum MLuaSig :&: Label)
:*: HState LuaCfgState (EnterExitPair MLuaSig))
i
t
instance ConstructCfg MLuaSig LuaCfgState P.FunctionDef where
constructCfg :: (:&:)
FunctionDef
Label
(HFix (Sum MLuaSig :&: Label)
:*: HState LuaCfgState (EnterExitPair MLuaSig))
i
-> HState LuaCfgState (EnterExitPair MLuaSig) i
constructCfg ((:&:)
FunctionDef
Label
(HFix (Sum MLuaSig :&: Label)
:*: HState LuaCfgState (EnterExitPair MLuaSig))
i
-> (:*:)
(HFix (Sum MLuaSig :&: Label))
(FunctionDef (HState LuaCfgState (EnterExitPair MLuaSig)))
i
forall (f :: (* -> *) -> * -> *) (gs :: [(* -> *) -> * -> *]) a
(t :: * -> *).
(HFunctor f, f :-<: gs) =>
(:&:) f a (AnnTerm a gs :*: t) :-> (AnnTerm a gs :*: f t)
collapseFProd' -> (_ :*: subCfgs :: FunctionDef (HState LuaCfgState (EnterExitPair MLuaSig)) i
subCfgs)) = State LuaCfgState (EnterExitPair MLuaSig i)
-> HState LuaCfgState (EnterExitPair MLuaSig) i
forall s (f :: * -> *) l. State s (f l) -> HState s f l
HState (State LuaCfgState (EnterExitPair MLuaSig i)
-> HState LuaCfgState (EnterExitPair MLuaSig) i)
-> State LuaCfgState (EnterExitPair MLuaSig i)
-> HState LuaCfgState (EnterExitPair MLuaSig) i
forall a b. (a -> b) -> a -> b
$ do
StateT LuaCfgState Identity ()
forall (m :: * -> *). MonadState LuaCfgState m => m ()
pushFunLabelMapStack
FunctionDef (HState LuaCfgState (EnterExitPair MLuaSig)) i
-> StateT LuaCfgState Identity (EnterExitPair MLuaSig Any)
forall (f :: (* -> *) -> * -> *) (gs :: [(* -> *) -> * -> *]) s i
j.
(f :-<: gs, HTraversable f, CfgComponent gs s) =>
f (HState s (EnterExitPair gs)) i -> State s (EnterExitPair gs j)
runSubCfgs FunctionDef (HState LuaCfgState (EnterExitPair MLuaSig)) i
subCfgs
StateT LuaCfgState Identity ()
forall (m :: * -> *). MonadState LuaCfgState m => m ()
popLabelMapStack
EnterExitPair MLuaSig i
-> State LuaCfgState (EnterExitPair MLuaSig i)
forall (m :: * -> *) a. Monad m => a -> m a
return EnterExitPair MLuaSig i
forall (fs :: [(* -> *) -> * -> *]) l. EnterExitPair fs l
EmptyEnterExit
instance ConstructCfg MLuaSig LuaCfgState P.Block where
constructCfg :: (:&:)
Block
Label
(HFix (Sum MLuaSig :&: Label)
:*: HState LuaCfgState (EnterExitPair MLuaSig))
i
-> HState LuaCfgState (EnterExitPair MLuaSig) i
constructCfg p :: (:&:)
Block
Label
(HFix (Sum MLuaSig :&: Label)
:*: HState LuaCfgState (EnterExitPair MLuaSig))
i
p@((:&:)
Block
Label
(HFix (Sum MLuaSig :&: Label)
:*: HState LuaCfgState (EnterExitPair MLuaSig))
i
-> (:*:)
(HFix (Sum MLuaSig :&: Label))
(Block (HState LuaCfgState (EnterExitPair MLuaSig)))
i
forall (f :: (* -> *) -> * -> *) (gs :: [(* -> *) -> * -> *]) a
(t :: * -> *).
(HFunctor f, f :-<: gs) =>
(:&:) f a (AnnTerm a gs :*: t) :-> (AnnTerm a gs :*: f t)
collapseFProd' -> (t :: AnnTerm Label MLuaSig i
t :*: _)) = case AnnTerm Label MLuaSig i
-> Maybe (Block (HFix (Sum MLuaSig :&: Label)) i)
forall (f :: (* -> *) -> * -> *) (f' :: (* -> *) -> * -> *)
(s :: (* -> *) -> * -> *) h (a :: * -> *) i.
(RemA f f', s :<: f') =>
Cxt h f a i -> Maybe (s (Cxt h f a) i)
project' AnnTerm Label MLuaSig i
t of
Just (P.Block xs :: Cxt NoHole (Sum MLuaSig :&: Label) (K ()) [BlockItemL]
xs r :: Cxt NoHole (Sum MLuaSig :&: Label) (K ()) BlockEndL
r) -> case (Cxt NoHole (Sum MLuaSig :&: Label) (K ()) [BlockItemL]
-> [Cxt NoHole (Sum MLuaSig :&: Label) (K ()) BlockItemL]
forall (f :: * -> *) (e :: * -> *) l.
ExtractF f e =>
e (f l) -> f (e l)
extractF Cxt NoHole (Sum MLuaSig :&: Label) (K ()) [BlockItemL]
xs, Cxt NoHole (Sum MLuaSig :&: Label) (K ()) BlockEndL
-> Maybe (LuaBlockEnd (HFix (Sum MLuaSig :&: Label)) BlockEndL)
forall (f :: (* -> *) -> * -> *) (f' :: (* -> *) -> * -> *)
(s :: (* -> *) -> * -> *) h (a :: * -> *) i.
(RemA f f', s :<: f') =>
Cxt h f a i -> Maybe (s (Cxt h f a) i)
project' Cxt NoHole (Sum MLuaSig :&: Label) (K ()) BlockEndL
r) of
([], Just (LuaBlockEnd e :: Cxt NoHole (Sum MLuaSig :&: Label) (K ()) (Maybe [ExpL])
e)) -> State LuaCfgState (EnterExitPair MLuaSig i)
-> HState LuaCfgState (EnterExitPair MLuaSig) i
forall s (f :: * -> *) l. State s (f l) -> HState s f l
HState (State LuaCfgState (EnterExitPair MLuaSig i)
-> HState LuaCfgState (EnterExitPair MLuaSig) i)
-> State LuaCfgState (EnterExitPair MLuaSig i)
-> HState LuaCfgState (EnterExitPair MLuaSig) i
forall a b. (a -> b) -> a -> b
$ do
State LuaCfgState (EnterExitPair MLuaSig i)
-> State LuaCfgState (EnterExitPair MLuaSig i)
forall (m :: * -> *) a. MonadState LuaCfgState m => m a -> m a
withBlockLabelMap (HState LuaCfgState (EnterExitPair MLuaSig) i
-> State LuaCfgState (EnterExitPair MLuaSig i)
forall s (f :: * -> *) l. HState s f l -> State s (f l)
unHState (HState LuaCfgState (EnterExitPair MLuaSig) i
-> State LuaCfgState (EnterExitPair MLuaSig i))
-> HState LuaCfgState (EnterExitPair MLuaSig) i
-> State LuaCfgState (EnterExitPair MLuaSig i)
forall a b. (a -> b) -> a -> b
$ (:&:)
Block
Label
(HFix (Sum MLuaSig :&: Label)
:*: HState LuaCfgState (EnterExitPair MLuaSig))
i
-> HState LuaCfgState (EnterExitPair MLuaSig) i
forall (f :: (* -> *) -> * -> *) (gs :: [(* -> *) -> * -> *]) s.
(f :-<: gs, HTraversable f, CfgComponent gs s) =>
PreRAlg
(f :&: Label) (Sum gs :&: Label) (HState s (EnterExitPair gs))
constructCfgGeneric (:&:)
Block
Label
(HFix (Sum MLuaSig :&: Label)
:*: HState LuaCfgState (EnterExitPair MLuaSig))
i
p)
_ -> State LuaCfgState (EnterExitPair MLuaSig i)
-> HState LuaCfgState (EnterExitPair MLuaSig) i
forall s (f :: * -> *) l. State s (f l) -> HState s f l
HState (State LuaCfgState (EnterExitPair MLuaSig i)
-> HState LuaCfgState (EnterExitPair MLuaSig) i)
-> State LuaCfgState (EnterExitPair MLuaSig i)
-> HState LuaCfgState (EnterExitPair MLuaSig) i
forall a b. (a -> b) -> a -> b
$ do
State LuaCfgState (EnterExitPair MLuaSig i)
-> State LuaCfgState (EnterExitPair MLuaSig i)
forall (m :: * -> *) a. MonadState LuaCfgState m => m a -> m a
withBlockLabelMap (HState LuaCfgState (EnterExitPair MLuaSig) i
-> State LuaCfgState (EnterExitPair MLuaSig i)
forall s (f :: * -> *) l. HState s f l -> State s (f l)
unHState (HState LuaCfgState (EnterExitPair MLuaSig) i
-> State LuaCfgState (EnterExitPair MLuaSig i))
-> HState LuaCfgState (EnterExitPair MLuaSig) i
-> State LuaCfgState (EnterExitPair MLuaSig i)
forall a b. (a -> b) -> a -> b
$ (:&:)
Block
Label
(HFix (Sum MLuaSig :&: Label)
:*: HState LuaCfgState (EnterExitPair MLuaSig))
i
-> HState LuaCfgState (EnterExitPair MLuaSig) i
forall (f :: (* -> *) -> * -> *) (gs :: [(* -> *) -> * -> *]) s.
(f :-<: gs, HTraversable f, CfgComponent gs s, SortChecks gs) =>
PreRAlg
(f :&: Label) (Sum gs :&: Label) (HState s (EnterExitPair gs))
constructCfgDefault (:&:)
Block
Label
(HFix (Sum MLuaSig :&: Label)
:*: HState LuaCfgState (EnterExitPair MLuaSig))
i
p)
instance ConstructCfg MLuaSig LuaCfgState Exp where
constructCfg :: (:&:)
Exp
Label
(HFix (Sum MLuaSig :&: Label)
:*: HState LuaCfgState (EnterExitPair MLuaSig))
i
-> HState LuaCfgState (EnterExitPair MLuaSig) i
constructCfg t' :: (:&:)
Exp
Label
(HFix (Sum MLuaSig :&: Label)
:*: HState LuaCfgState (EnterExitPair MLuaSig))
i
t'@((:&:)
Exp
Label
(HFix (Sum MLuaSig :&: Label)
:*: HState LuaCfgState (EnterExitPair MLuaSig))
i
-> Exp
(HFix (Sum MLuaSig :&: Label)
:*: HState LuaCfgState (EnterExitPair MLuaSig))
i
forall (s :: (* -> *) -> * -> *) (s' :: (* -> *) -> * -> *)
(a :: * -> *).
RemA s s' =>
s a :-> s' a
remA -> (Binop (op :: HFix (Sum MLuaSig :&: Label) BinopL
op :*: _) _ _)) = do
let (t :: AnnTerm Label MLuaSig i
t :*: (Binop _ el er)) = (:&:)
Exp
Label
(HFix (Sum MLuaSig :&: Label)
:*: HState LuaCfgState (EnterExitPair MLuaSig))
i
-> (:*:)
(HFix (Sum MLuaSig :&: Label))
(Exp (HState LuaCfgState (EnterExitPair MLuaSig)))
i
forall (f :: (* -> *) -> * -> *) (gs :: [(* -> *) -> * -> *]) a
(t :: * -> *).
(HFunctor f, f :-<: gs) =>
(:&:) f a (AnnTerm a gs :*: t) :-> (AnnTerm a gs :*: f t)
collapseFProd' (:&:)
Exp
Label
(HFix (Sum MLuaSig :&: Label)
:*: HState LuaCfgState (EnterExitPair MLuaSig))
i
t'
case HFix (Sum MLuaSig :&: Label) BinopL
-> Binop (Cxt NoHole (Sum MLuaSig) (K ())) BinopL
extractOp HFix (Sum MLuaSig :&: Label) BinopL
op of
And -> State LuaCfgState (EnterExitPair MLuaSig i)
-> HState LuaCfgState (EnterExitPair MLuaSig) i
forall s (f :: * -> *) l. State s (f l) -> HState s f l
HState (State LuaCfgState (EnterExitPair MLuaSig i)
-> HState LuaCfgState (EnterExitPair MLuaSig) i)
-> State LuaCfgState (EnterExitPair MLuaSig i)
-> HState LuaCfgState (EnterExitPair MLuaSig) i
forall a b. (a -> b) -> a -> b
$ AnnTerm Label MLuaSig i
-> StateT LuaCfgState Identity (EnterExitPair MLuaSig ExpL)
-> StateT LuaCfgState Identity (EnterExitPair MLuaSig ExpL)
-> State LuaCfgState (EnterExitPair MLuaSig i)
forall s (m :: * -> *) (fs :: [(* -> *) -> * -> *]) l ls rs es.
(MonadState s m, CfgComponent fs s) =>
TermLab fs l
-> m (EnterExitPair fs ls)
-> m (EnterExitPair fs rs)
-> m (EnterExitPair fs es)
constructCfgShortCircuitingBinOp AnnTerm Label MLuaSig i
t (HState LuaCfgState (EnterExitPair MLuaSig) ExpL
-> StateT LuaCfgState Identity (EnterExitPair MLuaSig ExpL)
forall s (f :: * -> *) l. HState s f l -> State s (f l)
unHState HState LuaCfgState (EnterExitPair MLuaSig) ExpL
el) (HState LuaCfgState (EnterExitPair MLuaSig) ExpL
-> StateT LuaCfgState Identity (EnterExitPair MLuaSig ExpL)
forall s (f :: * -> *) l. HState s f l -> State s (f l)
unHState HState LuaCfgState (EnterExitPair MLuaSig) ExpL
er)
Or -> State LuaCfgState (EnterExitPair MLuaSig i)
-> HState LuaCfgState (EnterExitPair MLuaSig) i
forall s (f :: * -> *) l. State s (f l) -> HState s f l
HState (State LuaCfgState (EnterExitPair MLuaSig i)
-> HState LuaCfgState (EnterExitPair MLuaSig) i)
-> State LuaCfgState (EnterExitPair MLuaSig i)
-> HState LuaCfgState (EnterExitPair MLuaSig) i
forall a b. (a -> b) -> a -> b
$ AnnTerm Label MLuaSig i
-> StateT LuaCfgState Identity (EnterExitPair MLuaSig ExpL)
-> StateT LuaCfgState Identity (EnterExitPair MLuaSig ExpL)
-> State LuaCfgState (EnterExitPair MLuaSig i)
forall s (m :: * -> *) (fs :: [(* -> *) -> * -> *]) l ls rs es.
(MonadState s m, CfgComponent fs s) =>
TermLab fs l
-> m (EnterExitPair fs ls)
-> m (EnterExitPair fs rs)
-> m (EnterExitPair fs es)
constructCfgShortCircuitingBinOp AnnTerm Label MLuaSig i
t (HState LuaCfgState (EnterExitPair MLuaSig) ExpL
-> StateT LuaCfgState Identity (EnterExitPair MLuaSig ExpL)
forall s (f :: * -> *) l. HState s f l -> State s (f l)
unHState HState LuaCfgState (EnterExitPair MLuaSig) ExpL
el) (HState LuaCfgState (EnterExitPair MLuaSig) ExpL
-> StateT LuaCfgState Identity (EnterExitPair MLuaSig ExpL)
forall s (f :: * -> *) l. HState s f l -> State s (f l)
unHState HState LuaCfgState (EnterExitPair MLuaSig) ExpL
er)
_ -> (:&:)
Exp
Label
(HFix (Sum MLuaSig :&: Label)
:*: HState LuaCfgState (EnterExitPair MLuaSig))
i
-> HState LuaCfgState (EnterExitPair MLuaSig) i
forall (f :: (* -> *) -> * -> *) (gs :: [(* -> *) -> * -> *]) s.
(f :-<: gs, HTraversable f, CfgComponent gs s, SortChecks gs) =>
PreRAlg
(f :&: Label) (Sum gs :&: Label) (HState s (EnterExitPair gs))
constructCfgDefault (:&:)
Exp
Label
(HFix (Sum MLuaSig :&: Label)
:*: HState LuaCfgState (EnterExitPair MLuaSig))
i
t'
where extractOp :: MLuaTermLab BinopL -> Binop MLuaTerm BinopL
extractOp :: HFix (Sum MLuaSig :&: Label) BinopL
-> Binop (Cxt NoHole (Sum MLuaSig) (K ())) BinopL
extractOp (HFix (Sum MLuaSig :&: Label) BinopL
-> Cxt NoHole (Sum MLuaSig) (K ()) BinopL
forall (g :: (* -> *) -> * -> *) (f :: (* -> *) -> * -> *).
(RemA g f, HFunctor g) =>
CxtFun g f
stripA -> Cxt NoHole (Sum MLuaSig) (K ()) BinopL
-> Maybe (Binop (Cxt NoHole (Sum MLuaSig) (K ())) BinopL)
forall (g :: (* -> *) -> * -> *) (f :: (* -> *) -> * -> *) h
(a :: * -> *).
(g :<: f) =>
NatM Maybe (Cxt h f a) (g (Cxt h f a))
project -> Just bp :: Binop (Cxt NoHole (Sum MLuaSig) (K ())) BinopL
bp) = Binop (Cxt NoHole (Sum MLuaSig) (K ())) BinopL
bp
constructCfg ((:&:)
Exp
Label
(HFix (Sum MLuaSig :&: Label)
:*: HState LuaCfgState (EnterExitPair MLuaSig))
i
-> (:*:)
(HFix (Sum MLuaSig :&: Label))
(Exp (HState LuaCfgState (EnterExitPair MLuaSig)))
i
forall (f :: (* -> *) -> * -> *) (gs :: [(* -> *) -> * -> *]) a
(t :: * -> *).
(HFunctor f, f :-<: gs) =>
(:&:) f a (AnnTerm a gs :*: t) :-> (AnnTerm a gs :*: f t)
collapseFProd' -> t :: AnnTerm Label MLuaSig i
t :*: EFunDef body :: HState LuaCfgState (EnterExitPair MLuaSig) FunDefL
body) = State LuaCfgState (EnterExitPair MLuaSig i)
-> HState LuaCfgState (EnterExitPair MLuaSig) i
forall s (f :: * -> *) l. State s (f l) -> HState s f l
HState (State LuaCfgState (EnterExitPair MLuaSig i)
-> HState LuaCfgState (EnterExitPair MLuaSig) i)
-> State LuaCfgState (EnterExitPair MLuaSig i)
-> HState LuaCfgState (EnterExitPair MLuaSig) i
forall a b. (a -> b) -> a -> b
$
HState LuaCfgState (EnterExitPair MLuaSig) FunDefL
-> State LuaCfgState (EnterExitPair MLuaSig FunDefL)
forall s (f :: * -> *) l. HState s f l -> State s (f l)
unHState HState LuaCfgState (EnterExitPair MLuaSig) FunDefL
body State LuaCfgState (EnterExitPair MLuaSig FunDefL)
-> State LuaCfgState (EnterExitPair MLuaSig i)
-> State LuaCfgState (EnterExitPair MLuaSig i)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> AnnTerm Label MLuaSig i
-> State LuaCfgState (EnterExitPair MLuaSig i)
forall s (m :: * -> *) (gs :: [(* -> *) -> * -> *]) l.
(MonadState s m, CfgComponent gs s) =>
TermLab gs l -> m (EnterExitPair gs l)
constructCfgEmpty AnnTerm Label MLuaSig i
t
constructCfg t :: (:&:)
Exp
Label
(HFix (Sum MLuaSig :&: Label)
:*: HState LuaCfgState (EnterExitPair MLuaSig))
i
t = (:&:)
Exp
Label
(HFix (Sum MLuaSig :&: Label)
:*: HState LuaCfgState (EnterExitPair MLuaSig))
i
-> HState LuaCfgState (EnterExitPair MLuaSig) i
forall (f :: (* -> *) -> * -> *) (gs :: [(* -> *) -> * -> *]) s.
(f :-<: gs, HTraversable f, CfgComponent gs s, SortChecks gs) =>
PreRAlg
(f :&: Label) (Sum gs :&: Label) (HState s (EnterExitPair gs))
constructCfgDefault (:&:)
Exp
Label
(HFix (Sum MLuaSig :&: Label)
:*: HState LuaCfgState (EnterExitPair MLuaSig))
i
t
instance CfgInitState MLuaSig where
cfgInitState :: Proxy MLuaSig -> CfgState MLuaSig
cfgInitState _ = Cfg MLuaSig
-> LabelGen -> LoopStack -> LuaLabelMapStack -> LuaCfgState
LuaCfgState Cfg MLuaSig
forall (fs :: [(* -> *) -> * -> *]). Cfg fs
emptyCfg (() -> LabelGen
unsafeMkCSLabelGen ()) LoopStack
emptyLoopStack LuaLabelMapStack
emptyLabelMapStack