{-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE ViewPatterns #-}

module Cubix.Language.JavaScript.Parametric.Common.Cfg () where

#ifndef ONLY_ONE_LANGUAGE
import Control.Monad ( liftM, liftM2, forM_ )

import Control.Lens (  makeLenses, (%=), (^.), use )

import qualified Data.Map as Map

import Data.Comp.Multi ( remA, stripA, project )
import Data.Comp.Multi.Ops ( (:*:)(..), fsnd )
import Data.Foldable

import Cubix.Language.Info

import Cubix.Language.JavaScript.Parametric.Common.Types as C
import Cubix.Language.JavaScript.Parametric.Full.Types as F
import Cubix.Language.Parametric.Semantics.Cfg
import Cubix.Language.Parametric.Syntax as P

data JSCfgState = JSCfgState {
                   JSCfgState -> Cfg MJSSig
_jcs_cfg         :: Cfg MJSSig
                 , JSCfgState -> LabelGen
_jcs_labeler     :: LabelGen
                 , JSCfgState -> LoopStack
_jcs_stack       :: LoopStack
                 , JSCfgState -> ScopedLabelMap
_jcs_scoped_labs :: ScopedLabelMap
                 }

makeLenses ''JSCfgState

instance HasCurCfg JSCfgState MJSSig where cur_cfg :: (Cfg MJSSig -> f (Cfg MJSSig)) -> JSCfgState -> f JSCfgState
cur_cfg = (Cfg MJSSig -> f (Cfg MJSSig)) -> JSCfgState -> f JSCfgState
Lens' JSCfgState (Cfg MJSSig)
jcs_cfg
instance HasLabelGen JSCfgState where labelGen :: (LabelGen -> f LabelGen) -> JSCfgState -> f JSCfgState
labelGen = (LabelGen -> f LabelGen) -> JSCfgState -> f JSCfgState
Lens' JSCfgState LabelGen
jcs_labeler
instance HasLoopStack JSCfgState where loopStack :: (LoopStack -> f LoopStack) -> JSCfgState -> f JSCfgState
loopStack = (LoopStack -> f LoopStack) -> JSCfgState -> f JSCfgState
Lens' JSCfgState LoopStack
jcs_stack
instance HasScopedLabelMap JSCfgState where scopedLabelMap :: (ScopedLabelMap -> f ScopedLabelMap) -> JSCfgState -> f JSCfgState
scopedLabelMap = (ScopedLabelMap -> f ScopedLabelMap) -> JSCfgState -> f JSCfgState
Lens' JSCfgState ScopedLabelMap
jcs_scoped_labs

type instance ComputationSorts MJSSig = '[JSStatementL, JSExpressionL, [BlockItemL], [JSStatementL]]
type instance SuspendedComputationSorts MJSSig = '[FunctionDefL]
type instance ContainerFunctors MJSSig = '[ListF, MaybeF]
type instance CfgState MJSSig = JSCfgState

singleton :: a -> [a]
singleton :: a -> [a]
singleton = a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return


instance ConstructCfg MJSSig JSCfgState JSStatement where
  constructCfg :: (:&:)
  JSStatement
  Label
  (HFix (Sum MJSSig :&: Label)
   :*: HState JSCfgState (EnterExitPair MJSSig))
  i
-> HState JSCfgState (EnterExitPair MJSSig) i
constructCfg p :: (:&:)
  JSStatement
  Label
  (HFix (Sum MJSSig :&: Label)
   :*: HState JSCfgState (EnterExitPair MJSSig))
  i
p@((:&:)
  JSStatement
  Label
  (HFix (Sum MJSSig :&: Label)
   :*: HState JSCfgState (EnterExitPair MJSSig))
  i
-> JSStatement
     (HFix (Sum MJSSig :&: Label)
      :*: HState JSCfgState (EnterExitPair MJSSig))
     i
forall (s :: (* -> *) -> * -> *) (s' :: (* -> *) -> * -> *)
       (a :: * -> *).
RemA s s' =>
s a :-> s' a
remA -> JSStatementBlock _ (body :: HFix (Sum MJSSig :&: Label) [JSStatementL]
body :*: _) _ _) =
       case HFix (Sum MJSSig :&: Label) [JSStatementL]
-> [HFix (Sum MJSSig :&: Label) JSStatementL]
forall (f :: * -> *) (e :: * -> *) l.
ExtractF f e =>
e (f l) -> f (e l)
extractF HFix (Sum MJSSig :&: Label) [JSStatementL]
body of
           [] -> (:&:)
  JSStatement
  Label
  (HFix (Sum MJSSig :&: Label)
   :*: HState JSCfgState (EnterExitPair MJSSig))
  i
-> HState JSCfgState (EnterExitPair MJSSig) i
forall (f :: (* -> *) -> * -> *) (gs :: [(* -> *) -> * -> *]) s.
(f :-<: gs, HTraversable f, CfgComponent gs s) =>
PreRAlg
  (f :&: Label) (Sum gs :&: Label) (HState s (EnterExitPair gs))
constructCfgGeneric (:&:)
  JSStatement
  Label
  (HFix (Sum MJSSig :&: Label)
   :*: HState JSCfgState (EnterExitPair MJSSig))
  i
p
           _  -> State JSCfgState (EnterExitPair MJSSig i)
-> HState JSCfgState (EnterExitPair MJSSig) i
forall s (f :: * -> *) l. State s (f l) -> HState s f l
HState (State JSCfgState (EnterExitPair MJSSig i)
 -> HState JSCfgState (EnterExitPair MJSSig) i)
-> State JSCfgState (EnterExitPair MJSSig i)
-> HState JSCfgState (EnterExitPair MJSSig) i
forall a b. (a -> b) -> a -> b
$ JSStatement (HState JSCfgState (EnterExitPair MJSSig)) i
-> State JSCfgState (EnterExitPair MJSSig i)
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 (JSStatement (HState JSCfgState (EnterExitPair MJSSig)) i
 -> State JSCfgState (EnterExitPair MJSSig i))
-> JSStatement (HState JSCfgState (EnterExitPair MJSSig)) i
-> State JSCfgState (EnterExitPair MJSSig i)
forall a b. (a -> b) -> a -> b
$ (:*:)
  (HFix (Sum MJSSig :&: Label))
  (JSStatement (HState JSCfgState (EnterExitPair MJSSig)))
  i
-> JSStatement (HState JSCfgState (EnterExitPair MJSSig)) i
forall k (f :: k -> *) (g :: k -> *) (a :: k). (:*:) f g a -> g a
fsnd ((:*:)
   (HFix (Sum MJSSig :&: Label))
   (JSStatement (HState JSCfgState (EnterExitPair MJSSig)))
   i
 -> JSStatement (HState JSCfgState (EnterExitPair MJSSig)) i)
-> (:*:)
     (HFix (Sum MJSSig :&: Label))
     (JSStatement (HState JSCfgState (EnterExitPair MJSSig)))
     i
-> JSStatement (HState JSCfgState (EnterExitPair MJSSig)) i
forall a b. (a -> b) -> a -> b
$ (:&:)
  JSStatement
  Label
  (HFix (Sum MJSSig :&: Label)
   :*: HState JSCfgState (EnterExitPair MJSSig))
  i
-> (:*:)
     (HFix (Sum MJSSig :&: Label))
     (JSStatement (HState JSCfgState (EnterExitPair MJSSig)))
     i
forall (f :: (* -> *) -> * -> *) (gs :: [(* -> *) -> * -> *]) a
       (t :: * -> *).
(HFunctor f, f :-<: gs) =>
(:&:) f a (AnnTerm a gs :*: t) :-> (AnnTerm a gs :*: f t)
collapseFProd' (:&:)
  JSStatement
  Label
  (HFix (Sum MJSSig :&: Label)
   :*: HState JSCfgState (EnterExitPair MJSSig))
  i
p



  constructCfg (t :: (:&:)
  JSStatement
  Label
  (HFix (Sum MJSSig :&: Label)
   :*: HState JSCfgState (EnterExitPair MJSSig))
  i
t@((:&:)
  JSStatement
  Label
  (HFix (Sum MJSSig :&: Label)
   :*: HState JSCfgState (EnterExitPair MJSSig))
  i
-> JSStatement
     (HFix (Sum MJSSig :&: Label)
      :*: HState JSCfgState (EnterExitPair MJSSig))
     i
forall (s :: (* -> *) -> * -> *) (s' :: (* -> *) -> * -> *)
       (a :: * -> *).
RemA s s' =>
s a :-> s' a
remA -> JSBreak _ ((HFix (Sum MJSSig :&: Label) JSIdentL
-> Cxt NoHole (Sum MJSSig) (K ()) JSIdentL
forall (g :: (* -> *) -> * -> *) (f :: (* -> *) -> * -> *).
(RemA g f, HFunctor g) =>
CxtFun g f
stripA -> JSIdent' targ :: String
targ) :*: _) _))    = State JSCfgState (EnterExitPair MJSSig i)
-> HState JSCfgState (EnterExitPair MJSSig) i
forall s (f :: * -> *) l. State s (f l) -> HState s f l
HState (State JSCfgState (EnterExitPair MJSSig i)
 -> HState JSCfgState (EnterExitPair MJSSig) i)
-> State JSCfgState (EnterExitPair MJSSig i)
-> HState JSCfgState (EnterExitPair MJSSig) i
forall a b. (a -> b) -> a -> b
$
    TermLab MJSSig i
-> String -> State JSCfgState (EnterExitPair MJSSig i)
forall s (m :: * -> *) (gs :: [(* -> *) -> * -> *]) l i.
(HasScopedLabelMap s, MonadState s m, CfgComponent gs s) =>
TermLab gs l -> String -> m (EnterExitPair gs i)
constructCfgScopedLabeledBreak ((:&:)
  JSStatement
  Label
  (HFix (Sum MJSSig :&: Label)
   :*: HState JSCfgState (EnterExitPair MJSSig))
  i
-> TermLab MJSSig i
forall (f :: (* -> *) -> * -> *) (gs :: [(* -> *) -> * -> *]) a
       (t :: * -> *).
(HFunctor f, f :-<: gs) =>
(:&:) f a (AnnTerm a gs :*: t) :-> AnnTerm a gs
fprodFst' (:&:)
  JSStatement
  Label
  (HFix (Sum MJSSig :&: Label)
   :*: HState JSCfgState (EnterExitPair MJSSig))
  i
t) String
targ
  constructCfg (t :: (:&:)
  JSStatement
  Label
  (HFix (Sum MJSSig :&: Label)
   :*: HState JSCfgState (EnterExitPair MJSSig))
  i
t@((:&:)
  JSStatement
  Label
  (HFix (Sum MJSSig :&: Label)
   :*: HState JSCfgState (EnterExitPair MJSSig))
  i
-> JSStatement
     (HFix (Sum MJSSig :&: Label)
      :*: HState JSCfgState (EnterExitPair MJSSig))
     i
forall (s :: (* -> *) -> * -> *) (s' :: (* -> *) -> * -> *)
       (a :: * -> *).
RemA s s' =>
s a :-> s' a
remA -> JSContinue _ ((HFix (Sum MJSSig :&: Label) JSIdentL
-> Cxt NoHole (Sum MJSSig) (K ()) JSIdentL
forall (g :: (* -> *) -> * -> *) (f :: (* -> *) -> * -> *).
(RemA g f, HFunctor g) =>
CxtFun g f
stripA -> JSIdent' targ :: String
targ) :*: _) _)) = State JSCfgState (EnterExitPair MJSSig i)
-> HState JSCfgState (EnterExitPair MJSSig) i
forall s (f :: * -> *) l. State s (f l) -> HState s f l
HState (State JSCfgState (EnterExitPair MJSSig i)
 -> HState JSCfgState (EnterExitPair MJSSig) i)
-> State JSCfgState (EnterExitPair MJSSig i)
-> HState JSCfgState (EnterExitPair MJSSig) i
forall a b. (a -> b) -> a -> b
$
    TermLab MJSSig i
-> String -> State JSCfgState (EnterExitPair MJSSig i)
forall s (m :: * -> *) (gs :: [(* -> *) -> * -> *]) l i.
(HasScopedLabelMap s, MonadState s m, CfgComponent gs s) =>
TermLab gs l -> String -> m (EnterExitPair gs i)
constructCfgScopedLabeledContinue ((:&:)
  JSStatement
  Label
  (HFix (Sum MJSSig :&: Label)
   :*: HState JSCfgState (EnterExitPair MJSSig))
  i
-> TermLab MJSSig i
forall (f :: (* -> *) -> * -> *) (gs :: [(* -> *) -> * -> *]) a
       (t :: * -> *).
(HFunctor f, f :-<: gs) =>
(:&:) f a (AnnTerm a gs :*: t) :-> AnnTerm a gs
fprodFst' (:&:)
  JSStatement
  Label
  (HFix (Sum MJSSig :&: Label)
   :*: HState JSCfgState (EnterExitPair MJSSig))
  i
t) String
targ

  constructCfg ((:&:)
  JSStatement
  Label
  (HFix (Sum MJSSig :&: Label)
   :*: HState JSCfgState (EnterExitPair MJSSig))
  i
-> (:*:)
     (HFix (Sum MJSSig :&: Label))
     (JSStatement (HState JSCfgState (EnterExitPair MJSSig)))
     i
forall (f :: (* -> *) -> * -> *) (gs :: [(* -> *) -> * -> *]) a
       (t :: * -> *).
(HFunctor f, f :-<: gs) =>
(:&:) f a (AnnTerm a gs :*: t) :-> (AnnTerm a gs :*: f t)
collapseFProd' -> (t :: TermLab MJSSig i
t :*: (JSBreak _ _ _))) = State JSCfgState (EnterExitPair MJSSig i)
-> HState JSCfgState (EnterExitPair MJSSig) i
forall s (f :: * -> *) l. State s (f l) -> HState s f l
HState (State JSCfgState (EnterExitPair MJSSig i)
 -> HState JSCfgState (EnterExitPair MJSSig) i)
-> State JSCfgState (EnterExitPair MJSSig i)
-> HState JSCfgState (EnterExitPair MJSSig) i
forall a b. (a -> b) -> a -> b
$ TermLab MJSSig i -> State JSCfgState (EnterExitPair MJSSig i)
forall s (m :: * -> *) (gs :: [(* -> *) -> * -> *]) l i.
(HasLoopStack s, MonadState s m, CfgComponent gs s) =>
TermLab gs l -> m (EnterExitPair gs i)
constructCfgBreak TermLab MJSSig i
t
  constructCfg ((:&:)
  JSStatement
  Label
  (HFix (Sum MJSSig :&: Label)
   :*: HState JSCfgState (EnterExitPair MJSSig))
  i
-> (:*:)
     (HFix (Sum MJSSig :&: Label))
     (JSStatement (HState JSCfgState (EnterExitPair MJSSig)))
     i
forall (f :: (* -> *) -> * -> *) (gs :: [(* -> *) -> * -> *]) a
       (t :: * -> *).
(HFunctor f, f :-<: gs) =>
(:&:) f a (AnnTerm a gs :*: t) :-> (AnnTerm a gs :*: f t)
collapseFProd' -> (t :: TermLab MJSSig i
t :*: (JSContinue _ _ _))) = State JSCfgState (EnterExitPair MJSSig i)
-> HState JSCfgState (EnterExitPair MJSSig) i
forall s (f :: * -> *) l. State s (f l) -> HState s f l
HState (State JSCfgState (EnterExitPair MJSSig i)
 -> HState JSCfgState (EnterExitPair MJSSig) i)
-> State JSCfgState (EnterExitPair MJSSig i)
-> HState JSCfgState (EnterExitPair MJSSig) i
forall a b. (a -> b) -> a -> b
$ TermLab MJSSig i -> State JSCfgState (EnterExitPair MJSSig i)
forall s (m :: * -> *) (gs :: [(* -> *) -> * -> *]) l i.
(HasLoopStack s, MonadState s m, CfgComponent gs s) =>
TermLab gs l -> m (EnterExitPair gs i)
constructCfgContinue TermLab MJSSig i
t

  constructCfg ((:&:)
  JSStatement
  Label
  (HFix (Sum MJSSig :&: Label)
   :*: HState JSCfgState (EnterExitPair MJSSig))
  i
-> (:*:)
     (HFix (Sum MJSSig :&: Label))
     (JSStatement (HState JSCfgState (EnterExitPair MJSSig)))
     i
forall (f :: (* -> *) -> * -> *) (gs :: [(* -> *) -> * -> *]) a
       (t :: * -> *).
(HFunctor f, f :-<: gs) =>
(:&:) f a (AnnTerm a gs :*: t) :-> (AnnTerm a gs :*: f t)
collapseFProd' -> (t :: TermLab MJSSig i
t :*: (JSDoWhile _ body :: HState JSCfgState (EnterExitPair MJSSig) JSStatementL
body _ _ cond :: HState JSCfgState (EnterExitPair MJSSig) JSExpressionL
cond _ _))) = State JSCfgState (EnterExitPair MJSSig i)
-> HState JSCfgState (EnterExitPair MJSSig) i
forall s (f :: * -> *) l. State s (f l) -> HState s f l
HState (State JSCfgState (EnterExitPair MJSSig i)
 -> HState JSCfgState (EnterExitPair MJSSig) i)
-> State JSCfgState (EnterExitPair MJSSig i)
-> HState JSCfgState (EnterExitPair MJSSig) i
forall a b. (a -> b) -> a -> b
$ TermLab MJSSig i
-> StateT JSCfgState Identity (EnterExitPair MJSSig JSExpressionL)
-> StateT JSCfgState Identity (EnterExitPair MJSSig JSStatementL)
-> State JSCfgState (EnterExitPair MJSSig 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 TermLab MJSSig i
t (HState JSCfgState (EnterExitPair MJSSig) JSExpressionL
-> StateT JSCfgState Identity (EnterExitPair MJSSig JSExpressionL)
forall s (f :: * -> *) l. HState s f l -> State s (f l)
unHState HState JSCfgState (EnterExitPair MJSSig) JSExpressionL
cond) (HState JSCfgState (EnterExitPair MJSSig) JSStatementL
-> StateT JSCfgState Identity (EnterExitPair MJSSig JSStatementL)
forall s (f :: * -> *) l. HState s f l -> State s (f l)
unHState HState JSCfgState (EnterExitPair MJSSig) JSStatementL
body)
  constructCfg ((:&:)
  JSStatement
  Label
  (HFix (Sum MJSSig :&: Label)
   :*: HState JSCfgState (EnterExitPair MJSSig))
  i
-> (:*:)
     (HFix (Sum MJSSig :&: Label))
     (JSStatement (HState JSCfgState (EnterExitPair MJSSig)))
     i
forall (f :: (* -> *) -> * -> *) (gs :: [(* -> *) -> * -> *]) a
       (t :: * -> *).
(HFunctor f, f :-<: gs) =>
(:&:) f a (AnnTerm a gs :*: t) :-> (AnnTerm a gs :*: f t)
collapseFProd' -> (t :: TermLab MJSSig i
t :*: (JSIf _ _ cond :: HState JSCfgState (EnterExitPair MJSSig) JSExpressionL
cond _ thn :: HState JSCfgState (EnterExitPair MJSSig) JSStatementL
thn))) = State JSCfgState (EnterExitPair MJSSig i)
-> HState JSCfgState (EnterExitPair MJSSig) i
forall s (f :: * -> *) l. State s (f l) -> HState s f l
HState (State JSCfgState (EnterExitPair MJSSig i)
 -> HState JSCfgState (EnterExitPair MJSSig) i)
-> State JSCfgState (EnterExitPair MJSSig i)
-> HState JSCfgState (EnterExitPair MJSSig) i
forall a b. (a -> b) -> a -> b
$ TermLab MJSSig i
-> StateT
     JSCfgState
     Identity
     [(EnterExitPair MJSSig JSExpressionL,
       EnterExitPair MJSSig JSStatementL)]
-> StateT JSCfgState Identity (Maybe (EnterExitPair MJSSig Any))
-> State JSCfgState (EnterExitPair MJSSig 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 TermLab MJSSig i
t (((EnterExitPair MJSSig JSExpressionL,
  EnterExitPair MJSSig JSStatementL)
 -> [(EnterExitPair MJSSig JSExpressionL,
      EnterExitPair MJSSig JSStatementL)])
-> StateT
     JSCfgState
     Identity
     (EnterExitPair MJSSig JSExpressionL,
      EnterExitPair MJSSig JSStatementL)
-> StateT
     JSCfgState
     Identity
     [(EnterExitPair MJSSig JSExpressionL,
       EnterExitPair MJSSig JSStatementL)]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (EnterExitPair MJSSig JSExpressionL,
 EnterExitPair MJSSig JSStatementL)
-> [(EnterExitPair MJSSig JSExpressionL,
     EnterExitPair MJSSig JSStatementL)]
forall a. a -> [a]
singleton (StateT
   JSCfgState
   Identity
   (EnterExitPair MJSSig JSExpressionL,
    EnterExitPair MJSSig JSStatementL)
 -> StateT
      JSCfgState
      Identity
      [(EnterExitPair MJSSig JSExpressionL,
        EnterExitPair MJSSig JSStatementL)])
-> StateT
     JSCfgState
     Identity
     (EnterExitPair MJSSig JSExpressionL,
      EnterExitPair MJSSig JSStatementL)
-> StateT
     JSCfgState
     Identity
     [(EnterExitPair MJSSig JSExpressionL,
       EnterExitPair MJSSig JSStatementL)]
forall a b. (a -> b) -> a -> b
$ (EnterExitPair MJSSig JSExpressionL
 -> EnterExitPair MJSSig JSStatementL
 -> (EnterExitPair MJSSig JSExpressionL,
     EnterExitPair MJSSig JSStatementL))
-> StateT JSCfgState Identity (EnterExitPair MJSSig JSExpressionL)
-> StateT JSCfgState Identity (EnterExitPair MJSSig JSStatementL)
-> StateT
     JSCfgState
     Identity
     (EnterExitPair MJSSig JSExpressionL,
      EnterExitPair MJSSig JSStatementL)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) (HState JSCfgState (EnterExitPair MJSSig) JSExpressionL
-> StateT JSCfgState Identity (EnterExitPair MJSSig JSExpressionL)
forall s (f :: * -> *) l. HState s f l -> State s (f l)
unHState HState JSCfgState (EnterExitPair MJSSig) JSExpressionL
cond) (HState JSCfgState (EnterExitPair MJSSig) JSStatementL
-> StateT JSCfgState Identity (EnterExitPair MJSSig JSStatementL)
forall s (f :: * -> *) l. HState s f l -> State s (f l)
unHState HState JSCfgState (EnterExitPair MJSSig) JSStatementL
thn)) (Maybe (EnterExitPair MJSSig Any)
-> StateT JSCfgState Identity (Maybe (EnterExitPair MJSSig Any))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (EnterExitPair MJSSig Any)
forall a. Maybe a
Nothing)
  constructCfg ((:&:)
  JSStatement
  Label
  (HFix (Sum MJSSig :&: Label)
   :*: HState JSCfgState (EnterExitPair MJSSig))
  i
-> (:*:)
     (HFix (Sum MJSSig :&: Label))
     (JSStatement (HState JSCfgState (EnterExitPair MJSSig)))
     i
forall (f :: (* -> *) -> * -> *) (gs :: [(* -> *) -> * -> *]) a
       (t :: * -> *).
(HFunctor f, f :-<: gs) =>
(:&:) f a (AnnTerm a gs :*: t) :-> (AnnTerm a gs :*: f t)
collapseFProd' -> (t :: TermLab MJSSig i
t :*: (JSIfElse _ _ cond :: HState JSCfgState (EnterExitPair MJSSig) JSExpressionL
cond _ thn :: HState JSCfgState (EnterExitPair MJSSig) JSStatementL
thn _ els :: HState JSCfgState (EnterExitPair MJSSig) JSStatementL
els))) = State JSCfgState (EnterExitPair MJSSig i)
-> HState JSCfgState (EnterExitPair MJSSig) i
forall s (f :: * -> *) l. State s (f l) -> HState s f l
HState (State JSCfgState (EnterExitPair MJSSig i)
 -> HState JSCfgState (EnterExitPair MJSSig) i)
-> State JSCfgState (EnterExitPair MJSSig i)
-> HState JSCfgState (EnterExitPair MJSSig) i
forall a b. (a -> b) -> a -> b
$ TermLab MJSSig i
-> StateT
     JSCfgState
     Identity
     [(EnterExitPair MJSSig JSExpressionL,
       EnterExitPair MJSSig JSStatementL)]
-> StateT
     JSCfgState Identity (Maybe (EnterExitPair MJSSig JSStatementL))
-> State JSCfgState (EnterExitPair MJSSig 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 TermLab MJSSig i
t (((EnterExitPair MJSSig JSExpressionL,
  EnterExitPair MJSSig JSStatementL)
 -> [(EnterExitPair MJSSig JSExpressionL,
      EnterExitPair MJSSig JSStatementL)])
-> StateT
     JSCfgState
     Identity
     (EnterExitPair MJSSig JSExpressionL,
      EnterExitPair MJSSig JSStatementL)
-> StateT
     JSCfgState
     Identity
     [(EnterExitPair MJSSig JSExpressionL,
       EnterExitPair MJSSig JSStatementL)]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (EnterExitPair MJSSig JSExpressionL,
 EnterExitPair MJSSig JSStatementL)
-> [(EnterExitPair MJSSig JSExpressionL,
     EnterExitPair MJSSig JSStatementL)]
forall a. a -> [a]
singleton (StateT
   JSCfgState
   Identity
   (EnterExitPair MJSSig JSExpressionL,
    EnterExitPair MJSSig JSStatementL)
 -> StateT
      JSCfgState
      Identity
      [(EnterExitPair MJSSig JSExpressionL,
        EnterExitPair MJSSig JSStatementL)])
-> StateT
     JSCfgState
     Identity
     (EnterExitPair MJSSig JSExpressionL,
      EnterExitPair MJSSig JSStatementL)
-> StateT
     JSCfgState
     Identity
     [(EnterExitPair MJSSig JSExpressionL,
       EnterExitPair MJSSig JSStatementL)]
forall a b. (a -> b) -> a -> b
$ (EnterExitPair MJSSig JSExpressionL
 -> EnterExitPair MJSSig JSStatementL
 -> (EnterExitPair MJSSig JSExpressionL,
     EnterExitPair MJSSig JSStatementL))
-> StateT JSCfgState Identity (EnterExitPair MJSSig JSExpressionL)
-> StateT JSCfgState Identity (EnterExitPair MJSSig JSStatementL)
-> StateT
     JSCfgState
     Identity
     (EnterExitPair MJSSig JSExpressionL,
      EnterExitPair MJSSig JSStatementL)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) (HState JSCfgState (EnterExitPair MJSSig) JSExpressionL
-> StateT JSCfgState Identity (EnterExitPair MJSSig JSExpressionL)
forall s (f :: * -> *) l. HState s f l -> State s (f l)
unHState HState JSCfgState (EnterExitPair MJSSig) JSExpressionL
cond) (HState JSCfgState (EnterExitPair MJSSig) JSStatementL
-> StateT JSCfgState Identity (EnterExitPair MJSSig JSStatementL)
forall s (f :: * -> *) l. HState s f l -> State s (f l)
unHState HState JSCfgState (EnterExitPair MJSSig) JSStatementL
thn)) ((EnterExitPair MJSSig JSStatementL
 -> Maybe (EnterExitPair MJSSig JSStatementL))
-> StateT JSCfgState Identity (EnterExitPair MJSSig JSStatementL)
-> StateT
     JSCfgState Identity (Maybe (EnterExitPair MJSSig JSStatementL))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM EnterExitPair MJSSig JSStatementL
-> Maybe (EnterExitPair MJSSig JSStatementL)
forall a. a -> Maybe a
Just (StateT JSCfgState Identity (EnterExitPair MJSSig JSStatementL)
 -> StateT
      JSCfgState Identity (Maybe (EnterExitPair MJSSig JSStatementL)))
-> StateT JSCfgState Identity (EnterExitPair MJSSig JSStatementL)
-> StateT
     JSCfgState Identity (Maybe (EnterExitPair MJSSig JSStatementL))
forall a b. (a -> b) -> a -> b
$ HState JSCfgState (EnterExitPair MJSSig) JSStatementL
-> StateT JSCfgState Identity (EnterExitPair MJSSig JSStatementL)
forall s (f :: * -> *) l. HState s f l -> State s (f l)
unHState HState JSCfgState (EnterExitPair MJSSig) JSStatementL
els)

  constructCfg tp :: (:&:)
  JSStatement
  Label
  (HFix (Sum MJSSig :&: Label)
   :*: HState JSCfgState (EnterExitPair MJSSig))
  i
tp@((:&:)
  JSStatement
  Label
  (HFix (Sum MJSSig :&: Label)
   :*: HState JSCfgState (EnterExitPair MJSSig))
  i
-> JSStatement
     (HFix (Sum MJSSig :&: Label)
      :*: HState JSCfgState (EnterExitPair MJSSig))
     i
forall (s :: (* -> *) -> * -> *) (s' :: (* -> *) -> * -> *)
       (a :: * -> *).
RemA s s' =>
s a :-> s' a
remA -> JSLabelled ((HFix (Sum MJSSig :&: Label) JSIdentL
-> Cxt NoHole (Sum MJSSig) (K ()) JSIdentL
forall (g :: (* -> *) -> * -> *) (f :: (* -> *) -> * -> *).
(RemA g f, HFunctor g) =>
CxtFun g f
stripA -> JSIdent' nam :: String
nam) :*: _) _ (s :: HFix (Sum MJSSig :&: Label) JSStatementL
s :*: mStmt :: HState JSCfgState (EnterExitPair MJSSig) JSStatementL
mStmt)) = State JSCfgState (EnterExitPair MJSSig i)
-> HState JSCfgState (EnterExitPair MJSSig) i
forall s (f :: * -> *) l. State s (f l) -> HState s f l
HState (State JSCfgState (EnterExitPair MJSSig i)
 -> HState JSCfgState (EnterExitPair MJSSig) i)
-> State JSCfgState (EnterExitPair MJSSig i)
-> HState JSCfgState (EnterExitPair MJSSig) i
forall a b. (a -> b) -> a -> b
$ TermLab MJSSig i
-> String
-> HFix (Sum MJSSig :&: Label) JSStatementL
-> StateT JSCfgState Identity (EnterExitPair MJSSig JSStatementL)
-> State JSCfgState (EnterExitPair MJSSig i)
forall s (m :: * -> *) (fs :: [(* -> *) -> * -> *]) l s0 i.
(HasScopedLabelMap s, MonadState s m, CfgComponent fs s) =>
TermLab fs l
-> String
-> TermLab fs s0
-> m (EnterExitPair fs s0)
-> m (EnterExitPair fs i)
constructCfgScopedLabel ((:&:)
  JSStatement
  Label
  (HFix (Sum MJSSig :&: Label)
   :*: HState JSCfgState (EnterExitPair MJSSig))
  i
-> TermLab MJSSig i
forall (f :: (* -> *) -> * -> *) (gs :: [(* -> *) -> * -> *]) a
       (t :: * -> *).
(HFunctor f, f :-<: gs) =>
(:&:) f a (AnnTerm a gs :*: t) :-> AnnTerm a gs
fprodFst' (:&:)
  JSStatement
  Label
  (HFix (Sum MJSSig :&: Label)
   :*: HState JSCfgState (EnterExitPair MJSSig))
  i
tp) String
nam HFix (Sum MJSSig :&: Label) JSStatementL
s (HState JSCfgState (EnterExitPair MJSSig) JSStatementL
-> StateT JSCfgState Identity (EnterExitPair MJSSig JSStatementL)
forall s (f :: * -> *) l. HState s f l -> State s (f l)
unHState HState JSCfgState (EnterExitPair MJSSig) JSStatementL
mStmt)

  constructCfg ((:&:)
  JSStatement
  Label
  (HFix (Sum MJSSig :&: Label)
   :*: HState JSCfgState (EnterExitPair MJSSig))
  i
-> (:*:)
     (HFix (Sum MJSSig :&: Label))
     (JSStatement (HState JSCfgState (EnterExitPair MJSSig)))
     i
forall (f :: (* -> *) -> * -> *) (gs :: [(* -> *) -> * -> *]) a
       (t :: * -> *).
(HFunctor f, f :-<: gs) =>
(:&:) f a (AnnTerm a gs :*: t) :-> (AnnTerm a gs :*: f t)
collapseFProd' -> (t :: TermLab MJSSig i
t :*: JSReturn _ e :: HState JSCfgState (EnterExitPair MJSSig) (Maybe JSExpressionL)
e _)) = State JSCfgState (EnterExitPair MJSSig i)
-> HState JSCfgState (EnterExitPair MJSSig) i
forall s (f :: * -> *) l. State s (f l) -> HState s f l
HState (State JSCfgState (EnterExitPair MJSSig i)
 -> HState JSCfgState (EnterExitPair MJSSig) i)
-> State JSCfgState (EnterExitPair MJSSig i)
-> HState JSCfgState (EnterExitPair MJSSig) i
forall a b. (a -> b) -> a -> b
$ TermLab MJSSig i
-> StateT
     JSCfgState Identity (Maybe (EnterExitPair MJSSig JSExpressionL))
-> State JSCfgState (EnterExitPair MJSSig i)
forall s (m :: * -> *) (gs :: [(* -> *) -> * -> *]) l i.
(MonadState s m, CfgComponent gs s) =>
TermLab gs l
-> m (Maybe (EnterExitPair gs i)) -> m (EnterExitPair gs l)
constructCfgReturn TermLab MJSSig i
t (StateT
  JSCfgState Identity (EnterExitPair MJSSig (Maybe JSExpressionL))
-> StateT
     JSCfgState Identity (Maybe (EnterExitPair MJSSig JSExpressionL))
forall (fs :: [(* -> *) -> * -> *]) (m :: * -> *) l.
(All (KExtractF' Maybe) fs, Monad m) =>
m (EnterExitPair fs (Maybe l)) -> m (Maybe (EnterExitPair fs l))
extractEEPMaybe (StateT
   JSCfgState Identity (EnterExitPair MJSSig (Maybe JSExpressionL))
 -> StateT
      JSCfgState Identity (Maybe (EnterExitPair MJSSig JSExpressionL)))
-> StateT
     JSCfgState Identity (EnterExitPair MJSSig (Maybe JSExpressionL))
-> StateT
     JSCfgState Identity (Maybe (EnterExitPair MJSSig JSExpressionL))
forall a b. (a -> b) -> a -> b
$ HState JSCfgState (EnterExitPair MJSSig) (Maybe JSExpressionL)
-> StateT
     JSCfgState Identity (EnterExitPair MJSSig (Maybe JSExpressionL))
forall s (f :: * -> *) l. HState s f l -> State s (f l)
unHState HState JSCfgState (EnterExitPair MJSSig) (Maybe JSExpressionL)
e)

  -- Consciously skipping switch's

  constructCfg ((:&:)
  JSStatement
  Label
  (HFix (Sum MJSSig :&: Label)
   :*: HState JSCfgState (EnterExitPair MJSSig))
  i
-> (:*:)
     (HFix (Sum MJSSig :&: Label))
     (JSStatement (HState JSCfgState (EnterExitPair MJSSig)))
     i
forall (f :: (* -> *) -> * -> *) (gs :: [(* -> *) -> * -> *]) a
       (t :: * -> *).
(HFunctor f, f :-<: gs) =>
(:&:) f a (AnnTerm a gs :*: t) :-> (AnnTerm a gs :*: f t)
collapseFProd' -> (t :: TermLab MJSSig i
t :*: JSThrow _ e :: HState JSCfgState (EnterExitPair MJSSig) JSExpressionL
e _)) = State JSCfgState (EnterExitPair MJSSig i)
-> HState JSCfgState (EnterExitPair MJSSig) i
forall s (f :: * -> *) l. State s (f l) -> HState s f l
HState (State JSCfgState (EnterExitPair MJSSig i)
 -> HState JSCfgState (EnterExitPair MJSSig) i)
-> State JSCfgState (EnterExitPair MJSSig i)
-> HState JSCfgState (EnterExitPair MJSSig) i
forall a b. (a -> b) -> a -> b
$ TermLab MJSSig i
-> StateT
     JSCfgState Identity (Maybe (EnterExitPair MJSSig JSExpressionL))
-> State JSCfgState (EnterExitPair MJSSig i)
forall s (m :: * -> *) (gs :: [(* -> *) -> * -> *]) l i.
(MonadState s m, CfgComponent gs s) =>
TermLab gs l
-> m (Maybe (EnterExitPair gs i)) -> m (EnterExitPair gs l)
constructCfgReturn TermLab MJSSig i
t ((EnterExitPair MJSSig JSExpressionL
 -> Maybe (EnterExitPair MJSSig JSExpressionL))
-> StateT JSCfgState Identity (EnterExitPair MJSSig JSExpressionL)
-> StateT
     JSCfgState Identity (Maybe (EnterExitPair MJSSig JSExpressionL))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM EnterExitPair MJSSig JSExpressionL
-> Maybe (EnterExitPair MJSSig JSExpressionL)
forall a. a -> Maybe a
Just (StateT JSCfgState Identity (EnterExitPair MJSSig JSExpressionL)
 -> StateT
      JSCfgState Identity (Maybe (EnterExitPair MJSSig JSExpressionL)))
-> StateT JSCfgState Identity (EnterExitPair MJSSig JSExpressionL)
-> StateT
     JSCfgState Identity (Maybe (EnterExitPair MJSSig JSExpressionL))
forall a b. (a -> b) -> a -> b
$ HState JSCfgState (EnterExitPair MJSSig) JSExpressionL
-> StateT JSCfgState Identity (EnterExitPair MJSSig JSExpressionL)
forall s (f :: * -> *) l. HState s f l -> State s (f l)
unHState HState JSCfgState (EnterExitPair MJSSig) JSExpressionL
e)
  -- Again, pretending try/catch blocks are independent computation units
  constructCfg ((:&:)
  JSStatement
  Label
  (HFix (Sum MJSSig :&: Label)
   :*: HState JSCfgState (EnterExitPair MJSSig))
  i
-> (:*:)
     (HFix (Sum MJSSig :&: Label))
     (JSStatement (HState JSCfgState (EnterExitPair MJSSig)))
     i
forall (f :: (* -> *) -> * -> *) (gs :: [(* -> *) -> * -> *]) a
       (t :: * -> *).
(HFunctor f, f :-<: gs) =>
(:&:) f a (AnnTerm a gs :*: t) :-> (AnnTerm a gs :*: f t)
collapseFProd' -> (t :: TermLab MJSSig i
t :*: JSTry _ block :: HState JSCfgState (EnterExitPair MJSSig) JSBlockL
block catchs :: HState JSCfgState (EnterExitPair MJSSig) [JSTryCatchL]
catchs finally :: HState JSCfgState (EnterExitPair MJSSig) JSTryFinallyL
finally)) = State JSCfgState (EnterExitPair MJSSig i)
-> HState JSCfgState (EnterExitPair MJSSig) i
forall s (f :: * -> *) l. State s (f l) -> HState s f l
HState (State JSCfgState (EnterExitPair MJSSig i)
 -> HState JSCfgState (EnterExitPair MJSSig) i)
-> State JSCfgState (EnterExitPair MJSSig i)
-> HState JSCfgState (EnterExitPair MJSSig) i
forall a b. (a -> b) -> a -> b
$ do
    HState JSCfgState (EnterExitPair MJSSig) JSBlockL
-> State JSCfgState (EnterExitPair MJSSig JSBlockL)
forall s (f :: * -> *) l. HState s f l -> State s (f l)
unHState HState JSCfgState (EnterExitPair MJSSig) JSBlockL
block
    HState JSCfgState (EnterExitPair MJSSig) [JSTryCatchL]
-> State JSCfgState (EnterExitPair MJSSig [JSTryCatchL])
forall s (f :: * -> *) l. HState s f l -> State s (f l)
unHState HState JSCfgState (EnterExitPair MJSSig) [JSTryCatchL]
catchs
    HState JSCfgState (EnterExitPair MJSSig) JSTryFinallyL
-> State JSCfgState (EnterExitPair MJSSig JSTryFinallyL)
forall s (f :: * -> *) l. HState s f l -> State s (f l)
unHState HState JSCfgState (EnterExitPair MJSSig) JSTryFinallyL
finally
    TermLab MJSSig i -> State JSCfgState (EnterExitPair MJSSig i)
forall s (m :: * -> *) (gs :: [(* -> *) -> * -> *]) l.
(MonadState s m, CfgComponent gs s) =>
TermLab gs l -> m (EnterExitPair gs l)
constructCfgEmpty TermLab MJSSig i
t

  constructCfg ((:&:)
  JSStatement
  Label
  (HFix (Sum MJSSig :&: Label)
   :*: HState JSCfgState (EnterExitPair MJSSig))
  i
-> (:*:)
     (HFix (Sum MJSSig :&: Label))
     (JSStatement (HState JSCfgState (EnterExitPair MJSSig)))
     i
forall (f :: (* -> *) -> * -> *) (gs :: [(* -> *) -> * -> *]) a
       (t :: * -> *).
(HFunctor f, f :-<: gs) =>
(:&:) f a (AnnTerm a gs :*: t) :-> (AnnTerm a gs :*: f t)
collapseFProd' -> (t :: TermLab MJSSig i
t :*: (JSWhile _ _ e :: HState JSCfgState (EnterExitPair MJSSig) JSExpressionL
e _ s :: HState JSCfgState (EnterExitPair MJSSig) JSStatementL
s))) = State JSCfgState (EnterExitPair MJSSig i)
-> HState JSCfgState (EnterExitPair MJSSig) i
forall s (f :: * -> *) l. State s (f l) -> HState s f l
HState (State JSCfgState (EnterExitPair MJSSig i)
 -> HState JSCfgState (EnterExitPair MJSSig) i)
-> State JSCfgState (EnterExitPair MJSSig i)
-> HState JSCfgState (EnterExitPair MJSSig) i
forall a b. (a -> b) -> a -> b
$ TermLab MJSSig i
-> StateT JSCfgState Identity (EnterExitPair MJSSig JSExpressionL)
-> StateT JSCfgState Identity (EnterExitPair MJSSig JSStatementL)
-> State JSCfgState (EnterExitPair MJSSig 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 TermLab MJSSig i
t (HState JSCfgState (EnterExitPair MJSSig) JSExpressionL
-> StateT JSCfgState Identity (EnterExitPair MJSSig JSExpressionL)
forall s (f :: * -> *) l. HState s f l -> State s (f l)
unHState HState JSCfgState (EnterExitPair MJSSig) JSExpressionL
e) (HState JSCfgState (EnterExitPair MJSSig) JSStatementL
-> StateT JSCfgState Identity (EnterExitPair MJSSig JSStatementL)
forall s (f :: * -> *) l. HState s f l -> State s (f l)
unHState HState JSCfgState (EnterExitPair MJSSig) JSStatementL
s)

  constructCfg ((:&:)
  JSStatement
  Label
  (HFix (Sum MJSSig :&: Label)
   :*: HState JSCfgState (EnterExitPair MJSSig))
  i
-> (:*:)
     (HFix (Sum MJSSig :&: Label))
     (JSStatement (HState JSCfgState (EnterExitPair MJSSig)))
     i
forall (f :: (* -> *) -> * -> *) (gs :: [(* -> *) -> * -> *]) a
       (t :: * -> *).
(HFunctor f, f :-<: gs) =>
(:&:) f a (AnnTerm a gs :*: t) :-> (AnnTerm a gs :*: f t)
collapseFProd' -> (t :: TermLab MJSSig i
t :*: (JSSwitch _ _ exp :: HState JSCfgState (EnterExitPair MJSSig) JSExpressionL
exp _ _ switchParts :: HState JSCfgState (EnterExitPair MJSSig) [JSSwitchPartsL]
switchParts _ _))) = State JSCfgState (EnterExitPair MJSSig i)
-> HState JSCfgState (EnterExitPair MJSSig) i
forall s (f :: * -> *) l. State s (f l) -> HState s f l
HState (State JSCfgState (EnterExitPair MJSSig i)
 -> HState JSCfgState (EnterExitPair MJSSig) i)
-> State JSCfgState (EnterExitPair MJSSig i)
-> HState JSCfgState (EnterExitPair MJSSig) i
forall a b. (a -> b) -> a -> b
$ do
    CfgNode MJSSig
enterNode <- TermLab MJSSig i
-> CfgNodeType -> StateT JSCfgState Identity (CfgNode MJSSig)
forall s (fs :: [(* -> *) -> * -> *]) (m :: * -> *) l.
(HasCurCfg s fs, HasLabelGen s, MonadState s m) =>
TermLab fs l -> CfgNodeType -> m (CfgNode fs)
addCfgNode TermLab MJSSig i
t CfgNodeType
EnterNode
    CfgNode MJSSig
exitNode  <- TermLab MJSSig i
-> CfgNodeType -> StateT JSCfgState Identity (CfgNode MJSSig)
forall s (fs :: [(* -> *) -> * -> *]) (m :: * -> *) l.
(HasCurCfg s fs, HasLabelGen s, MonadState s m) =>
TermLab fs l -> CfgNodeType -> m (CfgNode fs)
addCfgNode TermLab MJSSig i
t CfgNodeType
ExitNode

    EnterExitPair MJSSig JSExpressionL
expEE <- HState JSCfgState (EnterExitPair MJSSig) JSExpressionL
-> StateT JSCfgState Identity (EnterExitPair MJSSig JSExpressionL)
forall s (f :: * -> *) l. HState s f l -> State s (f l)
unHState HState JSCfgState (EnterExitPair MJSSig) JSExpressionL
exp
    (Cfg MJSSig -> Identity (Cfg MJSSig))
-> JSCfgState -> Identity JSCfgState
forall c (fs :: [(* -> *) -> * -> *]).
HasCurCfg c fs =>
Lens' c (Cfg fs)
cur_cfg ((Cfg MJSSig -> Identity (Cfg MJSSig))
 -> JSCfgState -> Identity JSCfgState)
-> (Cfg MJSSig -> Cfg MJSSig) -> StateT JSCfgState Identity ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= CfgNode MJSSig -> CfgNode MJSSig -> Cfg MJSSig -> Cfg MJSSig
forall (fs :: [(* -> *) -> * -> *]).
CfgNode fs -> CfgNode fs -> Cfg fs -> Cfg fs
addEdge CfgNode MJSSig
enterNode (EnterExitPair MJSSig JSExpressionL -> CfgNode MJSSig
forall (fs :: [(* -> *) -> * -> *]) l.
EnterExitPair fs l -> CfgNode fs
enter EnterExitPair MJSSig JSExpressionL
expEE)

    CfgNode MJSSig -> StateT JSCfgState Identity ()
forall s (m :: * -> *) (fs :: [(* -> *) -> * -> *]).
(MonadState s m, HasLoopStack s) =>
CfgNode fs -> m ()
pushBreakNode CfgNode MJSSig
exitNode

    [EnterExitPair MJSSig JSSwitchPartsL]
blocks <- EnterExitPair MJSSig [JSSwitchPartsL]
-> [EnterExitPair MJSSig JSSwitchPartsL]
forall (fs :: [(* -> *) -> * -> *]) l.
(ListF :-<: fs, Typeable l) =>
EnterExitPair fs [l] -> [EnterExitPair fs l]
extractEEPList (EnterExitPair MJSSig [JSSwitchPartsL]
 -> [EnterExitPair MJSSig JSSwitchPartsL])
-> StateT
     JSCfgState Identity (EnterExitPair MJSSig [JSSwitchPartsL])
-> StateT JSCfgState Identity [EnterExitPair MJSSig JSSwitchPartsL]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HState JSCfgState (EnterExitPair MJSSig) [JSSwitchPartsL]
-> StateT
     JSCfgState Identity (EnterExitPair MJSSig [JSSwitchPartsL])
forall s (f :: * -> *) l. HState s f l -> State s (f l)
unHState HState JSCfgState (EnterExitPair MJSSig) [JSSwitchPartsL]
switchParts

    [EnterExitPair MJSSig JSSwitchPartsL]
-> (EnterExitPair MJSSig JSSwitchPartsL
    -> StateT JSCfgState Identity ())
-> StateT JSCfgState Identity ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [EnterExitPair MJSSig JSSwitchPartsL]
blocks ((EnterExitPair MJSSig JSSwitchPartsL
  -> StateT JSCfgState Identity ())
 -> StateT JSCfgState Identity ())
-> (EnterExitPair MJSSig JSSwitchPartsL
    -> StateT JSCfgState Identity ())
-> StateT JSCfgState Identity ()
forall a b. (a -> b) -> a -> b
$ \b :: EnterExitPair MJSSig JSSwitchPartsL
b -> case EnterExitPair MJSSig JSSwitchPartsL
b of
                          -- EmptyEnterExit -> cur_cfg %= addEdge (exit expEE) exitNode
                           EnterExitPair bEnt :: CfgNode MJSSig
bEnt bEx :: CfgNode MJSSig
bEx -> do
                             (Cfg MJSSig -> Identity (Cfg MJSSig))
-> JSCfgState -> Identity JSCfgState
forall c (fs :: [(* -> *) -> * -> *]).
HasCurCfg c fs =>
Lens' c (Cfg fs)
cur_cfg ((Cfg MJSSig -> Identity (Cfg MJSSig))
 -> JSCfgState -> Identity JSCfgState)
-> (Cfg MJSSig -> Cfg MJSSig) -> StateT JSCfgState Identity ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= CfgNode MJSSig -> CfgNode MJSSig -> Cfg MJSSig -> Cfg MJSSig
forall (fs :: [(* -> *) -> * -> *]).
CfgNode fs -> CfgNode fs -> Cfg fs -> Cfg fs
addEdge (EnterExitPair MJSSig JSExpressionL -> CfgNode MJSSig
forall (fs :: [(* -> *) -> * -> *]) l.
EnterExitPair fs l -> CfgNode fs
exit EnterExitPair MJSSig JSExpressionL
expEE) CfgNode MJSSig
bEnt

    StateT JSCfgState Identity ()
forall s (m :: * -> *). (MonadState s m, HasLoopStack s) => m ()
popBreakNode

    -- NOTE: fallthrough
    EnterExitPair MJSSig Any
blockEE <- (EnterExitPair MJSSig Any
 -> EnterExitPair MJSSig JSSwitchPartsL
 -> StateT JSCfgState Identity (EnterExitPair MJSSig Any))
-> EnterExitPair MJSSig Any
-> [EnterExitPair MJSSig JSSwitchPartsL]
-> StateT JSCfgState Identity (EnterExitPair MJSSig Any)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM EnterExitPair MJSSig Any
-> EnterExitPair MJSSig JSSwitchPartsL
-> StateT JSCfgState Identity (EnterExitPair MJSSig 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 MJSSig Any
forall (fs :: [(* -> *) -> * -> *]) l. EnterExitPair fs l
EmptyEnterExit [EnterExitPair MJSSig JSSwitchPartsL]
blocks
    EnterExitPair MJSSig Any
_ <- EnterExitPair MJSSig Any
-> EnterExitPair MJSSig Any
-> StateT JSCfgState Identity (EnterExitPair MJSSig 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 MJSSig Any
blockEE (CfgNode MJSSig -> EnterExitPair MJSSig Any
forall (fs :: [(* -> *) -> * -> *]) l.
CfgNode fs -> EnterExitPair fs l
identEnterExit CfgNode MJSSig
exitNode)

    EnterExitPair MJSSig i -> State JSCfgState (EnterExitPair MJSSig i)
forall (m :: * -> *) a. Monad m => a -> m a
return (EnterExitPair MJSSig i
 -> State JSCfgState (EnterExitPair MJSSig i))
-> EnterExitPair MJSSig i
-> State JSCfgState (EnterExitPair MJSSig i)
forall a b. (a -> b) -> a -> b
$ CfgNode MJSSig -> CfgNode MJSSig -> EnterExitPair MJSSig i
forall (fs :: [(* -> *) -> * -> *]) l.
CfgNode fs -> CfgNode fs -> EnterExitPair fs l
EnterExitPair CfgNode MJSSig
enterNode CfgNode MJSSig
exitNode

  constructCfg t :: (:&:)
  JSStatement
  Label
  (HFix (Sum MJSSig :&: Label)
   :*: HState JSCfgState (EnterExitPair MJSSig))
  i
t = (:&:)
  JSStatement
  Label
  (HFix (Sum MJSSig :&: Label)
   :*: HState JSCfgState (EnterExitPair MJSSig))
  i
-> HState JSCfgState (EnterExitPair MJSSig) 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 (:&:)
  JSStatement
  Label
  (HFix (Sum MJSSig :&: Label)
   :*: HState JSCfgState (EnterExitPair MJSSig))
  i
t

instance ConstructCfg MJSSig JSCfgState FunctionDef where
  constructCfg :: (:&:)
  FunctionDef
  Label
  (HFix (Sum MJSSig :&: Label)
   :*: HState JSCfgState (EnterExitPair MJSSig))
  i
-> HState JSCfgState (EnterExitPair MJSSig) i
constructCfg ((:&:)
  FunctionDef
  Label
  (HFix (Sum MJSSig :&: Label)
   :*: HState JSCfgState (EnterExitPair MJSSig))
  i
-> (:*:)
     (HFix (Sum MJSSig :&: Label))
     (FunctionDef (HState JSCfgState (EnterExitPair MJSSig)))
     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 MJSSig i
t :*: (FunctionDef _ _ _ body :: HState JSCfgState (EnterExitPair MJSSig) FunctionBodyL
body))) = State JSCfgState (EnterExitPair MJSSig i)
-> HState JSCfgState (EnterExitPair MJSSig) i
forall s (f :: * -> *) l. State s (f l) -> HState s f l
HState (State JSCfgState (EnterExitPair MJSSig i)
 -> HState JSCfgState (EnterExitPair MJSSig) i)
-> State JSCfgState (EnterExitPair MJSSig i)
-> HState JSCfgState (EnterExitPair MJSSig) i
forall a b. (a -> b) -> a -> b
$ (HState JSCfgState (EnterExitPair MJSSig) FunctionBodyL
-> State JSCfgState (EnterExitPair MJSSig FunctionBodyL)
forall s (f :: * -> *) l. HState s f l -> State s (f l)
unHState HState JSCfgState (EnterExitPair MJSSig) FunctionBodyL
body State JSCfgState (EnterExitPair MJSSig FunctionBodyL)
-> State JSCfgState (EnterExitPair MJSSig i)
-> State JSCfgState (EnterExitPair MJSSig i)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> AnnTerm Label MJSSig i -> State JSCfgState (EnterExitPair MJSSig i)
forall s (m :: * -> *) (gs :: [(* -> *) -> * -> *]) l.
(MonadState s m, CfgComponent gs s) =>
TermLab gs l -> m (EnterExitPair gs l)
constructCfgEmpty AnnTerm Label MJSSig i
t)

instance ConstructCfg MJSSig JSCfgState JSExpression where
  constructCfg :: (:&:)
  JSExpression
  Label
  (HFix (Sum MJSSig :&: Label)
   :*: HState JSCfgState (EnterExitPair MJSSig))
  i
-> HState JSCfgState (EnterExitPair MJSSig) i
constructCfg ((:&:)
  JSExpression
  Label
  (HFix (Sum MJSSig :&: Label)
   :*: HState JSCfgState (EnterExitPair MJSSig))
  i
-> (:*:)
     (HFix (Sum MJSSig :&: Label))
     (JSExpression (HState JSCfgState (EnterExitPair MJSSig)))
     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 MJSSig i
t :*: (JSFunctionExpression _ _ _ _ _ body :: HState JSCfgState (EnterExitPair MJSSig) JSBlockL
body))) = State JSCfgState (EnterExitPair MJSSig i)
-> HState JSCfgState (EnterExitPair MJSSig) i
forall s (f :: * -> *) l. State s (f l) -> HState s f l
HState (HState JSCfgState (EnterExitPair MJSSig) JSBlockL
-> State JSCfgState (EnterExitPair MJSSig JSBlockL)
forall s (f :: * -> *) l. HState s f l -> State s (f l)
unHState HState JSCfgState (EnterExitPair MJSSig) JSBlockL
body State JSCfgState (EnterExitPair MJSSig JSBlockL)
-> State JSCfgState (EnterExitPair MJSSig i)
-> State JSCfgState (EnterExitPair MJSSig i)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> AnnTerm Label MJSSig i -> State JSCfgState (EnterExitPair MJSSig i)
forall s (m :: * -> *) (gs :: [(* -> *) -> * -> *]) l.
(MonadState s m, CfgComponent gs s) =>
TermLab gs l -> m (EnterExitPair gs l)
constructCfgEmpty AnnTerm Label MJSSig i
t)

  constructCfg t' :: (:&:)
  JSExpression
  Label
  (HFix (Sum MJSSig :&: Label)
   :*: HState JSCfgState (EnterExitPair MJSSig))
  i
t'@((:&:)
  JSExpression
  Label
  (HFix (Sum MJSSig :&: Label)
   :*: HState JSCfgState (EnterExitPair MJSSig))
  i
-> JSExpression
     (HFix (Sum MJSSig :&: Label)
      :*: HState JSCfgState (EnterExitPair MJSSig))
     i
forall (s :: (* -> *) -> * -> *) (s' :: (* -> *) -> * -> *)
       (a :: * -> *).
RemA s s' =>
s a :-> s' a
remA -> (JSExpressionBinary _ (op :: HFix (Sum MJSSig :&: Label) JSBinOpL
op :*: _) _)) = do
    let (t :: AnnTerm Label MJSSig i
t :*: (JSExpressionBinary el _ er)) = (:&:)
  JSExpression
  Label
  (HFix (Sum MJSSig :&: Label)
   :*: HState JSCfgState (EnterExitPair MJSSig))
  i
-> (:*:)
     (HFix (Sum MJSSig :&: Label))
     (JSExpression (HState JSCfgState (EnterExitPair MJSSig)))
     i
forall (f :: (* -> *) -> * -> *) (gs :: [(* -> *) -> * -> *]) a
       (t :: * -> *).
(HFunctor f, f :-<: gs) =>
(:&:) f a (AnnTerm a gs :*: t) :-> (AnnTerm a gs :*: f t)
collapseFProd' (:&:)
  JSExpression
  Label
  (HFix (Sum MJSSig :&: Label)
   :*: HState JSCfgState (EnterExitPair MJSSig))
  i
t'
    case HFix (Sum MJSSig :&: Label) JSBinOpL -> JSBinOp MJSTerm JSBinOpL
extractOp HFix (Sum MJSSig :&: Label) JSBinOpL
op of
      JSBinOpAnd {} -> State JSCfgState (EnterExitPair MJSSig i)
-> HState JSCfgState (EnterExitPair MJSSig) i
forall s (f :: * -> *) l. State s (f l) -> HState s f l
HState (State JSCfgState (EnterExitPair MJSSig i)
 -> HState JSCfgState (EnterExitPair MJSSig) i)
-> State JSCfgState (EnterExitPair MJSSig i)
-> HState JSCfgState (EnterExitPair MJSSig) i
forall a b. (a -> b) -> a -> b
$ AnnTerm Label MJSSig i
-> StateT JSCfgState Identity (EnterExitPair MJSSig JSExpressionL)
-> StateT JSCfgState Identity (EnterExitPair MJSSig JSExpressionL)
-> State JSCfgState (EnterExitPair MJSSig 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 MJSSig i
t (HState JSCfgState (EnterExitPair MJSSig) JSExpressionL
-> StateT JSCfgState Identity (EnterExitPair MJSSig JSExpressionL)
forall s (f :: * -> *) l. HState s f l -> State s (f l)
unHState HState JSCfgState (EnterExitPair MJSSig) JSExpressionL
el) (HState JSCfgState (EnterExitPair MJSSig) JSExpressionL
-> StateT JSCfgState Identity (EnterExitPair MJSSig JSExpressionL)
forall s (f :: * -> *) l. HState s f l -> State s (f l)
unHState HState JSCfgState (EnterExitPair MJSSig) JSExpressionL
er)
      JSBinOpOr {} -> State JSCfgState (EnterExitPair MJSSig i)
-> HState JSCfgState (EnterExitPair MJSSig) i
forall s (f :: * -> *) l. State s (f l) -> HState s f l
HState (State JSCfgState (EnterExitPair MJSSig i)
 -> HState JSCfgState (EnterExitPair MJSSig) i)
-> State JSCfgState (EnterExitPair MJSSig i)
-> HState JSCfgState (EnterExitPair MJSSig) i
forall a b. (a -> b) -> a -> b
$ AnnTerm Label MJSSig i
-> StateT JSCfgState Identity (EnterExitPair MJSSig JSExpressionL)
-> StateT JSCfgState Identity (EnterExitPair MJSSig JSExpressionL)
-> State JSCfgState (EnterExitPair MJSSig 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 MJSSig i
t (HState JSCfgState (EnterExitPair MJSSig) JSExpressionL
-> StateT JSCfgState Identity (EnterExitPair MJSSig JSExpressionL)
forall s (f :: * -> *) l. HState s f l -> State s (f l)
unHState HState JSCfgState (EnterExitPair MJSSig) JSExpressionL
el) (HState JSCfgState (EnterExitPair MJSSig) JSExpressionL
-> StateT JSCfgState Identity (EnterExitPair MJSSig JSExpressionL)
forall s (f :: * -> *) l. HState s f l -> State s (f l)
unHState HState JSCfgState (EnterExitPair MJSSig) JSExpressionL
er)
      _   -> (:&:)
  JSExpression
  Label
  (HFix (Sum MJSSig :&: Label)
   :*: HState JSCfgState (EnterExitPair MJSSig))
  i
-> HState JSCfgState (EnterExitPair MJSSig) 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 (:&:)
  JSExpression
  Label
  (HFix (Sum MJSSig :&: Label)
   :*: HState JSCfgState (EnterExitPair MJSSig))
  i
t'

    where extractOp :: MJSTermLab JSBinOpL -> JSBinOp MJSTerm JSBinOpL
          extractOp :: HFix (Sum MJSSig :&: Label) JSBinOpL -> JSBinOp MJSTerm JSBinOpL
extractOp (HFix (Sum MJSSig :&: Label) JSBinOpL
-> Cxt NoHole (Sum MJSSig) (K ()) JSBinOpL
forall (g :: (* -> *) -> * -> *) (f :: (* -> *) -> * -> *).
(RemA g f, HFunctor g) =>
CxtFun g f
stripA -> Cxt NoHole (Sum MJSSig) (K ()) JSBinOpL
-> Maybe (JSBinOp MJSTerm JSBinOpL)
forall (g :: (* -> *) -> * -> *) (f :: (* -> *) -> * -> *) h
       (a :: * -> *).
(g :<: f) =>
NatM Maybe (Cxt h f a) (g (Cxt h f a))
project -> Just bp :: JSBinOp MJSTerm JSBinOpL
bp) = JSBinOp MJSTerm JSBinOpL
bp

  constructCfg t' :: (:&:)
  JSExpression
  Label
  (HFix (Sum MJSSig :&: Label)
   :*: HState JSCfgState (EnterExitPair MJSSig))
  i
t'@((:&:)
  JSExpression
  Label
  (HFix (Sum MJSSig :&: Label)
   :*: HState JSCfgState (EnterExitPair MJSSig))
  i
-> JSExpression
     (HFix (Sum MJSSig :&: Label)
      :*: HState JSCfgState (EnterExitPair MJSSig))
     i
forall (s :: (* -> *) -> * -> *) (s' :: (* -> *) -> * -> *)
       (a :: * -> *).
RemA s s' =>
s a :-> s' a
remA -> JSExpressionTernary {}) = State JSCfgState (EnterExitPair MJSSig i)
-> HState JSCfgState (EnterExitPair MJSSig) i
forall s (f :: * -> *) l. State s (f l) -> HState s f l
HState (State JSCfgState (EnterExitPair MJSSig i)
 -> HState JSCfgState (EnterExitPair MJSSig) i)
-> State JSCfgState (EnterExitPair MJSSig i)
-> HState JSCfgState (EnterExitPair MJSSig) i
forall a b. (a -> b) -> a -> b
$ do
    let (t :: AnnTerm Label MJSSig i
t :*: (JSExpressionTernary test _ succ _ fail)) = (:&:)
  JSExpression
  Label
  (HFix (Sum MJSSig :&: Label)
   :*: HState JSCfgState (EnterExitPair MJSSig))
  i
-> (:*:)
     (HFix (Sum MJSSig :&: Label))
     (JSExpression (HState JSCfgState (EnterExitPair MJSSig)))
     i
forall (f :: (* -> *) -> * -> *) (gs :: [(* -> *) -> * -> *]) a
       (t :: * -> *).
(HFunctor f, f :-<: gs) =>
(:&:) f a (AnnTerm a gs :*: t) :-> (AnnTerm a gs :*: f t)
collapseFProd' (:&:)
  JSExpression
  Label
  (HFix (Sum MJSSig :&: Label)
   :*: HState JSCfgState (EnterExitPair MJSSig))
  i
t'
    AnnTerm Label MJSSig i
-> StateT JSCfgState Identity (EnterExitPair MJSSig JSExpressionL)
-> StateT JSCfgState Identity (EnterExitPair MJSSig JSExpressionL)
-> State JSCfgState (EnterExitPair MJSSig i)
-> State JSCfgState (EnterExitPair MJSSig 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)
-> m (EnterExitPair fs es)
constructCfgCondOp AnnTerm Label MJSSig i
t (HState JSCfgState (EnterExitPair MJSSig) JSExpressionL
-> StateT JSCfgState Identity (EnterExitPair MJSSig JSExpressionL)
forall s (f :: * -> *) l. HState s f l -> State s (f l)
unHState HState JSCfgState (EnterExitPair MJSSig) JSExpressionL
test) (HState JSCfgState (EnterExitPair MJSSig) JSExpressionL
-> StateT JSCfgState Identity (EnterExitPair MJSSig JSExpressionL)
forall s (f :: * -> *) l. HState s f l -> State s (f l)
unHState HState JSCfgState (EnterExitPair MJSSig) JSExpressionL
succ) (HState JSCfgState (EnterExitPair MJSSig) i
-> State JSCfgState (EnterExitPair MJSSig i)
forall s (f :: * -> *) l. HState s f l -> State s (f l)
unHState HState JSCfgState (EnterExitPair MJSSig) i
fail)
  constructCfg t :: (:&:)
  JSExpression
  Label
  (HFix (Sum MJSSig :&: Label)
   :*: HState JSCfgState (EnterExitPair MJSSig))
  i
t = (:&:)
  JSExpression
  Label
  (HFix (Sum MJSSig :&: Label)
   :*: HState JSCfgState (EnterExitPair MJSSig))
  i
-> HState JSCfgState (EnterExitPair MJSSig) 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 (:&:)
  JSExpression
  Label
  (HFix (Sum MJSSig :&: Label)
   :*: HState JSCfgState (EnterExitPair MJSSig))
  i
t

instance ConstructCfg MJSSig JSCfgState C.JSFor where
  constructCfg :: (:&:)
  JSFor
  Label
  (HFix (Sum MJSSig :&: Label)
   :*: HState JSCfgState (EnterExitPair MJSSig))
  i
-> HState JSCfgState (EnterExitPair MJSSig) i
constructCfg ((:&:)
  JSFor
  Label
  (HFix (Sum MJSSig :&: Label)
   :*: HState JSCfgState (EnterExitPair MJSSig))
  i
-> (:*:)
     (HFix (Sum MJSSig :&: Label))
     (JSFor (HState JSCfgState (EnterExitPair MJSSig)))
     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 MJSSig i
t :*: C.JSFor init :: HState JSCfgState (EnterExitPair MJSSig) [JSExpressionL]
init cond :: HState JSCfgState (EnterExitPair MJSSig) [JSExpressionL]
cond step :: HState JSCfgState (EnterExitPair MJSSig) [JSExpressionL]
step body :: HState JSCfgState (EnterExitPair MJSSig) JSStatementL
body)) = State JSCfgState (EnterExitPair MJSSig i)
-> HState JSCfgState (EnterExitPair MJSSig) i
forall s (f :: * -> *) l. State s (f l) -> HState s f l
HState (State JSCfgState (EnterExitPair MJSSig i)
 -> HState JSCfgState (EnterExitPair MJSSig) i)
-> State JSCfgState (EnterExitPair MJSSig i)
-> HState JSCfgState (EnterExitPair MJSSig) i
forall a b. (a -> b) -> a -> b
$ AnnTerm Label MJSSig i
-> StateT
     JSCfgState Identity (Maybe (EnterExitPair MJSSig [JSExpressionL]))
-> StateT
     JSCfgState Identity (Maybe (EnterExitPair MJSSig [JSExpressionL]))
-> StateT
     JSCfgState Identity (Maybe (EnterExitPair MJSSig [JSExpressionL]))
-> StateT JSCfgState Identity (EnterExitPair MJSSig JSStatementL)
-> State JSCfgState (EnterExitPair MJSSig i)
forall s (m :: * -> *) (gs :: [(* -> *) -> * -> *]) l h i j k.
(HasLoopStack s, MonadState s m, CfgComponent gs s) =>
TermLab gs l
-> m (Maybe (EnterExitPair gs h))
-> m (Maybe (EnterExitPair gs i))
-> m (Maybe (EnterExitPair gs j))
-> m (EnterExitPair gs k)
-> m (EnterExitPair gs l)
constructCfgFor AnnTerm Label MJSSig i
t ((EnterExitPair MJSSig [JSExpressionL]
 -> Maybe (EnterExitPair MJSSig [JSExpressionL]))
-> StateT
     JSCfgState Identity (EnterExitPair MJSSig [JSExpressionL])
-> StateT
     JSCfgState Identity (Maybe (EnterExitPair MJSSig [JSExpressionL]))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM EnterExitPair MJSSig [JSExpressionL]
-> Maybe (EnterExitPair MJSSig [JSExpressionL])
forall a. a -> Maybe a
Just (StateT JSCfgState Identity (EnterExitPair MJSSig [JSExpressionL])
 -> StateT
      JSCfgState Identity (Maybe (EnterExitPair MJSSig [JSExpressionL])))
-> StateT
     JSCfgState Identity (EnterExitPair MJSSig [JSExpressionL])
-> StateT
     JSCfgState Identity (Maybe (EnterExitPair MJSSig [JSExpressionL]))
forall a b. (a -> b) -> a -> b
$ HState JSCfgState (EnterExitPair MJSSig) [JSExpressionL]
-> StateT
     JSCfgState Identity (EnterExitPair MJSSig [JSExpressionL])
forall s (f :: * -> *) l. HState s f l -> State s (f l)
unHState HState JSCfgState (EnterExitPair MJSSig) [JSExpressionL]
init) ((EnterExitPair MJSSig [JSExpressionL]
 -> Maybe (EnterExitPair MJSSig [JSExpressionL]))
-> StateT
     JSCfgState Identity (EnterExitPair MJSSig [JSExpressionL])
-> StateT
     JSCfgState Identity (Maybe (EnterExitPair MJSSig [JSExpressionL]))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM EnterExitPair MJSSig [JSExpressionL]
-> Maybe (EnterExitPair MJSSig [JSExpressionL])
forall a. a -> Maybe a
Just (StateT JSCfgState Identity (EnterExitPair MJSSig [JSExpressionL])
 -> StateT
      JSCfgState Identity (Maybe (EnterExitPair MJSSig [JSExpressionL])))
-> StateT
     JSCfgState Identity (EnterExitPair MJSSig [JSExpressionL])
-> StateT
     JSCfgState Identity (Maybe (EnterExitPair MJSSig [JSExpressionL]))
forall a b. (a -> b) -> a -> b
$ HState JSCfgState (EnterExitPair MJSSig) [JSExpressionL]
-> StateT
     JSCfgState Identity (EnterExitPair MJSSig [JSExpressionL])
forall s (f :: * -> *) l. HState s f l -> State s (f l)
unHState HState JSCfgState (EnterExitPair MJSSig) [JSExpressionL]
cond) ((EnterExitPair MJSSig [JSExpressionL]
 -> Maybe (EnterExitPair MJSSig [JSExpressionL]))
-> StateT
     JSCfgState Identity (EnterExitPair MJSSig [JSExpressionL])
-> StateT
     JSCfgState Identity (Maybe (EnterExitPair MJSSig [JSExpressionL]))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM EnterExitPair MJSSig [JSExpressionL]
-> Maybe (EnterExitPair MJSSig [JSExpressionL])
forall a. a -> Maybe a
Just (StateT JSCfgState Identity (EnterExitPair MJSSig [JSExpressionL])
 -> StateT
      JSCfgState Identity (Maybe (EnterExitPair MJSSig [JSExpressionL])))
-> StateT
     JSCfgState Identity (EnterExitPair MJSSig [JSExpressionL])
-> StateT
     JSCfgState Identity (Maybe (EnterExitPair MJSSig [JSExpressionL]))
forall a b. (a -> b) -> a -> b
$ HState JSCfgState (EnterExitPair MJSSig) [JSExpressionL]
-> StateT
     JSCfgState Identity (EnterExitPair MJSSig [JSExpressionL])
forall s (f :: * -> *) l. HState s f l -> State s (f l)
unHState HState JSCfgState (EnterExitPair MJSSig) [JSExpressionL]
step) (HState JSCfgState (EnterExitPair MJSSig) JSStatementL
-> StateT JSCfgState Identity (EnterExitPair MJSSig JSStatementL)
forall s (f :: * -> *) l. HState s f l -> State s (f l)
unHState HState JSCfgState (EnterExitPair MJSSig) JSStatementL
body)
  constructCfg ((:&:)
  JSFor
  Label
  (HFix (Sum MJSSig :&: Label)
   :*: HState JSCfgState (EnterExitPair MJSSig))
  i
-> (:*:)
     (HFix (Sum MJSSig :&: Label))
     (JSFor (HState JSCfgState (EnterExitPair MJSSig)))
     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 MJSSig i
t :*: C.JSForIn _ _ exp :: HState JSCfgState (EnterExitPair MJSSig) JSExpressionL
exp body :: HState JSCfgState (EnterExitPair MJSSig) JSStatementL
body)) = State JSCfgState (EnterExitPair MJSSig i)
-> HState JSCfgState (EnterExitPair MJSSig) i
forall s (f :: * -> *) l. State s (f l) -> HState s f l
HState (State JSCfgState (EnterExitPair MJSSig i)
 -> HState JSCfgState (EnterExitPair MJSSig) i)
-> State JSCfgState (EnterExitPair MJSSig i)
-> HState JSCfgState (EnterExitPair MJSSig) i
forall a b. (a -> b) -> a -> b
$ AnnTerm Label MJSSig i
-> StateT JSCfgState Identity (EnterExitPair MJSSig JSExpressionL)
-> StateT JSCfgState Identity (EnterExitPair MJSSig JSStatementL)
-> State JSCfgState (EnterExitPair MJSSig 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 MJSSig i
t (HState JSCfgState (EnterExitPair MJSSig) JSExpressionL
-> StateT JSCfgState Identity (EnterExitPair MJSSig JSExpressionL)
forall s (f :: * -> *) l. HState s f l -> State s (f l)
unHState HState JSCfgState (EnterExitPair MJSSig) JSExpressionL
exp) (HState JSCfgState (EnterExitPair MJSSig) JSStatementL
-> StateT JSCfgState Identity (EnterExitPair MJSSig JSStatementL)
forall s (f :: * -> *) l. HState s f l -> State s (f l)
unHState HState JSCfgState (EnterExitPair MJSSig) JSStatementL
body)
  constructCfg ((:&:)
  JSFor
  Label
  (HFix (Sum MJSSig :&: Label)
   :*: HState JSCfgState (EnterExitPair MJSSig))
  i
-> (:*:)
     (HFix (Sum MJSSig :&: Label))
     (JSFor (HState JSCfgState (EnterExitPair MJSSig)))
     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 MJSSig i
t :*: C.JSForVar init :: HState JSCfgState (EnterExitPair MJSSig) [SingleLocalVarDeclL]
init cond :: HState JSCfgState (EnterExitPair MJSSig) [JSExpressionL]
cond step :: HState JSCfgState (EnterExitPair MJSSig) [JSExpressionL]
step body :: HState JSCfgState (EnterExitPair MJSSig) JSStatementL
body)) = State JSCfgState (EnterExitPair MJSSig i)
-> HState JSCfgState (EnterExitPair MJSSig) i
forall s (f :: * -> *) l. State s (f l) -> HState s f l
HState (State JSCfgState (EnterExitPair MJSSig i)
 -> HState JSCfgState (EnterExitPair MJSSig) i)
-> State JSCfgState (EnterExitPair MJSSig i)
-> HState JSCfgState (EnterExitPair MJSSig) i
forall a b. (a -> b) -> a -> b
$ AnnTerm Label MJSSig i
-> StateT
     JSCfgState
     Identity
     (Maybe (EnterExitPair MJSSig [SingleLocalVarDeclL]))
-> StateT
     JSCfgState Identity (Maybe (EnterExitPair MJSSig [JSExpressionL]))
-> StateT
     JSCfgState Identity (Maybe (EnterExitPair MJSSig [JSExpressionL]))
-> StateT JSCfgState Identity (EnterExitPair MJSSig JSStatementL)
-> State JSCfgState (EnterExitPair MJSSig i)
forall s (m :: * -> *) (gs :: [(* -> *) -> * -> *]) l h i j k.
(HasLoopStack s, MonadState s m, CfgComponent gs s) =>
TermLab gs l
-> m (Maybe (EnterExitPair gs h))
-> m (Maybe (EnterExitPair gs i))
-> m (Maybe (EnterExitPair gs j))
-> m (EnterExitPair gs k)
-> m (EnterExitPair gs l)
constructCfgFor AnnTerm Label MJSSig i
t ((EnterExitPair MJSSig [SingleLocalVarDeclL]
 -> Maybe (EnterExitPair MJSSig [SingleLocalVarDeclL]))
-> StateT
     JSCfgState Identity (EnterExitPair MJSSig [SingleLocalVarDeclL])
-> StateT
     JSCfgState
     Identity
     (Maybe (EnterExitPair MJSSig [SingleLocalVarDeclL]))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM EnterExitPair MJSSig [SingleLocalVarDeclL]
-> Maybe (EnterExitPair MJSSig [SingleLocalVarDeclL])
forall a. a -> Maybe a
Just (StateT
   JSCfgState Identity (EnterExitPair MJSSig [SingleLocalVarDeclL])
 -> StateT
      JSCfgState
      Identity
      (Maybe (EnterExitPair MJSSig [SingleLocalVarDeclL])))
-> StateT
     JSCfgState Identity (EnterExitPair MJSSig [SingleLocalVarDeclL])
-> StateT
     JSCfgState
     Identity
     (Maybe (EnterExitPair MJSSig [SingleLocalVarDeclL]))
forall a b. (a -> b) -> a -> b
$ HState JSCfgState (EnterExitPair MJSSig) [SingleLocalVarDeclL]
-> StateT
     JSCfgState Identity (EnterExitPair MJSSig [SingleLocalVarDeclL])
forall s (f :: * -> *) l. HState s f l -> State s (f l)
unHState HState JSCfgState (EnterExitPair MJSSig) [SingleLocalVarDeclL]
init) ((EnterExitPair MJSSig [JSExpressionL]
 -> Maybe (EnterExitPair MJSSig [JSExpressionL]))
-> StateT
     JSCfgState Identity (EnterExitPair MJSSig [JSExpressionL])
-> StateT
     JSCfgState Identity (Maybe (EnterExitPair MJSSig [JSExpressionL]))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM EnterExitPair MJSSig [JSExpressionL]
-> Maybe (EnterExitPair MJSSig [JSExpressionL])
forall a. a -> Maybe a
Just (StateT JSCfgState Identity (EnterExitPair MJSSig [JSExpressionL])
 -> StateT
      JSCfgState Identity (Maybe (EnterExitPair MJSSig [JSExpressionL])))
-> StateT
     JSCfgState Identity (EnterExitPair MJSSig [JSExpressionL])
-> StateT
     JSCfgState Identity (Maybe (EnterExitPair MJSSig [JSExpressionL]))
forall a b. (a -> b) -> a -> b
$ HState JSCfgState (EnterExitPair MJSSig) [JSExpressionL]
-> StateT
     JSCfgState Identity (EnterExitPair MJSSig [JSExpressionL])
forall s (f :: * -> *) l. HState s f l -> State s (f l)
unHState HState JSCfgState (EnterExitPair MJSSig) [JSExpressionL]
cond) ((EnterExitPair MJSSig [JSExpressionL]
 -> Maybe (EnterExitPair MJSSig [JSExpressionL]))
-> StateT
     JSCfgState Identity (EnterExitPair MJSSig [JSExpressionL])
-> StateT
     JSCfgState Identity (Maybe (EnterExitPair MJSSig [JSExpressionL]))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM EnterExitPair MJSSig [JSExpressionL]
-> Maybe (EnterExitPair MJSSig [JSExpressionL])
forall a. a -> Maybe a
Just (StateT JSCfgState Identity (EnterExitPair MJSSig [JSExpressionL])
 -> StateT
      JSCfgState Identity (Maybe (EnterExitPair MJSSig [JSExpressionL])))
-> StateT
     JSCfgState Identity (EnterExitPair MJSSig [JSExpressionL])
-> StateT
     JSCfgState Identity (Maybe (EnterExitPair MJSSig [JSExpressionL]))
forall a b. (a -> b) -> a -> b
$ HState JSCfgState (EnterExitPair MJSSig) [JSExpressionL]
-> StateT
     JSCfgState Identity (EnterExitPair MJSSig [JSExpressionL])
forall s (f :: * -> *) l. HState s f l -> State s (f l)
unHState HState JSCfgState (EnterExitPair MJSSig) [JSExpressionL]
step) (HState JSCfgState (EnterExitPair MJSSig) JSStatementL
-> StateT JSCfgState Identity (EnterExitPair MJSSig JSStatementL)
forall s (f :: * -> *) l. HState s f l -> State s (f l)
unHState HState JSCfgState (EnterExitPair MJSSig) JSStatementL
body)
  constructCfg ((:&:)
  JSFor
  Label
  (HFix (Sum MJSSig :&: Label)
   :*: HState JSCfgState (EnterExitPair MJSSig))
  i
-> (:*:)
     (HFix (Sum MJSSig :&: Label))
     (JSFor (HState JSCfgState (EnterExitPair MJSSig)))
     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 MJSSig i
t :*: C.JSForVarIn _ _ exp :: HState JSCfgState (EnterExitPair MJSSig) JSExpressionL
exp body :: HState JSCfgState (EnterExitPair MJSSig) JSStatementL
body)) = State JSCfgState (EnterExitPair MJSSig i)
-> HState JSCfgState (EnterExitPair MJSSig) i
forall s (f :: * -> *) l. State s (f l) -> HState s f l
HState (State JSCfgState (EnterExitPair MJSSig i)
 -> HState JSCfgState (EnterExitPair MJSSig) i)
-> State JSCfgState (EnterExitPair MJSSig i)
-> HState JSCfgState (EnterExitPair MJSSig) i
forall a b. (a -> b) -> a -> b
$ AnnTerm Label MJSSig i
-> StateT JSCfgState Identity (EnterExitPair MJSSig JSExpressionL)
-> StateT JSCfgState Identity (EnterExitPair MJSSig JSStatementL)
-> State JSCfgState (EnterExitPair MJSSig 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 MJSSig i
t (HState JSCfgState (EnterExitPair MJSSig) JSExpressionL
-> StateT JSCfgState Identity (EnterExitPair MJSSig JSExpressionL)
forall s (f :: * -> *) l. HState s f l -> State s (f l)
unHState HState JSCfgState (EnterExitPair MJSSig) JSExpressionL
exp) (HState JSCfgState (EnterExitPair MJSSig) JSStatementL
-> StateT JSCfgState Identity (EnterExitPair MJSSig JSStatementL)
forall s (f :: * -> *) l. HState s f l -> State s (f l)
unHState HState JSCfgState (EnterExitPair MJSSig) JSStatementL
body)

instance CfgInitState MJSSig where
  cfgInitState :: Proxy MJSSig -> CfgState MJSSig
cfgInitState _ = Cfg MJSSig -> LabelGen -> LoopStack -> ScopedLabelMap -> JSCfgState
JSCfgState Cfg MJSSig
forall (fs :: [(* -> *) -> * -> *]). Cfg fs
emptyCfg (() -> LabelGen
unsafeMkCSLabelGen ()) LoopStack
emptyLoopStack ScopedLabelMap
emptyScopedLabelMap
#endif