{-# 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

-----------------------------------------------------------------------------------
---------------           Labelling mechanism              ------------------------
-----------------------------------------------------------------------------------


-- For Lua - quoting ref:
-- A label is visible in the entire block where it is defined, except inside nested blocks where a label with the same name is defined and inside nested functions. A goto may jump to any visible label as long as it does not enter into the scope of a local variable.

-- So we push a new stack of label map or Fun marker whenever we enter a new block or a function respectively


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 []

-- NOTE: Merges the top of the stack with the subsequent
--       element in the stack, adding in the unresolved labels in the top
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)

-- Unsafe constructs
-- Taken from Data-List-Lens
_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 #-}


-----------------------------------------------------------------------------------
---------------           CfgConstruction Instances        ------------------------
-----------------------------------------------------------------------------------


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)]
extractClauses :: HState s (EnterExitPair fs) [(a, b)]
-> State s [(EnterExitPair fs a, EnterExitPair fs b)]
extractClauses 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

-- Lua's for loop is weird
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' -- either the exit of final or step (b/c step is optional)


  (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) -- there isn't really a separate node for the comparison

  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)

  -- We can get away with using the While cfg-generator for for-each's.
  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) -- FIXME: Doesn't properly handle returns, but I think the TACer won't notice
      _  -> 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