{-# LANGUAGE TypeFamilies, Rank2Types #-}

-- Performs code analysis on the GOOL code
module Drasil.GOOL.CodeInfoOO (CodeInfoOO(..)) where

import Drasil.GOOL.InterfaceCommon (MSBody, VSType, SValue, MSStatement, 
  SMethod, SharedProg, BodySym(..), BlockSym(..), TypeSym(..), TypeElim(..),
  VariableSym(..), VariableElim(..), ValueSym(..), Argument(..), Literal(..),
  MathConstant(..), VariableValue(..), CommandLineArgs(..),
  NumericExpression(..), BooleanExpression(..), Comparison(..),
  ValueExpression(..), List(..), Set(..), InternalList(..), ThunkSym(..), VectorType(..),
  VectorDecl(..), VectorThunk(..), VectorExpression(..), ThunkAssign(..),
  StatementSym(..), AssignStatement(..), DeclStatement(..), IOStatement(..),
  StringStatement(..), FunctionSym(..), FuncAppStatement(..),
  CommentStatement(..), ControlStatement(..), ScopeSym(..), ParameterSym(..),
  MethodSym(..), VisibilitySym(..))
import Drasil.GOOL.InterfaceGOOL (OOProg, ProgramSym(..), FileSym(..),
  ModuleSym(..), ClassSym(..), OOMethodSym(..), OOTypeSym(..),
  OOVariableSym(..), PermanenceSym(..), StateVarSym(..), OOValueSym,
  OOVariableValue, OOValueExpression(..), InternalValueExp(..),
  OOFunctionSym(..), GetSet(..), OODeclStatement(..), OOFuncAppStatement(..),
  ObserverPattern(..), StrategyPattern(..))
import Drasil.GOOL.CodeType (CodeType(Void))
import Drasil.GOOL.AST (VisibilityTag(..), qualName)
import Drasil.GOOL.CodeAnalysis (ExceptionType(..))
import Drasil.GOOL.Helpers (toCode, toState)
import Drasil.GOOL.State (GOOLState, VS, lensGStoFS, lensFStoCS, lensFStoMS,
  lensCStoMS, lensMStoVS, lensVStoFS, lensCStoFS, modifyReturn, 
  setClassName, getClassName, setModuleName, getModuleName, addClass, 
  updateClassMap, addException, updateMethodExcMap, updateCallMap, addCall, 
  callMapTransClosure, updateMEMWithCalls)

import Control.Monad.State (State, modify)
import qualified Control.Monad.State as S (get)
import Control.Lens.Zoom (zoom)
import Data.Maybe (fromMaybe)

newtype CodeInfoOO a = CI {forall a. CodeInfoOO a -> a
unCI :: a} deriving CodeInfoOO a -> CodeInfoOO a -> Bool
(CodeInfoOO a -> CodeInfoOO a -> Bool)
-> (CodeInfoOO a -> CodeInfoOO a -> Bool) -> Eq (CodeInfoOO a)
forall a. Eq a => CodeInfoOO a -> CodeInfoOO a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => CodeInfoOO a -> CodeInfoOO a -> Bool
== :: CodeInfoOO a -> CodeInfoOO a -> Bool
$c/= :: forall a. Eq a => CodeInfoOO a -> CodeInfoOO a -> Bool
/= :: CodeInfoOO a -> CodeInfoOO a -> Bool
Eq

-- FIXME: Use DerivingVia language extension (and maybe DeriveFunctor) to 
-- derive the Functor, Applicative, Monad instances for this 
-- (and for JavaCode, PythonCode, etc.)
instance Functor CodeInfoOO where
  fmap :: forall a b. (a -> b) -> CodeInfoOO a -> CodeInfoOO b
fmap a -> b
f (CI a
x) = b -> CodeInfoOO b
forall a. a -> CodeInfoOO a
CI (a -> b
f a
x)

instance Applicative CodeInfoOO where
  pure :: forall a. a -> CodeInfoOO a
pure = a -> CodeInfoOO a
forall a. a -> CodeInfoOO a
CI
  (CI a -> b
f) <*> :: forall a b. CodeInfoOO (a -> b) -> CodeInfoOO a -> CodeInfoOO b
<*> (CI a
x) = b -> CodeInfoOO b
forall a. a -> CodeInfoOO a
CI (a -> b
f a
x)

instance Monad CodeInfoOO where
  CI a
x >>= :: forall a b. CodeInfoOO a -> (a -> CodeInfoOO b) -> CodeInfoOO b
>>= a -> CodeInfoOO b
f = a -> CodeInfoOO b
f a
x

instance SharedProg CodeInfoOO
instance OOProg CodeInfoOO

instance ProgramSym CodeInfoOO where
  type Program CodeInfoOO = GOOLState
  prog :: String -> String -> [SFile CodeInfoOO] -> GSProgram CodeInfoOO
prog String
_ String
_ [SFile CodeInfoOO]
fs = do
    (StateT FileState Identity (CodeInfoOO ())
 -> StateT GOOLState Identity (CodeInfoOO ()))
-> [StateT FileState Identity (CodeInfoOO ())]
-> StateT GOOLState Identity ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (LensLike'
  (Zoomed (StateT FileState Identity) (CodeInfoOO ()))
  GOOLState
  FileState
-> StateT FileState Identity (CodeInfoOO ())
-> StateT GOOLState Identity (CodeInfoOO ())
forall c.
LensLike'
  (Zoomed (StateT FileState Identity) c) GOOLState FileState
-> StateT FileState Identity c -> StateT GOOLState Identity c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (StateT FileState Identity) (CodeInfoOO ()))
  GOOLState
  FileState
(FileState -> Focusing Identity (CodeInfoOO ()) FileState)
-> GOOLState -> Focusing Identity (CodeInfoOO ()) GOOLState
Lens' GOOLState FileState
lensGStoFS) [StateT FileState Identity (CodeInfoOO ())]
[SFile CodeInfoOO]
fs
    (GOOLState -> GOOLState) -> StateT GOOLState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (GOOLState -> GOOLState
updateMEMWithCalls (GOOLState -> GOOLState)
-> (GOOLState -> GOOLState) -> GOOLState -> GOOLState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GOOLState -> GOOLState
callMapTransClosure)
    GOOLState
s <- StateT GOOLState Identity GOOLState
forall s (m :: * -> *). MonadState s m => m s
S.get
    CodeInfoOO GOOLState -> State GOOLState (CodeInfoOO GOOLState)
forall a s. a -> State s a
toState (CodeInfoOO GOOLState -> State GOOLState (CodeInfoOO GOOLState))
-> CodeInfoOO GOOLState -> State GOOLState (CodeInfoOO GOOLState)
forall a b. (a -> b) -> a -> b
$ GOOLState -> CodeInfoOO GOOLState
forall (r :: * -> *) a. Monad r => a -> r a
toCode GOOLState
s

instance FileSym CodeInfoOO where
  type File CodeInfoOO = ()
  fileDoc :: FSModule CodeInfoOO -> SFile CodeInfoOO
fileDoc = StateT FileState Identity (CodeInfoOO ())
-> StateT FileState Identity (CodeInfoOO ())
FSModule CodeInfoOO -> SFile CodeInfoOO
forall a. State a (CodeInfoOO ()) -> State a (CodeInfoOO ())
execute1
  
  docMod :: String
-> [String] -> String -> SFile CodeInfoOO -> SFile CodeInfoOO
docMod String
_ [String]
_ String
_ = StateT FileState Identity (CodeInfoOO ())
-> StateT FileState Identity (CodeInfoOO ())
SFile CodeInfoOO -> SFile CodeInfoOO
forall a. State a (CodeInfoOO ()) -> State a (CodeInfoOO ())
execute1

instance PermanenceSym CodeInfoOO where
  type Permanence CodeInfoOO = ()
  static :: CodeInfoOO (Permanence CodeInfoOO)
static  = () -> CodeInfoOO ()
forall (r :: * -> *) a. Monad r => a -> r a
toCode ()
  dynamic :: CodeInfoOO (Permanence CodeInfoOO)
dynamic = () -> CodeInfoOO ()
forall (r :: * -> *) a. Monad r => a -> r a
toCode ()

instance BodySym CodeInfoOO where
  type Body CodeInfoOO = ()
  body :: [MSBlock CodeInfoOO] -> MSBody CodeInfoOO
body = [State MethodState (CodeInfoOO ())]
-> State MethodState (CodeInfoOO ())
[MSBlock CodeInfoOO] -> MSBody CodeInfoOO
forall a. [State a (CodeInfoOO ())] -> State a (CodeInfoOO ())
executeList

  addComments :: String -> MSBody CodeInfoOO -> MSBody CodeInfoOO
addComments String
_ MSBody CodeInfoOO
_ = State MethodState (CodeInfoOO ())
MSBody CodeInfoOO
forall s. State s (CodeInfoOO ())
noInfo

instance BlockSym CodeInfoOO where
  type Block CodeInfoOO = ()
  block :: [MSStatement CodeInfoOO] -> MSBlock CodeInfoOO
block = [State MethodState (CodeInfoOO ())]
-> State MethodState (CodeInfoOO ())
[MSStatement CodeInfoOO] -> MSBlock CodeInfoOO
forall a. [State a (CodeInfoOO ())] -> State a (CodeInfoOO ())
executeList

instance TypeSym CodeInfoOO where
  type Type CodeInfoOO = String
  bool :: VSType CodeInfoOO
bool              = State ValueState (CodeInfoOO String)
VSType CodeInfoOO
forall s. State s (CodeInfoOO String)
noInfoType
  int :: VSType CodeInfoOO
int               = State ValueState (CodeInfoOO String)
VSType CodeInfoOO
forall s. State s (CodeInfoOO String)
noInfoType
  float :: VSType CodeInfoOO
float             = State ValueState (CodeInfoOO String)
VSType CodeInfoOO
forall s. State s (CodeInfoOO String)
noInfoType
  double :: VSType CodeInfoOO
double            = State ValueState (CodeInfoOO String)
VSType CodeInfoOO
forall s. State s (CodeInfoOO String)
noInfoType
  char :: VSType CodeInfoOO
char              = State ValueState (CodeInfoOO String)
VSType CodeInfoOO
forall s. State s (CodeInfoOO String)
noInfoType
  string :: VSType CodeInfoOO
string            = State ValueState (CodeInfoOO String)
VSType CodeInfoOO
forall s. State s (CodeInfoOO String)
noInfoType
  infile :: VSType CodeInfoOO
infile            = State ValueState (CodeInfoOO String)
VSType CodeInfoOO
forall s. State s (CodeInfoOO String)
noInfoType
  outfile :: VSType CodeInfoOO
outfile           = State ValueState (CodeInfoOO String)
VSType CodeInfoOO
forall s. State s (CodeInfoOO String)
noInfoType
  setType :: VSType CodeInfoOO -> VSType CodeInfoOO
setType       VSType CodeInfoOO
_   = State ValueState (CodeInfoOO String)
VSType CodeInfoOO
forall s. State s (CodeInfoOO String)
noInfoType
  listType :: VSType CodeInfoOO -> VSType CodeInfoOO
listType      VSType CodeInfoOO
_   = State ValueState (CodeInfoOO String)
VSType CodeInfoOO
forall s. State s (CodeInfoOO String)
noInfoType
  arrayType :: VSType CodeInfoOO -> VSType CodeInfoOO
arrayType     VSType CodeInfoOO
_   = State ValueState (CodeInfoOO String)
VSType CodeInfoOO
forall s. State s (CodeInfoOO String)
noInfoType
  listInnerType :: VSType CodeInfoOO -> VSType CodeInfoOO
listInnerType VSType CodeInfoOO
_   = State ValueState (CodeInfoOO String)
VSType CodeInfoOO
forall s. State s (CodeInfoOO String)
noInfoType
  funcType :: [VSType CodeInfoOO] -> VSType CodeInfoOO -> VSType CodeInfoOO
funcType      [VSType CodeInfoOO]
_ VSType CodeInfoOO
_ = State ValueState (CodeInfoOO String)
VSType CodeInfoOO
forall s. State s (CodeInfoOO String)
noInfoType
  void :: VSType CodeInfoOO
void              = State ValueState (CodeInfoOO String)
VSType CodeInfoOO
forall s. State s (CodeInfoOO String)
noInfoType

instance OOTypeSym CodeInfoOO where
  obj :: String -> VSType CodeInfoOO
obj               = CodeInfoOO String -> State ValueState (CodeInfoOO String)
forall a s. a -> State s a
toState (CodeInfoOO String -> State ValueState (CodeInfoOO String))
-> (String -> CodeInfoOO String)
-> String
-> State ValueState (CodeInfoOO String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> CodeInfoOO String
forall (r :: * -> *) a. Monad r => a -> r a
toCode

instance TypeElim CodeInfoOO where
  getType :: CodeInfoOO (Type CodeInfoOO) -> CodeType
getType CodeInfoOO (Type CodeInfoOO)
_     = CodeType
Void
  getTypeString :: CodeInfoOO (Type CodeInfoOO) -> String
getTypeString = CodeInfoOO String -> String
CodeInfoOO (Type CodeInfoOO) -> String
forall a. CodeInfoOO a -> a
unCI

instance ScopeSym CodeInfoOO where
  type Scope CodeInfoOO = ()
  global :: CodeInfoOO (Scope CodeInfoOO)
global = () -> CodeInfoOO ()
forall (r :: * -> *) a. Monad r => a -> r a
toCode ()
  mainFn :: CodeInfoOO (Scope CodeInfoOO)
mainFn = () -> CodeInfoOO ()
forall (r :: * -> *) a. Monad r => a -> r a
toCode ()
  local :: CodeInfoOO (Scope CodeInfoOO)
local = () -> CodeInfoOO ()
forall (r :: * -> *) a. Monad r => a -> r a
toCode ()

instance VariableSym CodeInfoOO where
  type Variable CodeInfoOO = ()
  var :: String -> VSType CodeInfoOO -> SVariable CodeInfoOO
var       String
_ VSType CodeInfoOO
_ = State ValueState (CodeInfoOO ())
SVariable CodeInfoOO
forall s. State s (CodeInfoOO ())
noInfo
  constant :: String -> VSType CodeInfoOO -> SVariable CodeInfoOO
constant  String
_ VSType CodeInfoOO
_ = State ValueState (CodeInfoOO ())
SVariable CodeInfoOO
forall s. State s (CodeInfoOO ())
noInfo
  extVar :: String -> String -> VSType CodeInfoOO -> SVariable CodeInfoOO
extVar  String
_ String
_ VSType CodeInfoOO
_ = State ValueState (CodeInfoOO ())
SVariable CodeInfoOO
forall s. State s (CodeInfoOO ())
noInfo
  arrayElem :: Integer -> SVariable CodeInfoOO -> SVariable CodeInfoOO
arrayElem Integer
_ SVariable CodeInfoOO
_ = State ValueState (CodeInfoOO ())
SVariable CodeInfoOO
forall s. State s (CodeInfoOO ())
noInfo

instance OOVariableSym CodeInfoOO where
  staticVar' :: Bool -> String -> VSType CodeInfoOO -> SVariable CodeInfoOO
staticVar'  Bool
_ String
_ VSType CodeInfoOO
_ = State ValueState (CodeInfoOO ())
SVariable CodeInfoOO
forall s. State s (CodeInfoOO ())
noInfo
  self :: SVariable CodeInfoOO
self              = State ValueState (CodeInfoOO ())
SVariable CodeInfoOO
forall s. State s (CodeInfoOO ())
noInfo
  classVar :: VSType CodeInfoOO -> SVariable CodeInfoOO -> SVariable CodeInfoOO
classVar    VSType CodeInfoOO
_ SVariable CodeInfoOO
_   = State ValueState (CodeInfoOO ())
SVariable CodeInfoOO
forall s. State s (CodeInfoOO ())
noInfo
  extClassVar :: VSType CodeInfoOO -> SVariable CodeInfoOO -> SVariable CodeInfoOO
extClassVar VSType CodeInfoOO
_ SVariable CodeInfoOO
_   = State ValueState (CodeInfoOO ())
SVariable CodeInfoOO
forall s. State s (CodeInfoOO ())
noInfo
  objVar :: SVariable CodeInfoOO
-> SVariable CodeInfoOO -> SVariable CodeInfoOO
objVar      SVariable CodeInfoOO
_ SVariable CodeInfoOO
_   = State ValueState (CodeInfoOO ())
SVariable CodeInfoOO
forall s. State s (CodeInfoOO ())
noInfo
  objVarSelf :: SVariable CodeInfoOO -> SVariable CodeInfoOO
objVarSelf  SVariable CodeInfoOO
_     = State ValueState (CodeInfoOO ())
SVariable CodeInfoOO
forall s. State s (CodeInfoOO ())
noInfo

instance VariableElim CodeInfoOO where
  variableName :: CodeInfoOO (Variable CodeInfoOO) -> String
variableName CodeInfoOO (Variable CodeInfoOO)
_ = String
""
  variableType :: CodeInfoOO (Variable CodeInfoOO) -> CodeInfoOO (Type CodeInfoOO)
variableType CodeInfoOO (Variable CodeInfoOO)
_ = String -> CodeInfoOO String
forall (r :: * -> *) a. Monad r => a -> r a
toCode String
""

instance ValueSym CodeInfoOO where
  type Value CodeInfoOO = ()
  valueType :: CodeInfoOO (Value CodeInfoOO) -> CodeInfoOO (Type CodeInfoOO)
valueType CodeInfoOO (Value CodeInfoOO)
_ = String -> CodeInfoOO String
forall (r :: * -> *) a. Monad r => a -> r a
toCode String
""

instance OOValueSym CodeInfoOO

instance Argument CodeInfoOO where
  pointerArg :: SValue CodeInfoOO -> SValue CodeInfoOO
pointerArg = State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
SValue CodeInfoOO -> SValue CodeInfoOO
forall a. a -> a
id

instance Literal CodeInfoOO where
  litTrue :: SValue CodeInfoOO
litTrue     = State ValueState (CodeInfoOO ())
SValue CodeInfoOO
forall s. State s (CodeInfoOO ())
noInfo
  litFalse :: SValue CodeInfoOO
litFalse    = State ValueState (CodeInfoOO ())
SValue CodeInfoOO
forall s. State s (CodeInfoOO ())
noInfo
  litChar :: Char -> SValue CodeInfoOO
litChar   Char
_ = State ValueState (CodeInfoOO ())
SValue CodeInfoOO
forall s. State s (CodeInfoOO ())
noInfo
  litDouble :: Double -> SValue CodeInfoOO
litDouble Double
_ = State ValueState (CodeInfoOO ())
SValue CodeInfoOO
forall s. State s (CodeInfoOO ())
noInfo
  litFloat :: Float -> SValue CodeInfoOO
litFloat  Float
_ = State ValueState (CodeInfoOO ())
SValue CodeInfoOO
forall s. State s (CodeInfoOO ())
noInfo
  litInt :: Integer -> SValue CodeInfoOO
litInt    Integer
_ = State ValueState (CodeInfoOO ())
SValue CodeInfoOO
forall s. State s (CodeInfoOO ())
noInfo
  litString :: String -> SValue CodeInfoOO
litString String
_ = State ValueState (CodeInfoOO ())
SValue CodeInfoOO
forall s. State s (CodeInfoOO ())
noInfo
  litArray :: VSType CodeInfoOO -> [SValue CodeInfoOO] -> SValue CodeInfoOO
litArray  VSType CodeInfoOO
_ = [State ValueState (CodeInfoOO ())]
-> State ValueState (CodeInfoOO ())
[SValue CodeInfoOO] -> SValue CodeInfoOO
forall a. [State a (CodeInfoOO ())] -> State a (CodeInfoOO ())
executeList
  litList :: VSType CodeInfoOO -> [SValue CodeInfoOO] -> SValue CodeInfoOO
litList   VSType CodeInfoOO
_ = [State ValueState (CodeInfoOO ())]
-> State ValueState (CodeInfoOO ())
[SValue CodeInfoOO] -> SValue CodeInfoOO
forall a. [State a (CodeInfoOO ())] -> State a (CodeInfoOO ())
executeList
  litSet :: VSType CodeInfoOO -> [SValue CodeInfoOO] -> SValue CodeInfoOO
litSet   VSType CodeInfoOO
_ = [State ValueState (CodeInfoOO ())]
-> State ValueState (CodeInfoOO ())
[SValue CodeInfoOO] -> SValue CodeInfoOO
forall a. [State a (CodeInfoOO ())] -> State a (CodeInfoOO ())
executeList

instance MathConstant CodeInfoOO where
  pi :: SValue CodeInfoOO
pi = State ValueState (CodeInfoOO ())
SValue CodeInfoOO
forall s. State s (CodeInfoOO ())
noInfo

instance VariableValue CodeInfoOO where
  valueOf :: SVariable CodeInfoOO -> SValue CodeInfoOO
valueOf SVariable CodeInfoOO
_ = State ValueState (CodeInfoOO ())
SValue CodeInfoOO
forall s. State s (CodeInfoOO ())
noInfo

instance OOVariableValue CodeInfoOO

instance CommandLineArgs CodeInfoOO where
  arg :: Integer -> SValue CodeInfoOO
arg       Integer
_ = State ValueState (CodeInfoOO ())
SValue CodeInfoOO
forall s. State s (CodeInfoOO ())
noInfo
  argsList :: SValue CodeInfoOO
argsList    = State ValueState (CodeInfoOO ())
SValue CodeInfoOO
forall s. State s (CodeInfoOO ())
noInfo
  argExists :: Integer -> SValue CodeInfoOO
argExists Integer
_ = State ValueState (CodeInfoOO ())
SValue CodeInfoOO
forall s. State s (CodeInfoOO ())
noInfo

instance NumericExpression CodeInfoOO where
  #~ :: SValue CodeInfoOO -> SValue CodeInfoOO
(#~)  = State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
SValue CodeInfoOO -> SValue CodeInfoOO
forall a. State a (CodeInfoOO ()) -> State a (CodeInfoOO ())
execute1
  #/^ :: SValue CodeInfoOO -> SValue CodeInfoOO
(#/^) = State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
SValue CodeInfoOO -> SValue CodeInfoOO
forall a. State a (CodeInfoOO ()) -> State a (CodeInfoOO ())
execute1
  #| :: SValue CodeInfoOO -> SValue CodeInfoOO
(#|)  = State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
SValue CodeInfoOO -> SValue CodeInfoOO
forall a. State a (CodeInfoOO ()) -> State a (CodeInfoOO ())
execute1
  #+ :: SValue CodeInfoOO -> SValue CodeInfoOO -> SValue CodeInfoOO
(#+)  = State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
SValue CodeInfoOO -> SValue CodeInfoOO -> SValue CodeInfoOO
forall a.
State a (CodeInfoOO ())
-> State a (CodeInfoOO ()) -> State a (CodeInfoOO ())
execute2
  #- :: SValue CodeInfoOO -> SValue CodeInfoOO -> SValue CodeInfoOO
(#-)  = State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
SValue CodeInfoOO -> SValue CodeInfoOO -> SValue CodeInfoOO
forall a.
State a (CodeInfoOO ())
-> State a (CodeInfoOO ()) -> State a (CodeInfoOO ())
execute2
  #* :: SValue CodeInfoOO -> SValue CodeInfoOO -> SValue CodeInfoOO
(#*)  = State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
SValue CodeInfoOO -> SValue CodeInfoOO -> SValue CodeInfoOO
forall a.
State a (CodeInfoOO ())
-> State a (CodeInfoOO ()) -> State a (CodeInfoOO ())
execute2
  #/ :: SValue CodeInfoOO -> SValue CodeInfoOO -> SValue CodeInfoOO
(#/)  = State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
SValue CodeInfoOO -> SValue CodeInfoOO -> SValue CodeInfoOO
forall a.
State a (CodeInfoOO ())
-> State a (CodeInfoOO ()) -> State a (CodeInfoOO ())
execute2
  #% :: SValue CodeInfoOO -> SValue CodeInfoOO -> SValue CodeInfoOO
(#%)  = State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
SValue CodeInfoOO -> SValue CodeInfoOO -> SValue CodeInfoOO
forall a.
State a (CodeInfoOO ())
-> State a (CodeInfoOO ()) -> State a (CodeInfoOO ())
execute2
  #^ :: SValue CodeInfoOO -> SValue CodeInfoOO -> SValue CodeInfoOO
(#^)  = State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
SValue CodeInfoOO -> SValue CodeInfoOO -> SValue CodeInfoOO
forall a.
State a (CodeInfoOO ())
-> State a (CodeInfoOO ()) -> State a (CodeInfoOO ())
execute2

  log :: SValue CodeInfoOO -> SValue CodeInfoOO
log    = State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
SValue CodeInfoOO -> SValue CodeInfoOO
forall a. State a (CodeInfoOO ()) -> State a (CodeInfoOO ())
execute1
  ln :: SValue CodeInfoOO -> SValue CodeInfoOO
ln     = State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
SValue CodeInfoOO -> SValue CodeInfoOO
forall a. State a (CodeInfoOO ()) -> State a (CodeInfoOO ())
execute1
  exp :: SValue CodeInfoOO -> SValue CodeInfoOO
exp    = State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
SValue CodeInfoOO -> SValue CodeInfoOO
forall a. State a (CodeInfoOO ()) -> State a (CodeInfoOO ())
execute1
  sin :: SValue CodeInfoOO -> SValue CodeInfoOO
sin    = State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
SValue CodeInfoOO -> SValue CodeInfoOO
forall a. State a (CodeInfoOO ()) -> State a (CodeInfoOO ())
execute1
  cos :: SValue CodeInfoOO -> SValue CodeInfoOO
cos    = State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
SValue CodeInfoOO -> SValue CodeInfoOO
forall a. State a (CodeInfoOO ()) -> State a (CodeInfoOO ())
execute1
  tan :: SValue CodeInfoOO -> SValue CodeInfoOO
tan    = State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
SValue CodeInfoOO -> SValue CodeInfoOO
forall a. State a (CodeInfoOO ()) -> State a (CodeInfoOO ())
execute1
  csc :: SValue CodeInfoOO -> SValue CodeInfoOO
csc    = State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
SValue CodeInfoOO -> SValue CodeInfoOO
forall a. State a (CodeInfoOO ()) -> State a (CodeInfoOO ())
execute1
  sec :: SValue CodeInfoOO -> SValue CodeInfoOO
sec    = State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
SValue CodeInfoOO -> SValue CodeInfoOO
forall a. State a (CodeInfoOO ()) -> State a (CodeInfoOO ())
execute1
  cot :: SValue CodeInfoOO -> SValue CodeInfoOO
cot    = State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
SValue CodeInfoOO -> SValue CodeInfoOO
forall a. State a (CodeInfoOO ()) -> State a (CodeInfoOO ())
execute1
  arcsin :: SValue CodeInfoOO -> SValue CodeInfoOO
arcsin = State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
SValue CodeInfoOO -> SValue CodeInfoOO
forall a. State a (CodeInfoOO ()) -> State a (CodeInfoOO ())
execute1
  arccos :: SValue CodeInfoOO -> SValue CodeInfoOO
arccos = State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
SValue CodeInfoOO -> SValue CodeInfoOO
forall a. State a (CodeInfoOO ()) -> State a (CodeInfoOO ())
execute1
  arctan :: SValue CodeInfoOO -> SValue CodeInfoOO
arctan = State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
SValue CodeInfoOO -> SValue CodeInfoOO
forall a. State a (CodeInfoOO ()) -> State a (CodeInfoOO ())
execute1
  floor :: SValue CodeInfoOO -> SValue CodeInfoOO
floor  = State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
SValue CodeInfoOO -> SValue CodeInfoOO
forall a. State a (CodeInfoOO ()) -> State a (CodeInfoOO ())
execute1
  ceil :: SValue CodeInfoOO -> SValue CodeInfoOO
ceil   = State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
SValue CodeInfoOO -> SValue CodeInfoOO
forall a. State a (CodeInfoOO ()) -> State a (CodeInfoOO ())
execute1

instance BooleanExpression CodeInfoOO where
  ?! :: SValue CodeInfoOO -> SValue CodeInfoOO
(?!)  = State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
SValue CodeInfoOO -> SValue CodeInfoOO
forall a. State a (CodeInfoOO ()) -> State a (CodeInfoOO ())
execute1
  ?&& :: SValue CodeInfoOO -> SValue CodeInfoOO -> SValue CodeInfoOO
(?&&) = State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
SValue CodeInfoOO -> SValue CodeInfoOO -> SValue CodeInfoOO
forall a.
State a (CodeInfoOO ())
-> State a (CodeInfoOO ()) -> State a (CodeInfoOO ())
execute2
  ?|| :: SValue CodeInfoOO -> SValue CodeInfoOO -> SValue CodeInfoOO
(?||) = State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
SValue CodeInfoOO -> SValue CodeInfoOO -> SValue CodeInfoOO
forall a.
State a (CodeInfoOO ())
-> State a (CodeInfoOO ()) -> State a (CodeInfoOO ())
execute2

instance Comparison CodeInfoOO where
  ?< :: SValue CodeInfoOO -> SValue CodeInfoOO -> SValue CodeInfoOO
(?<)  = State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
SValue CodeInfoOO -> SValue CodeInfoOO -> SValue CodeInfoOO
forall a.
State a (CodeInfoOO ())
-> State a (CodeInfoOO ()) -> State a (CodeInfoOO ())
execute2
  ?<= :: SValue CodeInfoOO -> SValue CodeInfoOO -> SValue CodeInfoOO
(?<=) = State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
SValue CodeInfoOO -> SValue CodeInfoOO -> SValue CodeInfoOO
forall a.
State a (CodeInfoOO ())
-> State a (CodeInfoOO ()) -> State a (CodeInfoOO ())
execute2
  ?> :: SValue CodeInfoOO -> SValue CodeInfoOO -> SValue CodeInfoOO
(?>)  = State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
SValue CodeInfoOO -> SValue CodeInfoOO -> SValue CodeInfoOO
forall a.
State a (CodeInfoOO ())
-> State a (CodeInfoOO ()) -> State a (CodeInfoOO ())
execute2
  ?>= :: SValue CodeInfoOO -> SValue CodeInfoOO -> SValue CodeInfoOO
(?>=) = State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
SValue CodeInfoOO -> SValue CodeInfoOO -> SValue CodeInfoOO
forall a.
State a (CodeInfoOO ())
-> State a (CodeInfoOO ()) -> State a (CodeInfoOO ())
execute2
  ?== :: SValue CodeInfoOO -> SValue CodeInfoOO -> SValue CodeInfoOO
(?==) = State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
SValue CodeInfoOO -> SValue CodeInfoOO -> SValue CodeInfoOO
forall a.
State a (CodeInfoOO ())
-> State a (CodeInfoOO ()) -> State a (CodeInfoOO ())
execute2
  ?!= :: SValue CodeInfoOO -> SValue CodeInfoOO -> SValue CodeInfoOO
(?!=) = State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
SValue CodeInfoOO -> SValue CodeInfoOO -> SValue CodeInfoOO
forall a.
State a (CodeInfoOO ())
-> State a (CodeInfoOO ()) -> State a (CodeInfoOO ())
execute2
    
instance ValueExpression CodeInfoOO where
  inlineIf :: SValue CodeInfoOO
-> SValue CodeInfoOO -> SValue CodeInfoOO -> SValue CodeInfoOO
inlineIf = State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
SValue CodeInfoOO
-> SValue CodeInfoOO -> SValue CodeInfoOO -> SValue CodeInfoOO
forall a.
State a (CodeInfoOO ())
-> State a (CodeInfoOO ())
-> State a (CodeInfoOO ())
-> State a (CodeInfoOO ())
execute3
  funcAppMixedArgs :: MixedCall CodeInfoOO
funcAppMixedArgs String
n VSType CodeInfoOO
_ = String
-> [State ValueState (CodeInfoOO ())]
-> [(State ValueState (CodeInfoOO ()),
     State ValueState (CodeInfoOO ()))]
-> State ValueState (CodeInfoOO ())
currModCall String
n
  extFuncAppMixedArgs :: String -> MixedCall CodeInfoOO
extFuncAppMixedArgs String
l String
n VSType CodeInfoOO
_ [SValue CodeInfoOO]
vs [(SVariable CodeInfoOO, SValue CodeInfoOO)]
ns = do
    [State ValueState (CodeInfoOO ())] -> StateT ValueState Identity ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [State ValueState (CodeInfoOO ())]
[SValue CodeInfoOO]
vs
    [(State ValueState (CodeInfoOO ()),
  State ValueState (CodeInfoOO ()))]
-> State ValueState (CodeInfoOO ())
forall a.
[(State a (CodeInfoOO ()), State a (CodeInfoOO ()))]
-> State a (CodeInfoOO ())
executePairList [(State ValueState (CodeInfoOO ()),
  State ValueState (CodeInfoOO ()))]
[(SVariable CodeInfoOO, SValue CodeInfoOO)]
ns
    String -> String -> SValue CodeInfoOO
addExternalCall String
l String
n  
  libFuncAppMixedArgs :: String -> MixedCall CodeInfoOO
libFuncAppMixedArgs = String -> MixedCall CodeInfoOO
forall (r :: * -> *). ValueExpression r => String -> MixedCall r
extFuncAppMixedArgs

  lambda :: [SVariable CodeInfoOO] -> SValue CodeInfoOO -> SValue CodeInfoOO
lambda [SVariable CodeInfoOO]
_ = State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
SValue CodeInfoOO -> SValue CodeInfoOO
forall a. State a (CodeInfoOO ()) -> State a (CodeInfoOO ())
execute1

  notNull :: SValue CodeInfoOO -> SValue CodeInfoOO
notNull = State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
SValue CodeInfoOO -> SValue CodeInfoOO
forall a. State a (CodeInfoOO ()) -> State a (CodeInfoOO ())
execute1

instance OOValueExpression CodeInfoOO where
  selfFuncAppMixedArgs :: MixedCall CodeInfoOO
selfFuncAppMixedArgs = MixedCall CodeInfoOO
forall (r :: * -> *). ValueExpression r => MixedCall r
funcAppMixedArgs
  newObjMixedArgs :: MixedCtorCall CodeInfoOO
newObjMixedArgs VSType CodeInfoOO
ot [SValue CodeInfoOO]
vs [(SVariable CodeInfoOO, SValue CodeInfoOO)]
ns = do
    [State ValueState (CodeInfoOO ())] -> StateT ValueState Identity ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [State ValueState (CodeInfoOO ())]
[SValue CodeInfoOO]
vs
    [(State ValueState (CodeInfoOO ()),
  State ValueState (CodeInfoOO ()))]
-> State ValueState (CodeInfoOO ())
forall a.
[(State a (CodeInfoOO ()), State a (CodeInfoOO ()))]
-> State a (CodeInfoOO ())
executePairList [(State ValueState (CodeInfoOO ()),
  State ValueState (CodeInfoOO ()))]
[(SVariable CodeInfoOO, SValue CodeInfoOO)]
ns
    VSType CodeInfoOO -> SValue CodeInfoOO
addCurrModConstructorCall VSType CodeInfoOO
ot
  extNewObjMixedArgs :: MixedCall CodeInfoOO
extNewObjMixedArgs String
l VSType CodeInfoOO
ot [SValue CodeInfoOO]
vs [(SVariable CodeInfoOO, SValue CodeInfoOO)]
ns = do
    [State ValueState (CodeInfoOO ())] -> StateT ValueState Identity ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [State ValueState (CodeInfoOO ())]
[SValue CodeInfoOO]
vs
    [(State ValueState (CodeInfoOO ()),
  State ValueState (CodeInfoOO ()))]
-> State ValueState (CodeInfoOO ())
forall a.
[(State a (CodeInfoOO ()), State a (CodeInfoOO ()))]
-> State a (CodeInfoOO ())
executePairList [(State ValueState (CodeInfoOO ()),
  State ValueState (CodeInfoOO ()))]
[(SVariable CodeInfoOO, SValue CodeInfoOO)]
ns
    String -> VSType CodeInfoOO -> SValue CodeInfoOO
addExternalConstructorCall String
l VSType CodeInfoOO
ot
  libNewObjMixedArgs :: MixedCall CodeInfoOO
libNewObjMixedArgs = MixedCall CodeInfoOO
forall (r :: * -> *). OOValueExpression r => MixedCall r
extNewObjMixedArgs
  
instance InternalValueExp CodeInfoOO where
  objMethodCallMixedArgs' :: String
-> VSType CodeInfoOO
-> SValue CodeInfoOO
-> [SValue CodeInfoOO]
-> [(SVariable CodeInfoOO, SValue CodeInfoOO)]
-> SValue CodeInfoOO
objMethodCallMixedArgs' String
n VSType CodeInfoOO
_ SValue CodeInfoOO
v [SValue CodeInfoOO]
vs [(SVariable CodeInfoOO, SValue CodeInfoOO)]
ns = State ValueState (CodeInfoOO ())
SValue CodeInfoOO
v State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
forall a b.
StateT ValueState Identity a
-> StateT ValueState Identity b -> StateT ValueState Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String
-> [State ValueState (CodeInfoOO ())]
-> [(State ValueState (CodeInfoOO ()),
     State ValueState (CodeInfoOO ()))]
-> State ValueState (CodeInfoOO ())
currModCall String
n [State ValueState (CodeInfoOO ())]
[SValue CodeInfoOO]
vs [(State ValueState (CodeInfoOO ()),
  State ValueState (CodeInfoOO ()))]
[(SVariable CodeInfoOO, SValue CodeInfoOO)]
ns

instance FunctionSym CodeInfoOO where
  type Function CodeInfoOO = ()

instance OOFunctionSym CodeInfoOO where
  func :: String
-> VSType CodeInfoOO
-> [SValue CodeInfoOO]
-> VSFunction CodeInfoOO
func  String
_ VSType CodeInfoOO
_ = [State ValueState (CodeInfoOO ())]
-> State ValueState (CodeInfoOO ())
[SValue CodeInfoOO] -> VSFunction CodeInfoOO
forall a. [State a (CodeInfoOO ())] -> State a (CodeInfoOO ())
executeList
  objAccess :: SValue CodeInfoOO -> VSFunction CodeInfoOO -> SValue CodeInfoOO
objAccess = State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
SValue CodeInfoOO -> VSFunction CodeInfoOO -> SValue CodeInfoOO
forall a.
State a (CodeInfoOO ())
-> State a (CodeInfoOO ()) -> State a (CodeInfoOO ())
execute2
  
instance GetSet CodeInfoOO where
  get :: SValue CodeInfoOO -> SVariable CodeInfoOO -> SValue CodeInfoOO
get SValue CodeInfoOO
v SVariable CodeInfoOO
_ = State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
forall a. State a (CodeInfoOO ()) -> State a (CodeInfoOO ())
execute1 State ValueState (CodeInfoOO ())
SValue CodeInfoOO
v
  set :: SValue CodeInfoOO
-> SVariable CodeInfoOO -> SValue CodeInfoOO -> SValue CodeInfoOO
set SValue CodeInfoOO
v SVariable CodeInfoOO
_ = State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
forall a.
State a (CodeInfoOO ())
-> State a (CodeInfoOO ()) -> State a (CodeInfoOO ())
execute2 State ValueState (CodeInfoOO ())
SValue CodeInfoOO
v

instance List CodeInfoOO where
  intToIndex :: SValue CodeInfoOO -> SValue CodeInfoOO
intToIndex = State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
SValue CodeInfoOO -> SValue CodeInfoOO
forall a. State a (CodeInfoOO ()) -> State a (CodeInfoOO ())
execute1
  indexToInt :: SValue CodeInfoOO -> SValue CodeInfoOO
indexToInt = State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
SValue CodeInfoOO -> SValue CodeInfoOO
forall a. State a (CodeInfoOO ()) -> State a (CodeInfoOO ())
execute1
  listSize :: SValue CodeInfoOO -> SValue CodeInfoOO
listSize   = State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
SValue CodeInfoOO -> SValue CodeInfoOO
forall a. State a (CodeInfoOO ()) -> State a (CodeInfoOO ())
execute1
  listAdd :: SValue CodeInfoOO
-> SValue CodeInfoOO -> SValue CodeInfoOO -> SValue CodeInfoOO
listAdd    = State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
SValue CodeInfoOO
-> SValue CodeInfoOO -> SValue CodeInfoOO -> SValue CodeInfoOO
forall a.
State a (CodeInfoOO ())
-> State a (CodeInfoOO ())
-> State a (CodeInfoOO ())
-> State a (CodeInfoOO ())
execute3
  listAppend :: SValue CodeInfoOO -> SValue CodeInfoOO -> SValue CodeInfoOO
listAppend = State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
SValue CodeInfoOO -> SValue CodeInfoOO -> SValue CodeInfoOO
forall a.
State a (CodeInfoOO ())
-> State a (CodeInfoOO ()) -> State a (CodeInfoOO ())
execute2
  listAccess :: SValue CodeInfoOO -> SValue CodeInfoOO -> SValue CodeInfoOO
listAccess = State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
SValue CodeInfoOO -> SValue CodeInfoOO -> SValue CodeInfoOO
forall a.
State a (CodeInfoOO ())
-> State a (CodeInfoOO ()) -> State a (CodeInfoOO ())
execute2
  listSet :: SValue CodeInfoOO
-> SValue CodeInfoOO -> SValue CodeInfoOO -> SValue CodeInfoOO
listSet    = State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
SValue CodeInfoOO
-> SValue CodeInfoOO -> SValue CodeInfoOO -> SValue CodeInfoOO
forall a.
State a (CodeInfoOO ())
-> State a (CodeInfoOO ())
-> State a (CodeInfoOO ())
-> State a (CodeInfoOO ())
execute3
  indexOf :: SValue CodeInfoOO -> SValue CodeInfoOO -> SValue CodeInfoOO
indexOf    = State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
SValue CodeInfoOO -> SValue CodeInfoOO -> SValue CodeInfoOO
forall a.
State a (CodeInfoOO ())
-> State a (CodeInfoOO ()) -> State a (CodeInfoOO ())
execute2

instance Set CodeInfoOO where
  contains :: SValue CodeInfoOO -> SValue CodeInfoOO -> SValue CodeInfoOO
contains = State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
SValue CodeInfoOO -> SValue CodeInfoOO -> SValue CodeInfoOO
forall a.
State a (CodeInfoOO ())
-> State a (CodeInfoOO ()) -> State a (CodeInfoOO ())
execute2
  setAdd :: SValue CodeInfoOO -> SValue CodeInfoOO -> SValue CodeInfoOO
setAdd = State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
SValue CodeInfoOO -> SValue CodeInfoOO -> SValue CodeInfoOO
forall a.
State a (CodeInfoOO ())
-> State a (CodeInfoOO ()) -> State a (CodeInfoOO ())
execute2
  setRemove :: SValue CodeInfoOO -> SValue CodeInfoOO -> SValue CodeInfoOO
setRemove = State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
SValue CodeInfoOO -> SValue CodeInfoOO -> SValue CodeInfoOO
forall a.
State a (CodeInfoOO ())
-> State a (CodeInfoOO ()) -> State a (CodeInfoOO ())
execute2
  setUnion :: SValue CodeInfoOO -> SValue CodeInfoOO -> SValue CodeInfoOO
setUnion = State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
SValue CodeInfoOO -> SValue CodeInfoOO -> SValue CodeInfoOO
forall a.
State a (CodeInfoOO ())
-> State a (CodeInfoOO ()) -> State a (CodeInfoOO ())
execute2

instance InternalList CodeInfoOO where
  listSlice' :: Maybe (SValue CodeInfoOO)
-> Maybe (SValue CodeInfoOO)
-> Maybe (SValue CodeInfoOO)
-> SVariable CodeInfoOO
-> SValue CodeInfoOO
-> MSBlock CodeInfoOO
listSlice' Maybe (SValue CodeInfoOO)
b Maybe (SValue CodeInfoOO)
e Maybe (SValue CodeInfoOO)
s SVariable CodeInfoOO
_ SValue CodeInfoOO
vl = LensLike'
  (Zoomed
     (StateT ValueState Identity) (CodeInfoOO (Block CodeInfoOO)))
  MethodState
  ValueState
-> StateT ValueState Identity (CodeInfoOO (Block CodeInfoOO))
-> MSBlock CodeInfoOO
forall c.
LensLike'
  (Zoomed (StateT ValueState Identity) c) MethodState ValueState
-> StateT ValueState Identity c -> StateT MethodState Identity c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed
     (StateT ValueState Identity) (CodeInfoOO (Block CodeInfoOO)))
  MethodState
  ValueState
(ValueState -> Focusing Identity (CodeInfoOO ()) ValueState)
-> MethodState -> Focusing Identity (CodeInfoOO ()) MethodState
Lens' MethodState ValueState
lensMStoVS (StateT ValueState Identity (CodeInfoOO (Block CodeInfoOO))
 -> MSBlock CodeInfoOO)
-> StateT ValueState Identity (CodeInfoOO (Block CodeInfoOO))
-> MSBlock CodeInfoOO
forall a b. (a -> b) -> a -> b
$ do
    (Maybe (State ValueState (CodeInfoOO ()))
 -> State ValueState (CodeInfoOO ()))
-> [Maybe (State ValueState (CodeInfoOO ()))]
-> StateT ValueState Identity ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (State ValueState (CodeInfoOO ())
-> Maybe (State ValueState (CodeInfoOO ()))
-> State ValueState (CodeInfoOO ())
forall a. a -> Maybe a -> a
fromMaybe State ValueState (CodeInfoOO ())
forall s. State s (CodeInfoOO ())
noInfo) [Maybe (State ValueState (CodeInfoOO ()))
Maybe (SValue CodeInfoOO)
b,Maybe (State ValueState (CodeInfoOO ()))
Maybe (SValue CodeInfoOO)
e,Maybe (State ValueState (CodeInfoOO ()))
Maybe (SValue CodeInfoOO)
s]
    CodeInfoOO ()
_ <- State ValueState (CodeInfoOO ())
SValue CodeInfoOO
vl
    State ValueState (CodeInfoOO ())
forall s. State s (CodeInfoOO ())
noInfo

instance ThunkSym CodeInfoOO where
  type Thunk CodeInfoOO = ()

instance ThunkAssign CodeInfoOO where
  thunkAssign :: SVariable CodeInfoOO
-> VSThunk CodeInfoOO -> MSStatement CodeInfoOO
thunkAssign SVariable CodeInfoOO
_ = LensLike'
  (Zoomed (StateT ValueState Identity) (CodeInfoOO ()))
  MethodState
  ValueState
-> State ValueState (CodeInfoOO ())
-> State MethodState (CodeInfoOO ())
forall c.
LensLike'
  (Zoomed (StateT ValueState Identity) c) MethodState ValueState
-> StateT ValueState Identity c -> StateT MethodState Identity c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (StateT ValueState Identity) (CodeInfoOO ()))
  MethodState
  ValueState
(ValueState -> Focusing Identity (CodeInfoOO ()) ValueState)
-> MethodState -> Focusing Identity (CodeInfoOO ()) MethodState
Lens' MethodState ValueState
lensMStoVS (State ValueState (CodeInfoOO ())
 -> State MethodState (CodeInfoOO ()))
-> (State ValueState (CodeInfoOO ())
    -> State ValueState (CodeInfoOO ()))
-> State ValueState (CodeInfoOO ())
-> State MethodState (CodeInfoOO ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
forall a. State a (CodeInfoOO ()) -> State a (CodeInfoOO ())
execute1

instance VectorType CodeInfoOO where
  vecType :: VSType CodeInfoOO -> VSType CodeInfoOO
vecType VSType CodeInfoOO
_ = State ValueState (CodeInfoOO String)
VSType CodeInfoOO
forall s. State s (CodeInfoOO String)
noInfoType

instance VectorDecl CodeInfoOO where
  vecDec :: Integer
-> SVariable CodeInfoOO
-> CodeInfoOO (Scope CodeInfoOO)
-> MSStatement CodeInfoOO
vecDec  Integer
_ SVariable CodeInfoOO
_ CodeInfoOO (Scope CodeInfoOO)
_ = State MethodState (CodeInfoOO ())
MSStatement CodeInfoOO
forall s. State s (CodeInfoOO ())
noInfo
  vecDecDef :: SVariable CodeInfoOO
-> CodeInfoOO (Scope CodeInfoOO)
-> [SValue CodeInfoOO]
-> MSStatement CodeInfoOO
vecDecDef SVariable CodeInfoOO
_ CodeInfoOO (Scope CodeInfoOO)
_ = LensLike'
  (Zoomed (StateT ValueState Identity) (CodeInfoOO ()))
  MethodState
  ValueState
-> State ValueState (CodeInfoOO ())
-> State MethodState (CodeInfoOO ())
forall c.
LensLike'
  (Zoomed (StateT ValueState Identity) c) MethodState ValueState
-> StateT ValueState Identity c -> StateT MethodState Identity c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (StateT ValueState Identity) (CodeInfoOO ()))
  MethodState
  ValueState
(ValueState -> Focusing Identity (CodeInfoOO ()) ValueState)
-> MethodState -> Focusing Identity (CodeInfoOO ()) MethodState
Lens' MethodState ValueState
lensMStoVS (State ValueState (CodeInfoOO ())
 -> State MethodState (CodeInfoOO ()))
-> ([State ValueState (CodeInfoOO ())]
    -> State ValueState (CodeInfoOO ()))
-> [State ValueState (CodeInfoOO ())]
-> State MethodState (CodeInfoOO ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [State ValueState (CodeInfoOO ())]
-> State ValueState (CodeInfoOO ())
forall a. [State a (CodeInfoOO ())] -> State a (CodeInfoOO ())
executeList

instance VectorThunk CodeInfoOO where
  vecThunk :: SVariable CodeInfoOO -> VSThunk CodeInfoOO
vecThunk SVariable CodeInfoOO
_ = State ValueState (CodeInfoOO ())
VSThunk CodeInfoOO
forall s. State s (CodeInfoOO ())
noInfo

instance VectorExpression CodeInfoOO where
  vecScale :: SValue CodeInfoOO -> VSThunk CodeInfoOO -> VSThunk CodeInfoOO
vecScale = State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
SValue CodeInfoOO -> VSThunk CodeInfoOO -> VSThunk CodeInfoOO
forall a.
State a (CodeInfoOO ())
-> State a (CodeInfoOO ()) -> State a (CodeInfoOO ())
execute2
  vecAdd :: VSThunk CodeInfoOO -> VSThunk CodeInfoOO -> VSThunk CodeInfoOO
vecAdd = State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
VSThunk CodeInfoOO -> VSThunk CodeInfoOO -> VSThunk CodeInfoOO
forall a.
State a (CodeInfoOO ())
-> State a (CodeInfoOO ()) -> State a (CodeInfoOO ())
execute2
  vecIndex :: SValue CodeInfoOO -> VSThunk CodeInfoOO -> SValue CodeInfoOO
vecIndex = State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
SValue CodeInfoOO -> VSThunk CodeInfoOO -> SValue CodeInfoOO
forall a.
State a (CodeInfoOO ())
-> State a (CodeInfoOO ()) -> State a (CodeInfoOO ())
execute2
  vecDot :: VSThunk CodeInfoOO -> VSThunk CodeInfoOO -> VSThunk CodeInfoOO
vecDot = State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
VSThunk CodeInfoOO -> VSThunk CodeInfoOO -> VSThunk CodeInfoOO
forall a.
State a (CodeInfoOO ())
-> State a (CodeInfoOO ()) -> State a (CodeInfoOO ())
execute2

instance StatementSym CodeInfoOO where
  type Statement CodeInfoOO = ()
  valStmt :: SValue CodeInfoOO -> MSStatement CodeInfoOO
valStmt = LensLike'
  (Zoomed (StateT ValueState Identity) (CodeInfoOO ()))
  MethodState
  ValueState
-> State ValueState (CodeInfoOO ())
-> State MethodState (CodeInfoOO ())
forall c.
LensLike'
  (Zoomed (StateT ValueState Identity) c) MethodState ValueState
-> StateT ValueState Identity c -> StateT MethodState Identity c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (StateT ValueState Identity) (CodeInfoOO ()))
  MethodState
  ValueState
(ValueState -> Focusing Identity (CodeInfoOO ()) ValueState)
-> MethodState -> Focusing Identity (CodeInfoOO ()) MethodState
Lens' MethodState ValueState
lensMStoVS (State ValueState (CodeInfoOO ())
 -> State MethodState (CodeInfoOO ()))
-> (State ValueState (CodeInfoOO ())
    -> State ValueState (CodeInfoOO ()))
-> State ValueState (CodeInfoOO ())
-> State MethodState (CodeInfoOO ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
forall a. State a (CodeInfoOO ()) -> State a (CodeInfoOO ())
execute1
  emptyStmt :: MSStatement CodeInfoOO
emptyStmt = State MethodState (CodeInfoOO ())
MSStatement CodeInfoOO
forall s. State s (CodeInfoOO ())
noInfo
  multi :: [MSStatement CodeInfoOO] -> MSStatement CodeInfoOO
multi    = [State MethodState (CodeInfoOO ())]
-> State MethodState (CodeInfoOO ())
[MSStatement CodeInfoOO] -> MSStatement CodeInfoOO
forall a. [State a (CodeInfoOO ())] -> State a (CodeInfoOO ())
executeList
  
instance AssignStatement CodeInfoOO where
  assign :: SVariable CodeInfoOO -> SValue CodeInfoOO -> MSStatement CodeInfoOO
assign SVariable CodeInfoOO
_ = LensLike'
  (Zoomed (StateT ValueState Identity) (CodeInfoOO ()))
  MethodState
  ValueState
-> State ValueState (CodeInfoOO ())
-> State MethodState (CodeInfoOO ())
forall c.
LensLike'
  (Zoomed (StateT ValueState Identity) c) MethodState ValueState
-> StateT ValueState Identity c -> StateT MethodState Identity c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (StateT ValueState Identity) (CodeInfoOO ()))
  MethodState
  ValueState
(ValueState -> Focusing Identity (CodeInfoOO ()) ValueState)
-> MethodState -> Focusing Identity (CodeInfoOO ()) MethodState
Lens' MethodState ValueState
lensMStoVS (State ValueState (CodeInfoOO ())
 -> State MethodState (CodeInfoOO ()))
-> (State ValueState (CodeInfoOO ())
    -> State ValueState (CodeInfoOO ()))
-> State ValueState (CodeInfoOO ())
-> State MethodState (CodeInfoOO ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
forall a. State a (CodeInfoOO ()) -> State a (CodeInfoOO ())
execute1
  &-= :: SVariable CodeInfoOO -> SValue CodeInfoOO -> MSStatement CodeInfoOO
(&-=)  SVariable CodeInfoOO
_ = LensLike'
  (Zoomed (StateT ValueState Identity) (CodeInfoOO ()))
  MethodState
  ValueState
-> State ValueState (CodeInfoOO ())
-> State MethodState (CodeInfoOO ())
forall c.
LensLike'
  (Zoomed (StateT ValueState Identity) c) MethodState ValueState
-> StateT ValueState Identity c -> StateT MethodState Identity c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (StateT ValueState Identity) (CodeInfoOO ()))
  MethodState
  ValueState
(ValueState -> Focusing Identity (CodeInfoOO ()) ValueState)
-> MethodState -> Focusing Identity (CodeInfoOO ()) MethodState
Lens' MethodState ValueState
lensMStoVS (State ValueState (CodeInfoOO ())
 -> State MethodState (CodeInfoOO ()))
-> (State ValueState (CodeInfoOO ())
    -> State ValueState (CodeInfoOO ()))
-> State ValueState (CodeInfoOO ())
-> State MethodState (CodeInfoOO ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
forall a. State a (CodeInfoOO ()) -> State a (CodeInfoOO ())
execute1
  &+= :: SVariable CodeInfoOO -> SValue CodeInfoOO -> MSStatement CodeInfoOO
(&+=)  SVariable CodeInfoOO
_ = LensLike'
  (Zoomed (StateT ValueState Identity) (CodeInfoOO ()))
  MethodState
  ValueState
-> State ValueState (CodeInfoOO ())
-> State MethodState (CodeInfoOO ())
forall c.
LensLike'
  (Zoomed (StateT ValueState Identity) c) MethodState ValueState
-> StateT ValueState Identity c -> StateT MethodState Identity c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (StateT ValueState Identity) (CodeInfoOO ()))
  MethodState
  ValueState
(ValueState -> Focusing Identity (CodeInfoOO ()) ValueState)
-> MethodState -> Focusing Identity (CodeInfoOO ()) MethodState
Lens' MethodState ValueState
lensMStoVS (State ValueState (CodeInfoOO ())
 -> State MethodState (CodeInfoOO ()))
-> (State ValueState (CodeInfoOO ())
    -> State ValueState (CodeInfoOO ()))
-> State ValueState (CodeInfoOO ())
-> State MethodState (CodeInfoOO ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
forall a. State a (CodeInfoOO ()) -> State a (CodeInfoOO ())
execute1
  &++ :: SVariable CodeInfoOO -> MSStatement CodeInfoOO
(&++)  SVariable CodeInfoOO
_ = State MethodState (CodeInfoOO ())
MSStatement CodeInfoOO
forall s. State s (CodeInfoOO ())
noInfo
  &-- :: SVariable CodeInfoOO -> MSStatement CodeInfoOO
(&--)  SVariable CodeInfoOO
_ = State MethodState (CodeInfoOO ())
MSStatement CodeInfoOO
forall s. State s (CodeInfoOO ())
noInfo

instance DeclStatement CodeInfoOO where
  varDec :: SVariable CodeInfoOO
-> CodeInfoOO (Scope CodeInfoOO) -> MSStatement CodeInfoOO
varDec               SVariable CodeInfoOO
_ CodeInfoOO (Scope CodeInfoOO)
_ = State MethodState (CodeInfoOO ())
MSStatement CodeInfoOO
forall s. State s (CodeInfoOO ())
noInfo
  varDecDef :: SVariable CodeInfoOO
-> CodeInfoOO (Scope CodeInfoOO)
-> SValue CodeInfoOO
-> MSStatement CodeInfoOO
varDecDef            SVariable CodeInfoOO
_ CodeInfoOO (Scope CodeInfoOO)
_ = LensLike'
  (Zoomed (StateT ValueState Identity) (CodeInfoOO ()))
  MethodState
  ValueState
-> State ValueState (CodeInfoOO ())
-> State MethodState (CodeInfoOO ())
forall c.
LensLike'
  (Zoomed (StateT ValueState Identity) c) MethodState ValueState
-> StateT ValueState Identity c -> StateT MethodState Identity c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (StateT ValueState Identity) (CodeInfoOO ()))
  MethodState
  ValueState
(ValueState -> Focusing Identity (CodeInfoOO ()) ValueState)
-> MethodState -> Focusing Identity (CodeInfoOO ()) MethodState
Lens' MethodState ValueState
lensMStoVS (State ValueState (CodeInfoOO ())
 -> State MethodState (CodeInfoOO ()))
-> (State ValueState (CodeInfoOO ())
    -> State ValueState (CodeInfoOO ()))
-> State ValueState (CodeInfoOO ())
-> State MethodState (CodeInfoOO ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
forall a. State a (CodeInfoOO ()) -> State a (CodeInfoOO ())
execute1
  setDec :: SVariable CodeInfoOO
-> CodeInfoOO (Scope CodeInfoOO) -> MSStatement CodeInfoOO
setDec               SVariable CodeInfoOO
_ CodeInfoOO (Scope CodeInfoOO)
_ = State MethodState (CodeInfoOO ())
MSStatement CodeInfoOO
forall s. State s (CodeInfoOO ())
noInfo
  setDecDef :: SVariable CodeInfoOO
-> CodeInfoOO (Scope CodeInfoOO)
-> SValue CodeInfoOO
-> MSStatement CodeInfoOO
setDecDef            SVariable CodeInfoOO
_ CodeInfoOO (Scope CodeInfoOO)
_ = LensLike'
  (Zoomed (StateT ValueState Identity) (CodeInfoOO ()))
  MethodState
  ValueState
-> State ValueState (CodeInfoOO ())
-> State MethodState (CodeInfoOO ())
forall c.
LensLike'
  (Zoomed (StateT ValueState Identity) c) MethodState ValueState
-> StateT ValueState Identity c -> StateT MethodState Identity c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (StateT ValueState Identity) (CodeInfoOO ()))
  MethodState
  ValueState
(ValueState -> Focusing Identity (CodeInfoOO ()) ValueState)
-> MethodState -> Focusing Identity (CodeInfoOO ()) MethodState
Lens' MethodState ValueState
lensMStoVS (State ValueState (CodeInfoOO ())
 -> State MethodState (CodeInfoOO ()))
-> (State ValueState (CodeInfoOO ())
    -> State ValueState (CodeInfoOO ()))
-> State ValueState (CodeInfoOO ())
-> State MethodState (CodeInfoOO ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
forall a. State a (CodeInfoOO ()) -> State a (CodeInfoOO ())
execute1
  listDec :: Integer
-> SVariable CodeInfoOO
-> CodeInfoOO (Scope CodeInfoOO)
-> MSStatement CodeInfoOO
listDec            Integer
_ SVariable CodeInfoOO
_ CodeInfoOO (Scope CodeInfoOO)
_ = State MethodState (CodeInfoOO ())
MSStatement CodeInfoOO
forall s. State s (CodeInfoOO ())
noInfo
  listDecDef :: SVariable CodeInfoOO
-> CodeInfoOO (Scope CodeInfoOO)
-> [SValue CodeInfoOO]
-> MSStatement CodeInfoOO
listDecDef           SVariable CodeInfoOO
_ CodeInfoOO (Scope CodeInfoOO)
_ = LensLike'
  (Zoomed (StateT ValueState Identity) (CodeInfoOO ()))
  MethodState
  ValueState
-> State ValueState (CodeInfoOO ())
-> State MethodState (CodeInfoOO ())
forall c.
LensLike'
  (Zoomed (StateT ValueState Identity) c) MethodState ValueState
-> StateT ValueState Identity c -> StateT MethodState Identity c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (StateT ValueState Identity) (CodeInfoOO ()))
  MethodState
  ValueState
(ValueState -> Focusing Identity (CodeInfoOO ()) ValueState)
-> MethodState -> Focusing Identity (CodeInfoOO ()) MethodState
Lens' MethodState ValueState
lensMStoVS (State ValueState (CodeInfoOO ())
 -> State MethodState (CodeInfoOO ()))
-> ([State ValueState (CodeInfoOO ())]
    -> State ValueState (CodeInfoOO ()))
-> [State ValueState (CodeInfoOO ())]
-> State MethodState (CodeInfoOO ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [State ValueState (CodeInfoOO ())]
-> State ValueState (CodeInfoOO ())
forall a. [State a (CodeInfoOO ())] -> State a (CodeInfoOO ())
executeList
  arrayDec :: Integer
-> SVariable CodeInfoOO
-> CodeInfoOO (Scope CodeInfoOO)
-> MSStatement CodeInfoOO
arrayDec           Integer
_ SVariable CodeInfoOO
_ CodeInfoOO (Scope CodeInfoOO)
_ = State MethodState (CodeInfoOO ())
MSStatement CodeInfoOO
forall s. State s (CodeInfoOO ())
noInfo
  arrayDecDef :: SVariable CodeInfoOO
-> CodeInfoOO (Scope CodeInfoOO)
-> [SValue CodeInfoOO]
-> MSStatement CodeInfoOO
arrayDecDef          SVariable CodeInfoOO
_ CodeInfoOO (Scope CodeInfoOO)
_ = LensLike'
  (Zoomed (StateT ValueState Identity) (CodeInfoOO ()))
  MethodState
  ValueState
-> State ValueState (CodeInfoOO ())
-> State MethodState (CodeInfoOO ())
forall c.
LensLike'
  (Zoomed (StateT ValueState Identity) c) MethodState ValueState
-> StateT ValueState Identity c -> StateT MethodState Identity c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (StateT ValueState Identity) (CodeInfoOO ()))
  MethodState
  ValueState
(ValueState -> Focusing Identity (CodeInfoOO ()) ValueState)
-> MethodState -> Focusing Identity (CodeInfoOO ()) MethodState
Lens' MethodState ValueState
lensMStoVS (State ValueState (CodeInfoOO ())
 -> State MethodState (CodeInfoOO ()))
-> ([State ValueState (CodeInfoOO ())]
    -> State ValueState (CodeInfoOO ()))
-> [State ValueState (CodeInfoOO ())]
-> State MethodState (CodeInfoOO ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [State ValueState (CodeInfoOO ())]
-> State ValueState (CodeInfoOO ())
forall a. [State a (CodeInfoOO ())] -> State a (CodeInfoOO ())
executeList
  constDecDef :: SVariable CodeInfoOO
-> CodeInfoOO (Scope CodeInfoOO)
-> SValue CodeInfoOO
-> MSStatement CodeInfoOO
constDecDef          SVariable CodeInfoOO
_ CodeInfoOO (Scope CodeInfoOO)
_ = LensLike'
  (Zoomed (StateT ValueState Identity) (CodeInfoOO ()))
  MethodState
  ValueState
-> State ValueState (CodeInfoOO ())
-> State MethodState (CodeInfoOO ())
forall c.
LensLike'
  (Zoomed (StateT ValueState Identity) c) MethodState ValueState
-> StateT ValueState Identity c -> StateT MethodState Identity c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (StateT ValueState Identity) (CodeInfoOO ()))
  MethodState
  ValueState
(ValueState -> Focusing Identity (CodeInfoOO ()) ValueState)
-> MethodState -> Focusing Identity (CodeInfoOO ()) MethodState
Lens' MethodState ValueState
lensMStoVS (State ValueState (CodeInfoOO ())
 -> State MethodState (CodeInfoOO ()))
-> (State ValueState (CodeInfoOO ())
    -> State ValueState (CodeInfoOO ()))
-> State ValueState (CodeInfoOO ())
-> State MethodState (CodeInfoOO ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
forall a. State a (CodeInfoOO ()) -> State a (CodeInfoOO ())
execute1
  funcDecDef :: SVariable CodeInfoOO
-> CodeInfoOO (Scope CodeInfoOO)
-> [SVariable CodeInfoOO]
-> MSBody CodeInfoOO
-> MSStatement CodeInfoOO
funcDecDef         SVariable CodeInfoOO
_ CodeInfoOO (Scope CodeInfoOO)
_ [SVariable CodeInfoOO]
_ = State MethodState (CodeInfoOO ())
-> State MethodState (CodeInfoOO ())
MSBody CodeInfoOO -> MSStatement CodeInfoOO
forall a. State a (CodeInfoOO ()) -> State a (CodeInfoOO ())
execute1

instance OODeclStatement CodeInfoOO where
  objDecDef :: SVariable CodeInfoOO
-> CodeInfoOO (Scope CodeInfoOO)
-> SValue CodeInfoOO
-> MSStatement CodeInfoOO
objDecDef            SVariable CodeInfoOO
_ CodeInfoOO (Scope CodeInfoOO)
_ = LensLike'
  (Zoomed (StateT ValueState Identity) (CodeInfoOO ()))
  MethodState
  ValueState
-> State ValueState (CodeInfoOO ())
-> State MethodState (CodeInfoOO ())
forall c.
LensLike'
  (Zoomed (StateT ValueState Identity) c) MethodState ValueState
-> StateT ValueState Identity c -> StateT MethodState Identity c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (StateT ValueState Identity) (CodeInfoOO ()))
  MethodState
  ValueState
(ValueState -> Focusing Identity (CodeInfoOO ()) ValueState)
-> MethodState -> Focusing Identity (CodeInfoOO ()) MethodState
Lens' MethodState ValueState
lensMStoVS (State ValueState (CodeInfoOO ())
 -> State MethodState (CodeInfoOO ()))
-> (State ValueState (CodeInfoOO ())
    -> State ValueState (CodeInfoOO ()))
-> State ValueState (CodeInfoOO ())
-> State MethodState (CodeInfoOO ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
forall a. State a (CodeInfoOO ()) -> State a (CodeInfoOO ())
execute1
  objDecNew :: SVariable CodeInfoOO
-> CodeInfoOO (Scope CodeInfoOO)
-> [SValue CodeInfoOO]
-> MSStatement CodeInfoOO
objDecNew            SVariable CodeInfoOO
_ CodeInfoOO (Scope CodeInfoOO)
_ = LensLike'
  (Zoomed (StateT ValueState Identity) (CodeInfoOO ()))
  MethodState
  ValueState
-> State ValueState (CodeInfoOO ())
-> State MethodState (CodeInfoOO ())
forall c.
LensLike'
  (Zoomed (StateT ValueState Identity) c) MethodState ValueState
-> StateT ValueState Identity c -> StateT MethodState Identity c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (StateT ValueState Identity) (CodeInfoOO ()))
  MethodState
  ValueState
(ValueState -> Focusing Identity (CodeInfoOO ()) ValueState)
-> MethodState -> Focusing Identity (CodeInfoOO ()) MethodState
Lens' MethodState ValueState
lensMStoVS (State ValueState (CodeInfoOO ())
 -> State MethodState (CodeInfoOO ()))
-> ([State ValueState (CodeInfoOO ())]
    -> State ValueState (CodeInfoOO ()))
-> [State ValueState (CodeInfoOO ())]
-> State MethodState (CodeInfoOO ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [State ValueState (CodeInfoOO ())]
-> State ValueState (CodeInfoOO ())
forall a. [State a (CodeInfoOO ())] -> State a (CodeInfoOO ())
executeList
  extObjDecNew :: String
-> SVariable CodeInfoOO
-> CodeInfoOO (Scope CodeInfoOO)
-> [SValue CodeInfoOO]
-> MSStatement CodeInfoOO
extObjDecNew       String
_ SVariable CodeInfoOO
_ CodeInfoOO (Scope CodeInfoOO)
_ = LensLike'
  (Zoomed (StateT ValueState Identity) (CodeInfoOO ()))
  MethodState
  ValueState
-> State ValueState (CodeInfoOO ())
-> State MethodState (CodeInfoOO ())
forall c.
LensLike'
  (Zoomed (StateT ValueState Identity) c) MethodState ValueState
-> StateT ValueState Identity c -> StateT MethodState Identity c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (StateT ValueState Identity) (CodeInfoOO ()))
  MethodState
  ValueState
(ValueState -> Focusing Identity (CodeInfoOO ()) ValueState)
-> MethodState -> Focusing Identity (CodeInfoOO ()) MethodState
Lens' MethodState ValueState
lensMStoVS (State ValueState (CodeInfoOO ())
 -> State MethodState (CodeInfoOO ()))
-> ([State ValueState (CodeInfoOO ())]
    -> State ValueState (CodeInfoOO ()))
-> [State ValueState (CodeInfoOO ())]
-> State MethodState (CodeInfoOO ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [State ValueState (CodeInfoOO ())]
-> State ValueState (CodeInfoOO ())
forall a. [State a (CodeInfoOO ())] -> State a (CodeInfoOO ())
executeList

instance IOStatement CodeInfoOO where
  print :: SValue CodeInfoOO -> MSStatement CodeInfoOO
print        = LensLike'
  (Zoomed (StateT ValueState Identity) (CodeInfoOO ()))
  MethodState
  ValueState
-> State ValueState (CodeInfoOO ())
-> State MethodState (CodeInfoOO ())
forall c.
LensLike'
  (Zoomed (StateT ValueState Identity) c) MethodState ValueState
-> StateT ValueState Identity c -> StateT MethodState Identity c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (StateT ValueState Identity) (CodeInfoOO ()))
  MethodState
  ValueState
(ValueState -> Focusing Identity (CodeInfoOO ()) ValueState)
-> MethodState -> Focusing Identity (CodeInfoOO ()) MethodState
Lens' MethodState ValueState
lensMStoVS (State ValueState (CodeInfoOO ())
 -> State MethodState (CodeInfoOO ()))
-> (State ValueState (CodeInfoOO ())
    -> State ValueState (CodeInfoOO ()))
-> State ValueState (CodeInfoOO ())
-> State MethodState (CodeInfoOO ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
forall a. State a (CodeInfoOO ()) -> State a (CodeInfoOO ())
execute1
  printLn :: SValue CodeInfoOO -> MSStatement CodeInfoOO
printLn      = LensLike'
  (Zoomed (StateT ValueState Identity) (CodeInfoOO ()))
  MethodState
  ValueState
-> State ValueState (CodeInfoOO ())
-> State MethodState (CodeInfoOO ())
forall c.
LensLike'
  (Zoomed (StateT ValueState Identity) c) MethodState ValueState
-> StateT ValueState Identity c -> StateT MethodState Identity c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (StateT ValueState Identity) (CodeInfoOO ()))
  MethodState
  ValueState
(ValueState -> Focusing Identity (CodeInfoOO ()) ValueState)
-> MethodState -> Focusing Identity (CodeInfoOO ()) MethodState
Lens' MethodState ValueState
lensMStoVS (State ValueState (CodeInfoOO ())
 -> State MethodState (CodeInfoOO ()))
-> (State ValueState (CodeInfoOO ())
    -> State ValueState (CodeInfoOO ()))
-> State ValueState (CodeInfoOO ())
-> State MethodState (CodeInfoOO ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
forall a. State a (CodeInfoOO ()) -> State a (CodeInfoOO ())
execute1
  printStr :: String -> MSStatement CodeInfoOO
printStr   String
_ = State MethodState (CodeInfoOO ())
MSStatement CodeInfoOO
forall s. State s (CodeInfoOO ())
noInfo
  printStrLn :: String -> MSStatement CodeInfoOO
printStrLn String
_ = State MethodState (CodeInfoOO ())
MSStatement CodeInfoOO
forall s. State s (CodeInfoOO ())
noInfo

  printFile :: SValue CodeInfoOO -> SValue CodeInfoOO -> MSStatement CodeInfoOO
printFile      SValue CodeInfoOO
v   = LensLike'
  (Zoomed (StateT ValueState Identity) (CodeInfoOO ()))
  MethodState
  ValueState
-> State ValueState (CodeInfoOO ())
-> State MethodState (CodeInfoOO ())
forall c.
LensLike'
  (Zoomed (StateT ValueState Identity) c) MethodState ValueState
-> StateT ValueState Identity c -> StateT MethodState Identity c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (StateT ValueState Identity) (CodeInfoOO ()))
  MethodState
  ValueState
(ValueState -> Focusing Identity (CodeInfoOO ()) ValueState)
-> MethodState -> Focusing Identity (CodeInfoOO ()) MethodState
Lens' MethodState ValueState
lensMStoVS (State ValueState (CodeInfoOO ())
 -> State MethodState (CodeInfoOO ()))
-> (State ValueState (CodeInfoOO ())
    -> State ValueState (CodeInfoOO ()))
-> State ValueState (CodeInfoOO ())
-> State MethodState (CodeInfoOO ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
forall a.
State a (CodeInfoOO ())
-> State a (CodeInfoOO ()) -> State a (CodeInfoOO ())
execute2 State ValueState (CodeInfoOO ())
SValue CodeInfoOO
v
  printFileLn :: SValue CodeInfoOO -> SValue CodeInfoOO -> MSStatement CodeInfoOO
printFileLn    SValue CodeInfoOO
v   = LensLike'
  (Zoomed (StateT ValueState Identity) (CodeInfoOO ()))
  MethodState
  ValueState
-> State ValueState (CodeInfoOO ())
-> State MethodState (CodeInfoOO ())
forall c.
LensLike'
  (Zoomed (StateT ValueState Identity) c) MethodState ValueState
-> StateT ValueState Identity c -> StateT MethodState Identity c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (StateT ValueState Identity) (CodeInfoOO ()))
  MethodState
  ValueState
(ValueState -> Focusing Identity (CodeInfoOO ()) ValueState)
-> MethodState -> Focusing Identity (CodeInfoOO ()) MethodState
Lens' MethodState ValueState
lensMStoVS (State ValueState (CodeInfoOO ())
 -> State MethodState (CodeInfoOO ()))
-> (State ValueState (CodeInfoOO ())
    -> State ValueState (CodeInfoOO ()))
-> State ValueState (CodeInfoOO ())
-> State MethodState (CodeInfoOO ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
forall a.
State a (CodeInfoOO ())
-> State a (CodeInfoOO ()) -> State a (CodeInfoOO ())
execute2 State ValueState (CodeInfoOO ())
SValue CodeInfoOO
v
  printFileStr :: SValue CodeInfoOO -> String -> MSStatement CodeInfoOO
printFileStr   SValue CodeInfoOO
v String
_ = LensLike'
  (Zoomed
     (StateT ValueState Identity) (CodeInfoOO (Statement CodeInfoOO)))
  MethodState
  ValueState
-> StateT ValueState Identity (CodeInfoOO (Statement CodeInfoOO))
-> MSStatement CodeInfoOO
forall c.
LensLike'
  (Zoomed (StateT ValueState Identity) c) MethodState ValueState
-> StateT ValueState Identity c -> StateT MethodState Identity c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed
     (StateT ValueState Identity) (CodeInfoOO (Statement CodeInfoOO)))
  MethodState
  ValueState
(ValueState -> Focusing Identity (CodeInfoOO ()) ValueState)
-> MethodState -> Focusing Identity (CodeInfoOO ()) MethodState
Lens' MethodState ValueState
lensMStoVS (StateT ValueState Identity (CodeInfoOO (Statement CodeInfoOO))
 -> MSStatement CodeInfoOO)
-> StateT ValueState Identity (CodeInfoOO (Statement CodeInfoOO))
-> MSStatement CodeInfoOO
forall a b. (a -> b) -> a -> b
$ State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
forall a. State a (CodeInfoOO ()) -> State a (CodeInfoOO ())
execute1 State ValueState (CodeInfoOO ())
SValue CodeInfoOO
v
  printFileStrLn :: SValue CodeInfoOO -> String -> MSStatement CodeInfoOO
printFileStrLn SValue CodeInfoOO
v String
_ = LensLike'
  (Zoomed
     (StateT ValueState Identity) (CodeInfoOO (Statement CodeInfoOO)))
  MethodState
  ValueState
-> StateT ValueState Identity (CodeInfoOO (Statement CodeInfoOO))
-> MSStatement CodeInfoOO
forall c.
LensLike'
  (Zoomed (StateT ValueState Identity) c) MethodState ValueState
-> StateT ValueState Identity c -> StateT MethodState Identity c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed
     (StateT ValueState Identity) (CodeInfoOO (Statement CodeInfoOO)))
  MethodState
  ValueState
(ValueState -> Focusing Identity (CodeInfoOO ()) ValueState)
-> MethodState -> Focusing Identity (CodeInfoOO ()) MethodState
Lens' MethodState ValueState
lensMStoVS (StateT ValueState Identity (CodeInfoOO (Statement CodeInfoOO))
 -> MSStatement CodeInfoOO)
-> StateT ValueState Identity (CodeInfoOO (Statement CodeInfoOO))
-> MSStatement CodeInfoOO
forall a b. (a -> b) -> a -> b
$ State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
forall a. State a (CodeInfoOO ()) -> State a (CodeInfoOO ())
execute1 State ValueState (CodeInfoOO ())
SValue CodeInfoOO
v

  getInput :: SVariable CodeInfoOO -> MSStatement CodeInfoOO
getInput       SVariable CodeInfoOO
_ = State MethodState (CodeInfoOO ())
MSStatement CodeInfoOO
forall s. State s (CodeInfoOO ())
noInfo
  discardInput :: MSStatement CodeInfoOO
discardInput     = State MethodState (CodeInfoOO ())
MSStatement CodeInfoOO
forall s. State s (CodeInfoOO ())
noInfo
  getFileInput :: SValue CodeInfoOO -> SVariable CodeInfoOO -> MSStatement CodeInfoOO
getFileInput SValue CodeInfoOO
v SVariable CodeInfoOO
_ = LensLike'
  (Zoomed
     (StateT ValueState Identity) (CodeInfoOO (Statement CodeInfoOO)))
  MethodState
  ValueState
-> StateT ValueState Identity (CodeInfoOO (Statement CodeInfoOO))
-> MSStatement CodeInfoOO
forall c.
LensLike'
  (Zoomed (StateT ValueState Identity) c) MethodState ValueState
-> StateT ValueState Identity c -> StateT MethodState Identity c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed
     (StateT ValueState Identity) (CodeInfoOO (Statement CodeInfoOO)))
  MethodState
  ValueState
(ValueState -> Focusing Identity (CodeInfoOO ()) ValueState)
-> MethodState -> Focusing Identity (CodeInfoOO ()) MethodState
Lens' MethodState ValueState
lensMStoVS (StateT ValueState Identity (CodeInfoOO (Statement CodeInfoOO))
 -> MSStatement CodeInfoOO)
-> StateT ValueState Identity (CodeInfoOO (Statement CodeInfoOO))
-> MSStatement CodeInfoOO
forall a b. (a -> b) -> a -> b
$ State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
forall a. State a (CodeInfoOO ()) -> State a (CodeInfoOO ())
execute1 State ValueState (CodeInfoOO ())
SValue CodeInfoOO
v
  discardFileInput :: SValue CodeInfoOO -> MSStatement CodeInfoOO
discardFileInput = LensLike'
  (Zoomed (StateT ValueState Identity) (CodeInfoOO ()))
  MethodState
  ValueState
-> State ValueState (CodeInfoOO ())
-> State MethodState (CodeInfoOO ())
forall c.
LensLike'
  (Zoomed (StateT ValueState Identity) c) MethodState ValueState
-> StateT ValueState Identity c -> StateT MethodState Identity c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (StateT ValueState Identity) (CodeInfoOO ()))
  MethodState
  ValueState
(ValueState -> Focusing Identity (CodeInfoOO ()) ValueState)
-> MethodState -> Focusing Identity (CodeInfoOO ()) MethodState
Lens' MethodState ValueState
lensMStoVS (State ValueState (CodeInfoOO ())
 -> State MethodState (CodeInfoOO ()))
-> (State ValueState (CodeInfoOO ())
    -> State ValueState (CodeInfoOO ()))
-> State ValueState (CodeInfoOO ())
-> State MethodState (CodeInfoOO ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
forall a. State a (CodeInfoOO ()) -> State a (CodeInfoOO ())
execute1

  openFileR :: SVariable CodeInfoOO -> SValue CodeInfoOO -> MSStatement CodeInfoOO
openFileR SVariable CodeInfoOO
_ SValue CodeInfoOO
v = (MethodState -> MethodState) -> StateT MethodState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (ExceptionType -> MethodState -> MethodState
addException ExceptionType
FileNotFound) StateT MethodState Identity ()
-> State MethodState (CodeInfoOO ())
-> State MethodState (CodeInfoOO ())
forall a b.
StateT MethodState Identity a
-> StateT MethodState Identity b -> StateT MethodState Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 
    State MethodState (CodeInfoOO ())
-> State MethodState (CodeInfoOO ())
forall a. State a (CodeInfoOO ()) -> State a (CodeInfoOO ())
execute1 (LensLike'
  (Zoomed (StateT ValueState Identity) (CodeInfoOO ()))
  MethodState
  ValueState
-> State ValueState (CodeInfoOO ())
-> State MethodState (CodeInfoOO ())
forall c.
LensLike'
  (Zoomed (StateT ValueState Identity) c) MethodState ValueState
-> StateT ValueState Identity c -> StateT MethodState Identity c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (StateT ValueState Identity) (CodeInfoOO ()))
  MethodState
  ValueState
(ValueState -> Focusing Identity (CodeInfoOO ()) ValueState)
-> MethodState -> Focusing Identity (CodeInfoOO ()) MethodState
Lens' MethodState ValueState
lensMStoVS State ValueState (CodeInfoOO ())
SValue CodeInfoOO
v)
  openFileW :: SVariable CodeInfoOO -> SValue CodeInfoOO -> MSStatement CodeInfoOO
openFileW SVariable CodeInfoOO
_ SValue CodeInfoOO
v = (MethodState -> MethodState) -> StateT MethodState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (ExceptionType -> MethodState -> MethodState
addException ExceptionType
IO) StateT MethodState Identity ()
-> State MethodState (CodeInfoOO ())
-> State MethodState (CodeInfoOO ())
forall a b.
StateT MethodState Identity a
-> StateT MethodState Identity b -> StateT MethodState Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> State MethodState (CodeInfoOO ())
-> State MethodState (CodeInfoOO ())
forall a. State a (CodeInfoOO ()) -> State a (CodeInfoOO ())
execute1 (LensLike'
  (Zoomed (StateT ValueState Identity) (CodeInfoOO ()))
  MethodState
  ValueState
-> State ValueState (CodeInfoOO ())
-> State MethodState (CodeInfoOO ())
forall c.
LensLike'
  (Zoomed (StateT ValueState Identity) c) MethodState ValueState
-> StateT ValueState Identity c -> StateT MethodState Identity c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (StateT ValueState Identity) (CodeInfoOO ()))
  MethodState
  ValueState
(ValueState -> Focusing Identity (CodeInfoOO ()) ValueState)
-> MethodState -> Focusing Identity (CodeInfoOO ()) MethodState
Lens' MethodState ValueState
lensMStoVS State ValueState (CodeInfoOO ())
SValue CodeInfoOO
v)
  openFileA :: SVariable CodeInfoOO -> SValue CodeInfoOO -> MSStatement CodeInfoOO
openFileA SVariable CodeInfoOO
_ SValue CodeInfoOO
v = (MethodState -> MethodState) -> StateT MethodState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (ExceptionType -> MethodState -> MethodState
addException ExceptionType
IO) StateT MethodState Identity ()
-> State MethodState (CodeInfoOO ())
-> State MethodState (CodeInfoOO ())
forall a b.
StateT MethodState Identity a
-> StateT MethodState Identity b -> StateT MethodState Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> State MethodState (CodeInfoOO ())
-> State MethodState (CodeInfoOO ())
forall a. State a (CodeInfoOO ()) -> State a (CodeInfoOO ())
execute1 (LensLike'
  (Zoomed (StateT ValueState Identity) (CodeInfoOO ()))
  MethodState
  ValueState
-> State ValueState (CodeInfoOO ())
-> State MethodState (CodeInfoOO ())
forall c.
LensLike'
  (Zoomed (StateT ValueState Identity) c) MethodState ValueState
-> StateT ValueState Identity c -> StateT MethodState Identity c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (StateT ValueState Identity) (CodeInfoOO ()))
  MethodState
  ValueState
(ValueState -> Focusing Identity (CodeInfoOO ()) ValueState)
-> MethodState -> Focusing Identity (CodeInfoOO ()) MethodState
Lens' MethodState ValueState
lensMStoVS State ValueState (CodeInfoOO ())
SValue CodeInfoOO
v)
  closeFile :: SValue CodeInfoOO -> MSStatement CodeInfoOO
closeFile     = LensLike'
  (Zoomed (StateT ValueState Identity) (CodeInfoOO ()))
  MethodState
  ValueState
-> State ValueState (CodeInfoOO ())
-> State MethodState (CodeInfoOO ())
forall c.
LensLike'
  (Zoomed (StateT ValueState Identity) c) MethodState ValueState
-> StateT ValueState Identity c -> StateT MethodState Identity c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (StateT ValueState Identity) (CodeInfoOO ()))
  MethodState
  ValueState
(ValueState -> Focusing Identity (CodeInfoOO ()) ValueState)
-> MethodState -> Focusing Identity (CodeInfoOO ()) MethodState
Lens' MethodState ValueState
lensMStoVS (State ValueState (CodeInfoOO ())
 -> State MethodState (CodeInfoOO ()))
-> (State ValueState (CodeInfoOO ())
    -> State ValueState (CodeInfoOO ()))
-> State ValueState (CodeInfoOO ())
-> State MethodState (CodeInfoOO ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
forall a. State a (CodeInfoOO ()) -> State a (CodeInfoOO ())
execute1

  getFileInputLine :: SValue CodeInfoOO -> SVariable CodeInfoOO -> MSStatement CodeInfoOO
getFileInputLine SValue CodeInfoOO
v SVariable CodeInfoOO
_ = LensLike'
  (Zoomed
     (StateT ValueState Identity) (CodeInfoOO (Statement CodeInfoOO)))
  MethodState
  ValueState
-> StateT ValueState Identity (CodeInfoOO (Statement CodeInfoOO))
-> MSStatement CodeInfoOO
forall c.
LensLike'
  (Zoomed (StateT ValueState Identity) c) MethodState ValueState
-> StateT ValueState Identity c -> StateT MethodState Identity c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed
     (StateT ValueState Identity) (CodeInfoOO (Statement CodeInfoOO)))
  MethodState
  ValueState
(ValueState -> Focusing Identity (CodeInfoOO ()) ValueState)
-> MethodState -> Focusing Identity (CodeInfoOO ()) MethodState
Lens' MethodState ValueState
lensMStoVS (StateT ValueState Identity (CodeInfoOO (Statement CodeInfoOO))
 -> MSStatement CodeInfoOO)
-> StateT ValueState Identity (CodeInfoOO (Statement CodeInfoOO))
-> MSStatement CodeInfoOO
forall a b. (a -> b) -> a -> b
$ State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
forall a. State a (CodeInfoOO ()) -> State a (CodeInfoOO ())
execute1 State ValueState (CodeInfoOO ())
SValue CodeInfoOO
v
  discardFileLine :: SValue CodeInfoOO -> MSStatement CodeInfoOO
discardFileLine      = LensLike'
  (Zoomed (StateT ValueState Identity) (CodeInfoOO ()))
  MethodState
  ValueState
-> State ValueState (CodeInfoOO ())
-> State MethodState (CodeInfoOO ())
forall c.
LensLike'
  (Zoomed (StateT ValueState Identity) c) MethodState ValueState
-> StateT ValueState Identity c -> StateT MethodState Identity c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (StateT ValueState Identity) (CodeInfoOO ()))
  MethodState
  ValueState
(ValueState -> Focusing Identity (CodeInfoOO ()) ValueState)
-> MethodState -> Focusing Identity (CodeInfoOO ()) MethodState
Lens' MethodState ValueState
lensMStoVS (State ValueState (CodeInfoOO ())
 -> State MethodState (CodeInfoOO ()))
-> (State ValueState (CodeInfoOO ())
    -> State ValueState (CodeInfoOO ()))
-> State ValueState (CodeInfoOO ())
-> State MethodState (CodeInfoOO ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
forall a. State a (CodeInfoOO ()) -> State a (CodeInfoOO ())
execute1
  getFileInputAll :: SValue CodeInfoOO -> SVariable CodeInfoOO -> MSStatement CodeInfoOO
getFileInputAll  SValue CodeInfoOO
v SVariable CodeInfoOO
_ = State MethodState (CodeInfoOO ())
-> State MethodState (CodeInfoOO ())
forall a. State a (CodeInfoOO ()) -> State a (CodeInfoOO ())
execute1 (LensLike'
  (Zoomed (StateT ValueState Identity) (CodeInfoOO ()))
  MethodState
  ValueState
-> State ValueState (CodeInfoOO ())
-> State MethodState (CodeInfoOO ())
forall c.
LensLike'
  (Zoomed (StateT ValueState Identity) c) MethodState ValueState
-> StateT ValueState Identity c -> StateT MethodState Identity c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (StateT ValueState Identity) (CodeInfoOO ()))
  MethodState
  ValueState
(ValueState -> Focusing Identity (CodeInfoOO ()) ValueState)
-> MethodState -> Focusing Identity (CodeInfoOO ()) MethodState
Lens' MethodState ValueState
lensMStoVS State ValueState (CodeInfoOO ())
SValue CodeInfoOO
v)

instance StringStatement CodeInfoOO where
  stringSplit :: Char
-> SVariable CodeInfoOO
-> SValue CodeInfoOO
-> MSStatement CodeInfoOO
stringSplit Char
_ SVariable CodeInfoOO
_ = LensLike'
  (Zoomed (StateT ValueState Identity) (CodeInfoOO ()))
  MethodState
  ValueState
-> State ValueState (CodeInfoOO ())
-> State MethodState (CodeInfoOO ())
forall c.
LensLike'
  (Zoomed (StateT ValueState Identity) c) MethodState ValueState
-> StateT ValueState Identity c -> StateT MethodState Identity c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (StateT ValueState Identity) (CodeInfoOO ()))
  MethodState
  ValueState
(ValueState -> Focusing Identity (CodeInfoOO ()) ValueState)
-> MethodState -> Focusing Identity (CodeInfoOO ()) MethodState
Lens' MethodState ValueState
lensMStoVS (State ValueState (CodeInfoOO ())
 -> State MethodState (CodeInfoOO ()))
-> (State ValueState (CodeInfoOO ())
    -> State ValueState (CodeInfoOO ()))
-> State ValueState (CodeInfoOO ())
-> State MethodState (CodeInfoOO ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
forall a. State a (CodeInfoOO ()) -> State a (CodeInfoOO ())
execute1

  stringListVals :: [SVariable CodeInfoOO]
-> SValue CodeInfoOO -> MSStatement CodeInfoOO
stringListVals  [SVariable CodeInfoOO]
_ = LensLike'
  (Zoomed (StateT ValueState Identity) (CodeInfoOO ()))
  MethodState
  ValueState
-> State ValueState (CodeInfoOO ())
-> State MethodState (CodeInfoOO ())
forall c.
LensLike'
  (Zoomed (StateT ValueState Identity) c) MethodState ValueState
-> StateT ValueState Identity c -> StateT MethodState Identity c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (StateT ValueState Identity) (CodeInfoOO ()))
  MethodState
  ValueState
(ValueState -> Focusing Identity (CodeInfoOO ()) ValueState)
-> MethodState -> Focusing Identity (CodeInfoOO ()) MethodState
Lens' MethodState ValueState
lensMStoVS (State ValueState (CodeInfoOO ())
 -> State MethodState (CodeInfoOO ()))
-> (State ValueState (CodeInfoOO ())
    -> State ValueState (CodeInfoOO ()))
-> State ValueState (CodeInfoOO ())
-> State MethodState (CodeInfoOO ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
forall a. State a (CodeInfoOO ()) -> State a (CodeInfoOO ())
execute1
  stringListLists :: [SVariable CodeInfoOO]
-> SValue CodeInfoOO -> MSStatement CodeInfoOO
stringListLists [SVariable CodeInfoOO]
_ = LensLike'
  (Zoomed (StateT ValueState Identity) (CodeInfoOO ()))
  MethodState
  ValueState
-> State ValueState (CodeInfoOO ())
-> State MethodState (CodeInfoOO ())
forall c.
LensLike'
  (Zoomed (StateT ValueState Identity) c) MethodState ValueState
-> StateT ValueState Identity c -> StateT MethodState Identity c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (StateT ValueState Identity) (CodeInfoOO ()))
  MethodState
  ValueState
(ValueState -> Focusing Identity (CodeInfoOO ()) ValueState)
-> MethodState -> Focusing Identity (CodeInfoOO ()) MethodState
Lens' MethodState ValueState
lensMStoVS (State ValueState (CodeInfoOO ())
 -> State MethodState (CodeInfoOO ()))
-> (State ValueState (CodeInfoOO ())
    -> State ValueState (CodeInfoOO ()))
-> State ValueState (CodeInfoOO ())
-> State MethodState (CodeInfoOO ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
forall a. State a (CodeInfoOO ()) -> State a (CodeInfoOO ())
execute1

instance FuncAppStatement CodeInfoOO where
  inOutCall :: InOutCall CodeInfoOO
inOutCall String
n [SValue CodeInfoOO]
vs [SVariable CodeInfoOO]
_ [SVariable CodeInfoOO]
_ = LensLike'
  (Zoomed
     (StateT ValueState Identity) (CodeInfoOO (Statement CodeInfoOO)))
  MethodState
  ValueState
-> StateT ValueState Identity (CodeInfoOO (Statement CodeInfoOO))
-> MSStatement CodeInfoOO
forall c.
LensLike'
  (Zoomed (StateT ValueState Identity) c) MethodState ValueState
-> StateT ValueState Identity c -> StateT MethodState Identity c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed
     (StateT ValueState Identity) (CodeInfoOO (Statement CodeInfoOO)))
  MethodState
  ValueState
(ValueState -> Focusing Identity (CodeInfoOO ()) ValueState)
-> MethodState -> Focusing Identity (CodeInfoOO ()) MethodState
Lens' MethodState ValueState
lensMStoVS (StateT ValueState Identity (CodeInfoOO (Statement CodeInfoOO))
 -> MSStatement CodeInfoOO)
-> StateT ValueState Identity (CodeInfoOO (Statement CodeInfoOO))
-> MSStatement CodeInfoOO
forall a b. (a -> b) -> a -> b
$ do
    [State ValueState (CodeInfoOO ())] -> StateT ValueState Identity ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [State ValueState (CodeInfoOO ())]
[SValue CodeInfoOO]
vs
    String -> SValue CodeInfoOO
addCurrModCall String
n
  extInOutCall :: String -> InOutCall CodeInfoOO
extInOutCall String
l String
n [SValue CodeInfoOO]
vs [SVariable CodeInfoOO]
_ [SVariable CodeInfoOO]
_ = LensLike'
  (Zoomed
     (StateT ValueState Identity) (CodeInfoOO (Statement CodeInfoOO)))
  MethodState
  ValueState
-> StateT ValueState Identity (CodeInfoOO (Statement CodeInfoOO))
-> MSStatement CodeInfoOO
forall c.
LensLike'
  (Zoomed (StateT ValueState Identity) c) MethodState ValueState
-> StateT ValueState Identity c -> StateT MethodState Identity c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed
     (StateT ValueState Identity) (CodeInfoOO (Statement CodeInfoOO)))
  MethodState
  ValueState
(ValueState -> Focusing Identity (CodeInfoOO ()) ValueState)
-> MethodState -> Focusing Identity (CodeInfoOO ()) MethodState
Lens' MethodState ValueState
lensMStoVS (StateT ValueState Identity (CodeInfoOO (Statement CodeInfoOO))
 -> MSStatement CodeInfoOO)
-> StateT ValueState Identity (CodeInfoOO (Statement CodeInfoOO))
-> MSStatement CodeInfoOO
forall a b. (a -> b) -> a -> b
$ do
    [State ValueState (CodeInfoOO ())] -> StateT ValueState Identity ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [State ValueState (CodeInfoOO ())]
[SValue CodeInfoOO]
vs
    String -> String -> SValue CodeInfoOO
addExternalCall String
l String
n

instance OOFuncAppStatement CodeInfoOO where
  selfInOutCall :: InOutCall CodeInfoOO
selfInOutCall String
n [SValue CodeInfoOO]
vs [SVariable CodeInfoOO]
_ [SVariable CodeInfoOO]
_ = LensLike'
  (Zoomed
     (StateT ValueState Identity) (CodeInfoOO (Statement CodeInfoOO)))
  MethodState
  ValueState
-> StateT ValueState Identity (CodeInfoOO (Statement CodeInfoOO))
-> MSStatement CodeInfoOO
forall c.
LensLike'
  (Zoomed (StateT ValueState Identity) c) MethodState ValueState
-> StateT ValueState Identity c -> StateT MethodState Identity c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed
     (StateT ValueState Identity) (CodeInfoOO (Statement CodeInfoOO)))
  MethodState
  ValueState
(ValueState -> Focusing Identity (CodeInfoOO ()) ValueState)
-> MethodState -> Focusing Identity (CodeInfoOO ()) MethodState
Lens' MethodState ValueState
lensMStoVS (StateT ValueState Identity (CodeInfoOO (Statement CodeInfoOO))
 -> MSStatement CodeInfoOO)
-> StateT ValueState Identity (CodeInfoOO (Statement CodeInfoOO))
-> MSStatement CodeInfoOO
forall a b. (a -> b) -> a -> b
$ do
    [State ValueState (CodeInfoOO ())] -> StateT ValueState Identity ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [State ValueState (CodeInfoOO ())]
[SValue CodeInfoOO]
vs
    String -> SValue CodeInfoOO
addCurrModCall String
n

instance CommentStatement CodeInfoOO where
  comment :: String -> MSStatement CodeInfoOO
comment String
_ = State MethodState (CodeInfoOO ())
MSStatement CodeInfoOO
forall s. State s (CodeInfoOO ())
noInfo

instance ControlStatement CodeInfoOO where
  break :: MSStatement CodeInfoOO
break    = State MethodState (CodeInfoOO ())
MSStatement CodeInfoOO
forall s. State s (CodeInfoOO ())
noInfo
  continue :: MSStatement CodeInfoOO
continue = State MethodState (CodeInfoOO ())
MSStatement CodeInfoOO
forall s. State s (CodeInfoOO ())
noInfo

  returnStmt :: SValue CodeInfoOO -> MSStatement CodeInfoOO
returnStmt = LensLike'
  (Zoomed (StateT ValueState Identity) (CodeInfoOO ()))
  MethodState
  ValueState
-> State ValueState (CodeInfoOO ())
-> State MethodState (CodeInfoOO ())
forall c.
LensLike'
  (Zoomed (StateT ValueState Identity) c) MethodState ValueState
-> StateT ValueState Identity c -> StateT MethodState Identity c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (StateT ValueState Identity) (CodeInfoOO ()))
  MethodState
  ValueState
(ValueState -> Focusing Identity (CodeInfoOO ()) ValueState)
-> MethodState -> Focusing Identity (CodeInfoOO ()) MethodState
Lens' MethodState ValueState
lensMStoVS (State ValueState (CodeInfoOO ())
 -> State MethodState (CodeInfoOO ()))
-> (State ValueState (CodeInfoOO ())
    -> State ValueState (CodeInfoOO ()))
-> State ValueState (CodeInfoOO ())
-> State MethodState (CodeInfoOO ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
forall a. State a (CodeInfoOO ()) -> State a (CodeInfoOO ())
execute1

  throw :: String -> MSStatement CodeInfoOO
throw String
_ = (MethodState -> MethodState)
-> CodeInfoOO () -> State MethodState (CodeInfoOO ())
forall s a. (s -> s) -> a -> State s a
modifyReturn (ExceptionType -> MethodState -> MethodState
addException ExceptionType
Standard) (() -> CodeInfoOO ()
forall (r :: * -> *) a. Monad r => a -> r a
toCode ())

  ifCond :: [(SValue CodeInfoOO, MSBody CodeInfoOO)]
-> MSBody CodeInfoOO -> MSStatement CodeInfoOO
ifCond = [(SValue CodeInfoOO, MSBody CodeInfoOO)]
-> MSBody CodeInfoOO -> MSStatement CodeInfoOO
evalConds
  switch :: SValue CodeInfoOO
-> [(SValue CodeInfoOO, MSBody CodeInfoOO)]
-> MSBody CodeInfoOO
-> MSStatement CodeInfoOO
switch SValue CodeInfoOO
v [(SValue CodeInfoOO, MSBody CodeInfoOO)]
cs MSBody CodeInfoOO
b = do
    CodeInfoOO ()
_ <- LensLike'
  (Zoomed (StateT ValueState Identity) (CodeInfoOO ()))
  MethodState
  ValueState
-> State ValueState (CodeInfoOO ())
-> State MethodState (CodeInfoOO ())
forall c.
LensLike'
  (Zoomed (StateT ValueState Identity) c) MethodState ValueState
-> StateT ValueState Identity c -> StateT MethodState Identity c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (StateT ValueState Identity) (CodeInfoOO ()))
  MethodState
  ValueState
(ValueState -> Focusing Identity (CodeInfoOO ()) ValueState)
-> MethodState -> Focusing Identity (CodeInfoOO ()) MethodState
Lens' MethodState ValueState
lensMStoVS State ValueState (CodeInfoOO ())
SValue CodeInfoOO
v
    [(SValue CodeInfoOO, MSBody CodeInfoOO)]
-> MSBody CodeInfoOO -> MSStatement CodeInfoOO
evalConds [(SValue CodeInfoOO, MSBody CodeInfoOO)]
cs MSBody CodeInfoOO
b

  ifExists :: SValue CodeInfoOO
-> MSBody CodeInfoOO -> MSBody CodeInfoOO -> MSStatement CodeInfoOO
ifExists SValue CodeInfoOO
v = State MethodState (CodeInfoOO ())
-> State MethodState (CodeInfoOO ())
-> State MethodState (CodeInfoOO ())
-> State MethodState (CodeInfoOO ())
forall a.
State a (CodeInfoOO ())
-> State a (CodeInfoOO ())
-> State a (CodeInfoOO ())
-> State a (CodeInfoOO ())
execute3 (LensLike'
  (Zoomed (StateT ValueState Identity) (CodeInfoOO ()))
  MethodState
  ValueState
-> State ValueState (CodeInfoOO ())
-> State MethodState (CodeInfoOO ())
forall c.
LensLike'
  (Zoomed (StateT ValueState Identity) c) MethodState ValueState
-> StateT ValueState Identity c -> StateT MethodState Identity c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (StateT ValueState Identity) (CodeInfoOO ()))
  MethodState
  ValueState
(ValueState -> Focusing Identity (CodeInfoOO ()) ValueState)
-> MethodState -> Focusing Identity (CodeInfoOO ()) MethodState
Lens' MethodState ValueState
lensMStoVS State ValueState (CodeInfoOO ())
SValue CodeInfoOO
v)

  for :: MSStatement CodeInfoOO
-> SValue CodeInfoOO
-> MSStatement CodeInfoOO
-> MSBody CodeInfoOO
-> MSStatement CodeInfoOO
for MSStatement CodeInfoOO
dec SValue CodeInfoOO
v = State MethodState (CodeInfoOO ())
-> State MethodState (CodeInfoOO ())
-> State MethodState (CodeInfoOO ())
-> State MethodState (CodeInfoOO ())
-> State MethodState (CodeInfoOO ())
forall a.
State a (CodeInfoOO ())
-> State a (CodeInfoOO ())
-> State a (CodeInfoOO ())
-> State a (CodeInfoOO ())
-> State a (CodeInfoOO ())
execute4 State MethodState (CodeInfoOO ())
MSStatement CodeInfoOO
dec (LensLike'
  (Zoomed (StateT ValueState Identity) (CodeInfoOO ()))
  MethodState
  ValueState
-> State ValueState (CodeInfoOO ())
-> State MethodState (CodeInfoOO ())
forall c.
LensLike'
  (Zoomed (StateT ValueState Identity) c) MethodState ValueState
-> StateT ValueState Identity c -> StateT MethodState Identity c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (StateT ValueState Identity) (CodeInfoOO ()))
  MethodState
  ValueState
(ValueState -> Focusing Identity (CodeInfoOO ()) ValueState)
-> MethodState -> Focusing Identity (CodeInfoOO ()) MethodState
Lens' MethodState ValueState
lensMStoVS State ValueState (CodeInfoOO ())
SValue CodeInfoOO
v)
  forRange :: SVariable CodeInfoOO
-> SValue CodeInfoOO
-> SValue CodeInfoOO
-> SValue CodeInfoOO
-> MSBody CodeInfoOO
-> MSStatement CodeInfoOO
forRange SVariable CodeInfoOO
_ SValue CodeInfoOO
b SValue CodeInfoOO
e SValue CodeInfoOO
s = State MethodState (CodeInfoOO ())
-> State MethodState (CodeInfoOO ())
-> State MethodState (CodeInfoOO ())
-> State MethodState (CodeInfoOO ())
-> State MethodState (CodeInfoOO ())
forall a.
State a (CodeInfoOO ())
-> State a (CodeInfoOO ())
-> State a (CodeInfoOO ())
-> State a (CodeInfoOO ())
-> State a (CodeInfoOO ())
execute4 (LensLike'
  (Zoomed (StateT ValueState Identity) (CodeInfoOO ()))
  MethodState
  ValueState
-> State ValueState (CodeInfoOO ())
-> State MethodState (CodeInfoOO ())
forall c.
LensLike'
  (Zoomed (StateT ValueState Identity) c) MethodState ValueState
-> StateT ValueState Identity c -> StateT MethodState Identity c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (StateT ValueState Identity) (CodeInfoOO ()))
  MethodState
  ValueState
(ValueState -> Focusing Identity (CodeInfoOO ()) ValueState)
-> MethodState -> Focusing Identity (CodeInfoOO ()) MethodState
Lens' MethodState ValueState
lensMStoVS State ValueState (CodeInfoOO ())
SValue CodeInfoOO
b) (LensLike'
  (Zoomed (StateT ValueState Identity) (CodeInfoOO ()))
  MethodState
  ValueState
-> State ValueState (CodeInfoOO ())
-> State MethodState (CodeInfoOO ())
forall c.
LensLike'
  (Zoomed (StateT ValueState Identity) c) MethodState ValueState
-> StateT ValueState Identity c -> StateT MethodState Identity c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (StateT ValueState Identity) (CodeInfoOO ()))
  MethodState
  ValueState
(ValueState -> Focusing Identity (CodeInfoOO ()) ValueState)
-> MethodState -> Focusing Identity (CodeInfoOO ()) MethodState
Lens' MethodState ValueState
lensMStoVS State ValueState (CodeInfoOO ())
SValue CodeInfoOO
e) 
    (LensLike'
  (Zoomed (StateT ValueState Identity) (CodeInfoOO ()))
  MethodState
  ValueState
-> State ValueState (CodeInfoOO ())
-> State MethodState (CodeInfoOO ())
forall c.
LensLike'
  (Zoomed (StateT ValueState Identity) c) MethodState ValueState
-> StateT ValueState Identity c -> StateT MethodState Identity c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (StateT ValueState Identity) (CodeInfoOO ()))
  MethodState
  ValueState
(ValueState -> Focusing Identity (CodeInfoOO ()) ValueState)
-> MethodState -> Focusing Identity (CodeInfoOO ()) MethodState
Lens' MethodState ValueState
lensMStoVS State ValueState (CodeInfoOO ())
SValue CodeInfoOO
s)
  forEach :: SVariable CodeInfoOO
-> SValue CodeInfoOO -> MSBody CodeInfoOO -> MSStatement CodeInfoOO
forEach SVariable CodeInfoOO
_ SValue CodeInfoOO
v = State MethodState (CodeInfoOO ())
-> State MethodState (CodeInfoOO ())
-> State MethodState (CodeInfoOO ())
forall a.
State a (CodeInfoOO ())
-> State a (CodeInfoOO ()) -> State a (CodeInfoOO ())
execute2 (LensLike'
  (Zoomed (StateT ValueState Identity) (CodeInfoOO ()))
  MethodState
  ValueState
-> State ValueState (CodeInfoOO ())
-> State MethodState (CodeInfoOO ())
forall c.
LensLike'
  (Zoomed (StateT ValueState Identity) c) MethodState ValueState
-> StateT ValueState Identity c -> StateT MethodState Identity c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (StateT ValueState Identity) (CodeInfoOO ()))
  MethodState
  ValueState
(ValueState -> Focusing Identity (CodeInfoOO ()) ValueState)
-> MethodState -> Focusing Identity (CodeInfoOO ()) MethodState
Lens' MethodState ValueState
lensMStoVS State ValueState (CodeInfoOO ())
SValue CodeInfoOO
v)
  while :: SValue CodeInfoOO -> MSBody CodeInfoOO -> MSStatement CodeInfoOO
while SValue CodeInfoOO
v = State MethodState (CodeInfoOO ())
-> State MethodState (CodeInfoOO ())
-> State MethodState (CodeInfoOO ())
forall a.
State a (CodeInfoOO ())
-> State a (CodeInfoOO ()) -> State a (CodeInfoOO ())
execute2 (LensLike'
  (Zoomed (StateT ValueState Identity) (CodeInfoOO ()))
  MethodState
  ValueState
-> State ValueState (CodeInfoOO ())
-> State MethodState (CodeInfoOO ())
forall c.
LensLike'
  (Zoomed (StateT ValueState Identity) c) MethodState ValueState
-> StateT ValueState Identity c -> StateT MethodState Identity c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (StateT ValueState Identity) (CodeInfoOO ()))
  MethodState
  ValueState
(ValueState -> Focusing Identity (CodeInfoOO ()) ValueState)
-> MethodState -> Focusing Identity (CodeInfoOO ()) MethodState
Lens' MethodState ValueState
lensMStoVS State ValueState (CodeInfoOO ())
SValue CodeInfoOO
v)

  tryCatch :: MSBody CodeInfoOO -> MSBody CodeInfoOO -> MSStatement CodeInfoOO
tryCatch MSBody CodeInfoOO
_ MSBody CodeInfoOO
cb = do
    CodeInfoOO ()
_ <- State MethodState (CodeInfoOO ())
MSBody CodeInfoOO
cb
    State MethodState (CodeInfoOO ())
forall s. State s (CodeInfoOO ())
noInfo
  
  assert :: SValue CodeInfoOO -> SValue CodeInfoOO -> MSStatement CodeInfoOO
assert SValue CodeInfoOO
cond SValue CodeInfoOO
msg = do
    CodeInfoOO ()
_ <- LensLike'
  (Zoomed (StateT ValueState Identity) (CodeInfoOO ()))
  MethodState
  ValueState
-> State ValueState (CodeInfoOO ())
-> State MethodState (CodeInfoOO ())
forall c.
LensLike'
  (Zoomed (StateT ValueState Identity) c) MethodState ValueState
-> StateT ValueState Identity c -> StateT MethodState Identity c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (StateT ValueState Identity) (CodeInfoOO ()))
  MethodState
  ValueState
(ValueState -> Focusing Identity (CodeInfoOO ()) ValueState)
-> MethodState -> Focusing Identity (CodeInfoOO ()) MethodState
Lens' MethodState ValueState
lensMStoVS State ValueState (CodeInfoOO ())
SValue CodeInfoOO
cond
    CodeInfoOO ()
_ <- LensLike'
  (Zoomed (StateT ValueState Identity) (CodeInfoOO ()))
  MethodState
  ValueState
-> State ValueState (CodeInfoOO ())
-> State MethodState (CodeInfoOO ())
forall c.
LensLike'
  (Zoomed (StateT ValueState Identity) c) MethodState ValueState
-> StateT ValueState Identity c -> StateT MethodState Identity c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (StateT ValueState Identity) (CodeInfoOO ()))
  MethodState
  ValueState
(ValueState -> Focusing Identity (CodeInfoOO ()) ValueState)
-> MethodState -> Focusing Identity (CodeInfoOO ()) MethodState
Lens' MethodState ValueState
lensMStoVS State ValueState (CodeInfoOO ())
SValue CodeInfoOO
msg
    State MethodState (CodeInfoOO ())
forall s. State s (CodeInfoOO ())
noInfo

instance ObserverPattern CodeInfoOO where
  notifyObservers :: VSFunction CodeInfoOO
-> VSType CodeInfoOO -> MSStatement CodeInfoOO
notifyObservers VSFunction CodeInfoOO
f VSType CodeInfoOO
_ = State MethodState (CodeInfoOO ())
-> State MethodState (CodeInfoOO ())
forall a. State a (CodeInfoOO ()) -> State a (CodeInfoOO ())
execute1 (LensLike'
  (Zoomed (StateT ValueState Identity) (CodeInfoOO ()))
  MethodState
  ValueState
-> State ValueState (CodeInfoOO ())
-> State MethodState (CodeInfoOO ())
forall c.
LensLike'
  (Zoomed (StateT ValueState Identity) c) MethodState ValueState
-> StateT ValueState Identity c -> StateT MethodState Identity c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (StateT ValueState Identity) (CodeInfoOO ()))
  MethodState
  ValueState
(ValueState -> Focusing Identity (CodeInfoOO ()) ValueState)
-> MethodState -> Focusing Identity (CodeInfoOO ()) MethodState
Lens' MethodState ValueState
lensMStoVS State ValueState (CodeInfoOO ())
VSFunction CodeInfoOO
f)
  
instance StrategyPattern CodeInfoOO where
  runStrategy :: String
-> [(String, MSBody CodeInfoOO)]
-> Maybe (SValue CodeInfoOO)
-> Maybe (SVariable CodeInfoOO)
-> MSBlock CodeInfoOO
runStrategy String
_ [(String, MSBody CodeInfoOO)]
ss Maybe (SValue CodeInfoOO)
vl Maybe (SVariable CodeInfoOO)
_ = do
    ((String, State MethodState (CodeInfoOO ()))
 -> State MethodState (CodeInfoOO ()))
-> [(String, State MethodState (CodeInfoOO ()))]
-> StateT MethodState Identity ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (String, State MethodState (CodeInfoOO ()))
-> State MethodState (CodeInfoOO ())
forall a b. (a, b) -> b
snd [(String, State MethodState (CodeInfoOO ()))]
[(String, MSBody CodeInfoOO)]
ss
    CodeInfoOO ()
_ <- LensLike'
  (Zoomed (StateT ValueState Identity) (CodeInfoOO ()))
  MethodState
  ValueState
-> State ValueState (CodeInfoOO ())
-> State MethodState (CodeInfoOO ())
forall c.
LensLike'
  (Zoomed (StateT ValueState Identity) c) MethodState ValueState
-> StateT ValueState Identity c -> StateT MethodState Identity c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (StateT ValueState Identity) (CodeInfoOO ()))
  MethodState
  ValueState
(ValueState -> Focusing Identity (CodeInfoOO ()) ValueState)
-> MethodState -> Focusing Identity (CodeInfoOO ()) MethodState
Lens' MethodState ValueState
lensMStoVS (State ValueState (CodeInfoOO ())
 -> State MethodState (CodeInfoOO ()))
-> State ValueState (CodeInfoOO ())
-> State MethodState (CodeInfoOO ())
forall a b. (a -> b) -> a -> b
$ State ValueState (CodeInfoOO ())
-> Maybe (State ValueState (CodeInfoOO ()))
-> State ValueState (CodeInfoOO ())
forall a. a -> Maybe a -> a
fromMaybe State ValueState (CodeInfoOO ())
forall s. State s (CodeInfoOO ())
noInfo Maybe (State ValueState (CodeInfoOO ()))
Maybe (SValue CodeInfoOO)
vl
    State MethodState (CodeInfoOO ())
forall s. State s (CodeInfoOO ())
noInfo

instance VisibilitySym CodeInfoOO where
  type Visibility CodeInfoOO = VisibilityTag
  private :: CodeInfoOO (Visibility CodeInfoOO)
private = VisibilityTag -> CodeInfoOO VisibilityTag
forall (r :: * -> *) a. Monad r => a -> r a
toCode VisibilityTag
Priv
  public :: CodeInfoOO (Visibility CodeInfoOO)
public  = VisibilityTag -> CodeInfoOO VisibilityTag
forall (r :: * -> *) a. Monad r => a -> r a
toCode VisibilityTag
Pub

instance ParameterSym CodeInfoOO where
  type Parameter CodeInfoOO = ()
  param :: SVariable CodeInfoOO -> MSParameter CodeInfoOO
param        SVariable CodeInfoOO
_ = State MethodState (CodeInfoOO ())
MSParameter CodeInfoOO
forall s. State s (CodeInfoOO ())
noInfo
  pointerParam :: SVariable CodeInfoOO -> MSParameter CodeInfoOO
pointerParam SVariable CodeInfoOO
_ = State MethodState (CodeInfoOO ())
MSParameter CodeInfoOO
forall s. State s (CodeInfoOO ())
noInfo

instance MethodSym CodeInfoOO where
  type Method CodeInfoOO = ()
  docMain :: MSBody CodeInfoOO -> SMethod CodeInfoOO
docMain = String -> MSBody CodeInfoOO -> SMethod CodeInfoOO
updateMEMandCM String
"main"
  function :: String
-> CodeInfoOO (Visibility CodeInfoOO)
-> VSType CodeInfoOO
-> [MSParameter CodeInfoOO]
-> MSBody CodeInfoOO
-> SMethod CodeInfoOO
function String
n CodeInfoOO (Visibility CodeInfoOO)
_ VSType CodeInfoOO
_ [MSParameter CodeInfoOO]
_ = String -> MSBody CodeInfoOO -> SMethod CodeInfoOO
updateMEMandCM String
n
  mainFunction :: MSBody CodeInfoOO -> SMethod CodeInfoOO
mainFunction = String -> MSBody CodeInfoOO -> SMethod CodeInfoOO
updateMEMandCM String
"main"
  docFunc :: String
-> [String]
-> Maybe String
-> SMethod CodeInfoOO
-> SMethod CodeInfoOO
docFunc String
_ [String]
_ Maybe String
_ SMethod CodeInfoOO
f = do
    CodeInfoOO ()
_ <- State MethodState (CodeInfoOO ())
SMethod CodeInfoOO
f
    State MethodState (CodeInfoOO ())
forall s. State s (CodeInfoOO ())
noInfo

  inOutFunc :: String
-> CodeInfoOO (Visibility CodeInfoOO) -> InOutFunc CodeInfoOO
inOutFunc      String
n CodeInfoOO (Visibility CodeInfoOO)
_ [SVariable CodeInfoOO]
_ [SVariable CodeInfoOO]
_ [SVariable CodeInfoOO]
_     = String -> MSBody CodeInfoOO -> SMethod CodeInfoOO
updateMEMandCM String
n
  docInOutFunc :: String
-> CodeInfoOO (Visibility CodeInfoOO) -> DocInOutFunc CodeInfoOO
docInOutFunc   String
n CodeInfoOO (Visibility CodeInfoOO)
_ String
_ [(String, SVariable CodeInfoOO)]
_ [(String, SVariable CodeInfoOO)]
_ [(String, SVariable CodeInfoOO)]
_   = String -> MSBody CodeInfoOO -> SMethod CodeInfoOO
updateMEMandCM String
n

instance OOMethodSym CodeInfoOO where
  method :: String
-> CodeInfoOO (Visibility CodeInfoOO)
-> CodeInfoOO (Permanence CodeInfoOO)
-> VSType CodeInfoOO
-> [MSParameter CodeInfoOO]
-> MSBody CodeInfoOO
-> SMethod CodeInfoOO
method String
n CodeInfoOO (Visibility CodeInfoOO)
_ CodeInfoOO (Permanence CodeInfoOO)
_ VSType CodeInfoOO
_ [MSParameter CodeInfoOO]
_ = String -> MSBody CodeInfoOO -> SMethod CodeInfoOO
updateMEMandCM String
n
  getMethod :: SVariable CodeInfoOO -> SMethod CodeInfoOO
getMethod SVariable CodeInfoOO
_ = State MethodState (CodeInfoOO ())
SMethod CodeInfoOO
forall s. State s (CodeInfoOO ())
noInfo
  setMethod :: SVariable CodeInfoOO -> SMethod CodeInfoOO
setMethod SVariable CodeInfoOO
_ = State MethodState (CodeInfoOO ())
SMethod CodeInfoOO
forall s. State s (CodeInfoOO ())
noInfo
  constructor :: [MSParameter CodeInfoOO]
-> [(SVariable CodeInfoOO, SValue CodeInfoOO)]
-> MSBody CodeInfoOO
-> SMethod CodeInfoOO
constructor [MSParameter CodeInfoOO]
_ [(SVariable CodeInfoOO, SValue CodeInfoOO)]
il MSBody CodeInfoOO
b = do
    ((State ValueState (CodeInfoOO ()),
  State ValueState (CodeInfoOO ()))
 -> State MethodState (CodeInfoOO ()))
-> [(State ValueState (CodeInfoOO ()),
     State ValueState (CodeInfoOO ()))]
-> StateT MethodState Identity ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (LensLike'
  (Zoomed (StateT ValueState Identity) (CodeInfoOO ()))
  MethodState
  ValueState
-> State ValueState (CodeInfoOO ())
-> State MethodState (CodeInfoOO ())
forall c.
LensLike'
  (Zoomed (StateT ValueState Identity) c) MethodState ValueState
-> StateT ValueState Identity c -> StateT MethodState Identity c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (StateT ValueState Identity) (CodeInfoOO ()))
  MethodState
  ValueState
(ValueState -> Focusing Identity (CodeInfoOO ()) ValueState)
-> MethodState -> Focusing Identity (CodeInfoOO ()) MethodState
Lens' MethodState ValueState
lensMStoVS (State ValueState (CodeInfoOO ())
 -> State MethodState (CodeInfoOO ()))
-> ((State ValueState (CodeInfoOO ()),
     State ValueState (CodeInfoOO ()))
    -> State ValueState (CodeInfoOO ()))
-> (State ValueState (CodeInfoOO ()),
    State ValueState (CodeInfoOO ()))
-> State MethodState (CodeInfoOO ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (State ValueState (CodeInfoOO ()),
 State ValueState (CodeInfoOO ()))
-> State ValueState (CodeInfoOO ())
forall a b. (a, b) -> b
snd) [(State ValueState (CodeInfoOO ()),
  State ValueState (CodeInfoOO ()))]
[(SVariable CodeInfoOO, SValue CodeInfoOO)]
il
    CodeInfoOO ()
_ <- State MethodState (CodeInfoOO ())
MSBody CodeInfoOO
b
    String
cn <- MS String
getClassName
    (MethodState -> MethodState) -> StateT MethodState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (String -> MethodState -> MethodState
updateCallMap String
cn (MethodState -> MethodState)
-> (MethodState -> MethodState) -> MethodState -> MethodState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> MethodState -> MethodState
updateMethodExcMap String
cn)
    State MethodState (CodeInfoOO ())
forall s. State s (CodeInfoOO ())
noInfo

  inOutMethod :: String
-> CodeInfoOO (Visibility CodeInfoOO)
-> CodeInfoOO (Permanence CodeInfoOO)
-> InOutFunc CodeInfoOO
inOutMethod    String
n CodeInfoOO (Visibility CodeInfoOO)
_ CodeInfoOO (Permanence CodeInfoOO)
_ [SVariable CodeInfoOO]
_ [SVariable CodeInfoOO]
_ [SVariable CodeInfoOO]
_   = String -> MSBody CodeInfoOO -> SMethod CodeInfoOO
updateMEMandCM String
n
  docInOutMethod :: String
-> CodeInfoOO (Visibility CodeInfoOO)
-> CodeInfoOO (Permanence CodeInfoOO)
-> DocInOutFunc CodeInfoOO
docInOutMethod String
n CodeInfoOO (Visibility CodeInfoOO)
_ CodeInfoOO (Permanence CodeInfoOO)
_ String
_ [(String, SVariable CodeInfoOO)]
_ [(String, SVariable CodeInfoOO)]
_ [(String, SVariable CodeInfoOO)]
_ = String -> MSBody CodeInfoOO -> SMethod CodeInfoOO
updateMEMandCM String
n

instance StateVarSym CodeInfoOO where
  type StateVar CodeInfoOO = ()
  stateVar :: CodeInfoOO (Visibility CodeInfoOO)
-> CodeInfoOO (Permanence CodeInfoOO)
-> SVariable CodeInfoOO
-> CSStateVar CodeInfoOO
stateVar    CodeInfoOO (Visibility CodeInfoOO)
_ CodeInfoOO (Permanence CodeInfoOO)
_ SVariable CodeInfoOO
_   = State ClassState (CodeInfoOO ())
CSStateVar CodeInfoOO
forall s. State s (CodeInfoOO ())
noInfo
  stateVarDef :: CodeInfoOO (Visibility CodeInfoOO)
-> CodeInfoOO (Permanence CodeInfoOO)
-> SVariable CodeInfoOO
-> SValue CodeInfoOO
-> CSStateVar CodeInfoOO
stateVarDef CodeInfoOO (Visibility CodeInfoOO)
_ CodeInfoOO (Permanence CodeInfoOO)
_ SVariable CodeInfoOO
_ SValue CodeInfoOO
_ = State ClassState (CodeInfoOO ())
CSStateVar CodeInfoOO
forall s. State s (CodeInfoOO ())
noInfo
  constVar :: CodeInfoOO (Visibility CodeInfoOO)
-> SVariable CodeInfoOO
-> SValue CodeInfoOO
-> CSStateVar CodeInfoOO
constVar    CodeInfoOO (Visibility CodeInfoOO)
_ SVariable CodeInfoOO
_ SValue CodeInfoOO
_   = State ClassState (CodeInfoOO ())
CSStateVar CodeInfoOO
forall s. State s (CodeInfoOO ())
noInfo

instance ClassSym CodeInfoOO where
  type Class CodeInfoOO = ()
  buildClass :: Maybe String
-> [CSStateVar CodeInfoOO]
-> [SMethod CodeInfoOO]
-> [SMethod CodeInfoOO]
-> SClass CodeInfoOO
buildClass Maybe String
_ [CSStateVar CodeInfoOO]
_ [SMethod CodeInfoOO]
cs [SMethod CodeInfoOO]
ms = do
    String
n <- LensLike'
  (Zoomed (StateT FileState Identity) String) ClassState FileState
-> StateT FileState Identity String
-> StateT ClassState Identity String
forall c.
LensLike'
  (Zoomed (StateT FileState Identity) c) ClassState FileState
-> StateT FileState Identity c -> StateT ClassState Identity c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (StateT FileState Identity) String) ClassState FileState
(FileState -> Focusing Identity String FileState)
-> ClassState -> Focusing Identity String ClassState
Lens' ClassState FileState
lensCStoFS StateT FileState Identity String
getModuleName
    String
-> [String]
-> [CSStateVar CodeInfoOO]
-> [SMethod CodeInfoOO]
-> [SMethod CodeInfoOO]
-> SClass CodeInfoOO
forall (r :: * -> *).
ClassSym r =>
String
-> [String]
-> [CSStateVar r]
-> [SMethod r]
-> [SMethod r]
-> SClass r
implementingClass String
n [] [] [SMethod CodeInfoOO]
cs [SMethod CodeInfoOO]
ms
  extraClass :: String
-> Maybe String
-> [CSStateVar CodeInfoOO]
-> [SMethod CodeInfoOO]
-> [SMethod CodeInfoOO]
-> SClass CodeInfoOO
extraClass String
n Maybe String
_ [CSStateVar CodeInfoOO]
_ [SMethod CodeInfoOO]
cs [SMethod CodeInfoOO]
ms = do
    (ClassState -> ClassState) -> StateT ClassState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (String -> ClassState -> ClassState
setClassName String
n)
    (State MethodState (CodeInfoOO ())
 -> State ClassState (CodeInfoOO ()))
-> [State MethodState (CodeInfoOO ())]
-> StateT ClassState Identity ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (LensLike'
  (Zoomed (StateT MethodState Identity) (CodeInfoOO ()))
  ClassState
  MethodState
-> State MethodState (CodeInfoOO ())
-> State ClassState (CodeInfoOO ())
forall c.
LensLike'
  (Zoomed (StateT MethodState Identity) c) ClassState MethodState
-> StateT MethodState Identity c -> StateT ClassState Identity c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (StateT MethodState Identity) (CodeInfoOO ()))
  ClassState
  MethodState
(MethodState -> Focusing Identity (CodeInfoOO ()) MethodState)
-> ClassState -> Focusing Identity (CodeInfoOO ()) ClassState
Lens' ClassState MethodState
lensCStoMS) [State MethodState (CodeInfoOO ())]
[SMethod CodeInfoOO]
cs
    (State MethodState (CodeInfoOO ())
 -> State ClassState (CodeInfoOO ()))
-> [State MethodState (CodeInfoOO ())]
-> StateT ClassState Identity ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (LensLike'
  (Zoomed (StateT MethodState Identity) (CodeInfoOO ()))
  ClassState
  MethodState
-> State MethodState (CodeInfoOO ())
-> State ClassState (CodeInfoOO ())
forall c.
LensLike'
  (Zoomed (StateT MethodState Identity) c) ClassState MethodState
-> StateT MethodState Identity c -> StateT ClassState Identity c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (StateT MethodState Identity) (CodeInfoOO ()))
  ClassState
  MethodState
(MethodState -> Focusing Identity (CodeInfoOO ()) MethodState)
-> ClassState -> Focusing Identity (CodeInfoOO ()) ClassState
Lens' ClassState MethodState
lensCStoMS) [State MethodState (CodeInfoOO ())]
[SMethod CodeInfoOO]
ms
    State ClassState (CodeInfoOO ())
forall s. State s (CodeInfoOO ())
noInfo
  implementingClass :: String
-> [String]
-> [CSStateVar CodeInfoOO]
-> [SMethod CodeInfoOO]
-> [SMethod CodeInfoOO]
-> SClass CodeInfoOO
implementingClass String
n [String]
_ [CSStateVar CodeInfoOO]
_ [SMethod CodeInfoOO]
cs [SMethod CodeInfoOO]
ms = do
    (ClassState -> ClassState) -> StateT ClassState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (String -> ClassState -> ClassState
addClass String
n (ClassState -> ClassState)
-> (ClassState -> ClassState) -> ClassState -> ClassState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ClassState -> ClassState
setClassName String
n)
    (State MethodState (CodeInfoOO ())
 -> State ClassState (CodeInfoOO ()))
-> [State MethodState (CodeInfoOO ())]
-> StateT ClassState Identity ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (LensLike'
  (Zoomed (StateT MethodState Identity) (CodeInfoOO ()))
  ClassState
  MethodState
-> State MethodState (CodeInfoOO ())
-> State ClassState (CodeInfoOO ())
forall c.
LensLike'
  (Zoomed (StateT MethodState Identity) c) ClassState MethodState
-> StateT MethodState Identity c -> StateT ClassState Identity c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (StateT MethodState Identity) (CodeInfoOO ()))
  ClassState
  MethodState
(MethodState -> Focusing Identity (CodeInfoOO ()) MethodState)
-> ClassState -> Focusing Identity (CodeInfoOO ()) ClassState
Lens' ClassState MethodState
lensCStoMS) [State MethodState (CodeInfoOO ())]
[SMethod CodeInfoOO]
cs
    (State MethodState (CodeInfoOO ())
 -> State ClassState (CodeInfoOO ()))
-> [State MethodState (CodeInfoOO ())]
-> StateT ClassState Identity ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (LensLike'
  (Zoomed (StateT MethodState Identity) (CodeInfoOO ()))
  ClassState
  MethodState
-> State MethodState (CodeInfoOO ())
-> State ClassState (CodeInfoOO ())
forall c.
LensLike'
  (Zoomed (StateT MethodState Identity) c) ClassState MethodState
-> StateT MethodState Identity c -> StateT ClassState Identity c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (StateT MethodState Identity) (CodeInfoOO ()))
  ClassState
  MethodState
(MethodState -> Focusing Identity (CodeInfoOO ()) MethodState)
-> ClassState -> Focusing Identity (CodeInfoOO ()) ClassState
Lens' ClassState MethodState
lensCStoMS) [State MethodState (CodeInfoOO ())]
[SMethod CodeInfoOO]
ms
    State ClassState (CodeInfoOO ())
forall s. State s (CodeInfoOO ())
noInfo

  docClass :: String -> SClass CodeInfoOO -> SClass CodeInfoOO
docClass String
_ SClass CodeInfoOO
c = do
    CodeInfoOO ()
_ <- State ClassState (CodeInfoOO ())
SClass CodeInfoOO
c
    State ClassState (CodeInfoOO ())
forall s. State s (CodeInfoOO ())
noInfo

instance ModuleSym CodeInfoOO where
  type Module CodeInfoOO = ()
  buildModule :: String
-> [String]
-> [SMethod CodeInfoOO]
-> [SClass CodeInfoOO]
-> FSModule CodeInfoOO
buildModule String
n [String]
_ [SMethod CodeInfoOO]
funcs [SClass CodeInfoOO]
classes = do
    (FileState -> FileState) -> StateT FileState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (String -> FileState -> FileState
setModuleName String
n)
    (State ClassState (CodeInfoOO ())
 -> StateT FileState Identity (CodeInfoOO ()))
-> [State ClassState (CodeInfoOO ())]
-> StateT FileState Identity ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (LensLike'
  (Zoomed (StateT ClassState Identity) (CodeInfoOO ()))
  FileState
  ClassState
-> State ClassState (CodeInfoOO ())
-> StateT FileState Identity (CodeInfoOO ())
forall c.
LensLike'
  (Zoomed (StateT ClassState Identity) c) FileState ClassState
-> StateT ClassState Identity c -> StateT FileState Identity c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (StateT ClassState Identity) (CodeInfoOO ()))
  FileState
  ClassState
(ClassState -> Focusing Identity (CodeInfoOO ()) ClassState)
-> FileState -> Focusing Identity (CodeInfoOO ()) FileState
Lens' FileState ClassState
lensFStoCS) [State ClassState (CodeInfoOO ())]
[SClass CodeInfoOO]
classes 
    (State MethodState (CodeInfoOO ())
 -> StateT FileState Identity (CodeInfoOO ()))
-> [State MethodState (CodeInfoOO ())]
-> StateT FileState Identity ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (LensLike'
  (Zoomed (StateT MethodState Identity) (CodeInfoOO ()))
  FileState
  MethodState
-> State MethodState (CodeInfoOO ())
-> StateT FileState Identity (CodeInfoOO ())
forall c.
LensLike'
  (Zoomed (StateT MethodState Identity) c) FileState MethodState
-> StateT MethodState Identity c -> StateT FileState Identity c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (StateT MethodState Identity) (CodeInfoOO ()))
  FileState
  MethodState
(MethodState -> Focusing Identity (CodeInfoOO ()) MethodState)
-> FileState -> Focusing Identity (CodeInfoOO ()) FileState
Lens' FileState MethodState
lensFStoMS) [State MethodState (CodeInfoOO ())]
[SMethod CodeInfoOO]
funcs
    (FileState -> FileState)
-> CodeInfoOO () -> StateT FileState Identity (CodeInfoOO ())
forall s a. (s -> s) -> a -> State s a
modifyReturn (String -> FileState -> FileState
updateClassMap String
n) (() -> CodeInfoOO ()
forall (r :: * -> *) a. Monad r => a -> r a
toCode ())

-- Helpers

noInfo :: State s (CodeInfoOO ())
noInfo :: forall s. State s (CodeInfoOO ())
noInfo = CodeInfoOO () -> State s (CodeInfoOO ())
forall a s. a -> State s a
toState (CodeInfoOO () -> State s (CodeInfoOO ()))
-> CodeInfoOO () -> State s (CodeInfoOO ())
forall a b. (a -> b) -> a -> b
$ () -> CodeInfoOO ()
forall (r :: * -> *) a. Monad r => a -> r a
toCode ()

noInfoType :: State s (CodeInfoOO String)
noInfoType :: forall s. State s (CodeInfoOO String)
noInfoType = CodeInfoOO String -> State s (CodeInfoOO String)
forall a s. a -> State s a
toState (CodeInfoOO String -> State s (CodeInfoOO String))
-> CodeInfoOO String -> State s (CodeInfoOO String)
forall a b. (a -> b) -> a -> b
$ String -> CodeInfoOO String
forall (r :: * -> *) a. Monad r => a -> r a
toCode String
""

updateMEMandCM :: String -> MSBody CodeInfoOO -> SMethod CodeInfoOO
updateMEMandCM :: String -> MSBody CodeInfoOO -> SMethod CodeInfoOO
updateMEMandCM String
n MSBody CodeInfoOO
b = do
  CodeInfoOO ()
_ <- State MethodState (CodeInfoOO ())
MSBody CodeInfoOO
b
  (MethodState -> MethodState) -> StateT MethodState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (String -> MethodState -> MethodState
updateCallMap String
n (MethodState -> MethodState)
-> (MethodState -> MethodState) -> MethodState -> MethodState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> MethodState -> MethodState
updateMethodExcMap String
n)
  State MethodState (CodeInfoOO ())
forall s. State s (CodeInfoOO ())
noInfo

evalConds :: [(SValue CodeInfoOO, MSBody CodeInfoOO)] -> MSBody CodeInfoOO -> 
  MSStatement CodeInfoOO
evalConds :: [(SValue CodeInfoOO, MSBody CodeInfoOO)]
-> MSBody CodeInfoOO -> MSStatement CodeInfoOO
evalConds [(SValue CodeInfoOO, MSBody CodeInfoOO)]
cs MSBody CodeInfoOO
def = do
  ((State ValueState (CodeInfoOO ()),
  State MethodState (CodeInfoOO ()))
 -> State MethodState (CodeInfoOO ()))
-> [(State ValueState (CodeInfoOO ()),
     State MethodState (CodeInfoOO ()))]
-> StateT MethodState Identity ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (LensLike'
  (Zoomed (StateT ValueState Identity) (CodeInfoOO ()))
  MethodState
  ValueState
-> State ValueState (CodeInfoOO ())
-> State MethodState (CodeInfoOO ())
forall c.
LensLike'
  (Zoomed (StateT ValueState Identity) c) MethodState ValueState
-> StateT ValueState Identity c -> StateT MethodState Identity c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (StateT ValueState Identity) (CodeInfoOO ()))
  MethodState
  ValueState
(ValueState -> Focusing Identity (CodeInfoOO ()) ValueState)
-> MethodState -> Focusing Identity (CodeInfoOO ()) MethodState
Lens' MethodState ValueState
lensMStoVS (State ValueState (CodeInfoOO ())
 -> State MethodState (CodeInfoOO ()))
-> ((State ValueState (CodeInfoOO ()),
     State MethodState (CodeInfoOO ()))
    -> State ValueState (CodeInfoOO ()))
-> (State ValueState (CodeInfoOO ()),
    State MethodState (CodeInfoOO ()))
-> State MethodState (CodeInfoOO ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (State ValueState (CodeInfoOO ()),
 State MethodState (CodeInfoOO ()))
-> State ValueState (CodeInfoOO ())
forall a b. (a, b) -> a
fst) [(State ValueState (CodeInfoOO ()),
  State MethodState (CodeInfoOO ()))]
[(SValue CodeInfoOO, MSBody CodeInfoOO)]
cs
  ((State ValueState (CodeInfoOO ()),
  State MethodState (CodeInfoOO ()))
 -> State MethodState (CodeInfoOO ()))
-> [(State ValueState (CodeInfoOO ()),
     State MethodState (CodeInfoOO ()))]
-> StateT MethodState Identity ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (State ValueState (CodeInfoOO ()),
 State MethodState (CodeInfoOO ()))
-> State MethodState (CodeInfoOO ())
forall a b. (a, b) -> b
snd [(State ValueState (CodeInfoOO ()),
  State MethodState (CodeInfoOO ()))]
[(SValue CodeInfoOO, MSBody CodeInfoOO)]
cs
  CodeInfoOO ()
_ <- State MethodState (CodeInfoOO ())
MSBody CodeInfoOO
def
  State MethodState (CodeInfoOO ())
forall s. State s (CodeInfoOO ())
noInfo

addCurrModCall :: String -> SValue CodeInfoOO
addCurrModCall :: String -> SValue CodeInfoOO
addCurrModCall String
n = do
  String
mn <- LensLike'
  (Zoomed (StateT FileState Identity) String) ValueState FileState
-> StateT FileState Identity String
-> StateT ValueState Identity String
forall c.
LensLike'
  (Zoomed (StateT FileState Identity) c) ValueState FileState
-> StateT FileState Identity c -> StateT ValueState Identity c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (StateT FileState Identity) String) ValueState FileState
(FileState -> Focusing Identity String FileState)
-> ValueState -> Focusing Identity String ValueState
Lens' ValueState FileState
lensVStoFS StateT FileState Identity String
getModuleName 
  (ValueState -> ValueState) -> StateT ValueState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (QualifiedName -> ValueState -> ValueState
addCall (String -> String -> QualifiedName
qualName String
mn String
n)) 
  State ValueState (CodeInfoOO ())
forall s. State s (CodeInfoOO ())
noInfo

addCurrModConstructorCall :: VSType CodeInfoOO -> SValue CodeInfoOO
addCurrModConstructorCall :: VSType CodeInfoOO -> SValue CodeInfoOO
addCurrModConstructorCall VSType CodeInfoOO
ot = do
  CodeInfoOO String
t <- State ValueState (CodeInfoOO String)
VSType CodeInfoOO
ot
  let tp :: String
tp = CodeInfoOO (Type CodeInfoOO) -> String
forall (r :: * -> *). TypeElim r => r (Type r) -> String
getTypeString CodeInfoOO String
CodeInfoOO (Type CodeInfoOO)
t
  String -> SValue CodeInfoOO
addCurrModCall String
tp

addExternalCall :: String -> String -> SValue CodeInfoOO
addExternalCall :: String -> String -> SValue CodeInfoOO
addExternalCall String
l String
n = (ValueState -> ValueState) -> StateT ValueState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (QualifiedName -> ValueState -> ValueState
addCall (String -> String -> QualifiedName
qualName String
l String
n)) StateT ValueState Identity ()
-> State ValueState (CodeInfoOO ())
-> State ValueState (CodeInfoOO ())
forall a b.
StateT ValueState Identity a
-> StateT ValueState Identity b -> StateT ValueState Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> State ValueState (CodeInfoOO ())
forall s. State s (CodeInfoOO ())
noInfo

addExternalConstructorCall :: String -> VSType CodeInfoOO -> SValue CodeInfoOO
addExternalConstructorCall :: String -> VSType CodeInfoOO -> SValue CodeInfoOO
addExternalConstructorCall String
l VSType CodeInfoOO
ot = do
  CodeInfoOO String
t <- State ValueState (CodeInfoOO String)
VSType CodeInfoOO
ot
  let tp :: String
tp = CodeInfoOO (Type CodeInfoOO) -> String
forall (r :: * -> *). TypeElim r => r (Type r) -> String
getTypeString CodeInfoOO String
CodeInfoOO (Type CodeInfoOO)
t
  String -> String -> SValue CodeInfoOO
addExternalCall String
l String
tp

execute1 :: State a (CodeInfoOO ()) -> State a (CodeInfoOO ())
execute1 :: forall a. State a (CodeInfoOO ()) -> State a (CodeInfoOO ())
execute1 State a (CodeInfoOO ())
s = do
  CodeInfoOO ()
_ <- State a (CodeInfoOO ())
s
  State a (CodeInfoOO ())
forall s. State s (CodeInfoOO ())
noInfo

executeList :: [State a (CodeInfoOO ())] -> State a (CodeInfoOO ())
executeList :: forall a. [State a (CodeInfoOO ())] -> State a (CodeInfoOO ())
executeList [State a (CodeInfoOO ())]
l = do
  [State a (CodeInfoOO ())] -> StateT a Identity ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [State a (CodeInfoOO ())]
l
  State a (CodeInfoOO ())
forall s. State s (CodeInfoOO ())
noInfo

executePairList :: [(State a (CodeInfoOO ()), State a (CodeInfoOO ()))] -> 
  State a (CodeInfoOO ())
executePairList :: forall a.
[(State a (CodeInfoOO ()), State a (CodeInfoOO ()))]
-> State a (CodeInfoOO ())
executePairList [(State a (CodeInfoOO ()), State a (CodeInfoOO ()))]
ps = do
  ((State a (CodeInfoOO ()), State a (CodeInfoOO ()))
 -> State a (CodeInfoOO ()))
-> [(State a (CodeInfoOO ()), State a (CodeInfoOO ()))]
-> StateT a Identity ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (State a (CodeInfoOO ()), State a (CodeInfoOO ()))
-> State a (CodeInfoOO ())
forall a b. (a, b) -> a
fst [(State a (CodeInfoOO ()), State a (CodeInfoOO ()))]
ps
  ((State a (CodeInfoOO ()), State a (CodeInfoOO ()))
 -> State a (CodeInfoOO ()))
-> [(State a (CodeInfoOO ()), State a (CodeInfoOO ()))]
-> StateT a Identity ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (State a (CodeInfoOO ()), State a (CodeInfoOO ()))
-> State a (CodeInfoOO ())
forall a b. (a, b) -> b
snd [(State a (CodeInfoOO ()), State a (CodeInfoOO ()))]
ps
  State a (CodeInfoOO ())
forall s. State s (CodeInfoOO ())
noInfo

execute2 :: State a (CodeInfoOO ()) -> State a (CodeInfoOO ()) -> 
  State a (CodeInfoOO ())
execute2 :: forall a.
State a (CodeInfoOO ())
-> State a (CodeInfoOO ()) -> State a (CodeInfoOO ())
execute2 State a (CodeInfoOO ())
s1 State a (CodeInfoOO ())
s2 = do
  CodeInfoOO ()
_ <- State a (CodeInfoOO ())
s1
  State a (CodeInfoOO ()) -> State a (CodeInfoOO ())
forall a. State a (CodeInfoOO ()) -> State a (CodeInfoOO ())
execute1 State a (CodeInfoOO ())
s2

execute3 :: State a (CodeInfoOO ()) -> State a (CodeInfoOO ()) -> 
  State a (CodeInfoOO ()) -> State a (CodeInfoOO ())
execute3 :: forall a.
State a (CodeInfoOO ())
-> State a (CodeInfoOO ())
-> State a (CodeInfoOO ())
-> State a (CodeInfoOO ())
execute3 State a (CodeInfoOO ())
s1 State a (CodeInfoOO ())
s2 State a (CodeInfoOO ())
s3 = do
  CodeInfoOO ()
_ <- State a (CodeInfoOO ())
s1
  State a (CodeInfoOO ())
-> State a (CodeInfoOO ()) -> State a (CodeInfoOO ())
forall a.
State a (CodeInfoOO ())
-> State a (CodeInfoOO ()) -> State a (CodeInfoOO ())
execute2 State a (CodeInfoOO ())
s2 State a (CodeInfoOO ())
s3

execute4 :: State a (CodeInfoOO ()) -> State a (CodeInfoOO ()) -> 
  State a (CodeInfoOO ()) -> State a (CodeInfoOO ()) -> State a (CodeInfoOO ())
execute4 :: forall a.
State a (CodeInfoOO ())
-> State a (CodeInfoOO ())
-> State a (CodeInfoOO ())
-> State a (CodeInfoOO ())
-> State a (CodeInfoOO ())
execute4 State a (CodeInfoOO ())
s1 State a (CodeInfoOO ())
s2 State a (CodeInfoOO ())
s3 State a (CodeInfoOO ())
s4 = do
  CodeInfoOO ()
_ <- State a (CodeInfoOO ())
s1
  State a (CodeInfoOO ())
-> State a (CodeInfoOO ())
-> State a (CodeInfoOO ())
-> State a (CodeInfoOO ())
forall a.
State a (CodeInfoOO ())
-> State a (CodeInfoOO ())
-> State a (CodeInfoOO ())
-> State a (CodeInfoOO ())
execute3 State a (CodeInfoOO ())
s2 State a (CodeInfoOO ())
s3 State a (CodeInfoOO ())
s4

currModCall :: String -> [VS (CodeInfoOO ())] -> 
  [(VS (CodeInfoOO ()), VS (CodeInfoOO ()))] -> VS (CodeInfoOO ())
currModCall :: String
-> [State ValueState (CodeInfoOO ())]
-> [(State ValueState (CodeInfoOO ()),
     State ValueState (CodeInfoOO ()))]
-> State ValueState (CodeInfoOO ())
currModCall String
n [State ValueState (CodeInfoOO ())]
ps [(State ValueState (CodeInfoOO ()),
  State ValueState (CodeInfoOO ()))]
ns = do
  [State ValueState (CodeInfoOO ())] -> StateT ValueState Identity ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [State ValueState (CodeInfoOO ())]
ps
  [(State ValueState (CodeInfoOO ()),
  State ValueState (CodeInfoOO ()))]
-> State ValueState (CodeInfoOO ())
forall a.
[(State a (CodeInfoOO ()), State a (CodeInfoOO ()))]
-> State a (CodeInfoOO ())
executePairList [(State ValueState (CodeInfoOO ()),
  State ValueState (CodeInfoOO ()))]
ns
  String -> SValue CodeInfoOO
addCurrModCall String
n