{-# LANGUAGE PostfixOperators #-}

-- | Language-polymorphic functions that are defined by GOOL code
module Drasil.GOOL.LanguageRenderer.Macros (
  ifExists, decrement1, increment, increment1, runStrategy, 
  listSlice, makeSetterVal, stringListVals, stringListLists, forRange, notifyObservers,
  notifyObservers'
) where

import Drasil.GOOL.CodeType (CodeType(..))
import Drasil.GOOL.InterfaceCommon (Label, MSBody, MSBlock, VSFunction, VSType,
  SVariable, SValue, MSStatement, bodyStatements, oneLiner, TypeElim(getType),
  VariableElim(..), listOf, ValueSym(valueType), 
  NumericExpression((#+), (#-), (#*), (#/)), Comparison(..),
  BooleanExpression((?&&), (?||)), at, StatementSym(multi),
  AssignStatement((&+=), (&-=), (&++)), (&=), convScope)
import qualified Drasil.GOOL.InterfaceCommon as IC (BlockSym(block), 
  TypeSym(int, listInnerType), VariableSym(var), ScopeSym(..), Literal(litInt),
  VariableValue(valueOf), ValueExpression(notNull), List(listSize, listAppend,
  listAccess, intToIndex), StatementSym(valStmt, emptyStmt), AssignStatement(assign),
  DeclStatement(varDecDef, listDec),  ControlStatement(ifCond, for, forRange),
  ValueExpression(inlineIf))
import Drasil.GOOL.InterfaceGOOL (($.), observerListName)
import Drasil.GOOL.RendererClassesCommon (CommonRenderSym, RenderValue(cast),
  ValueElim(valueInt))
import qualified Drasil.GOOL.RendererClassesCommon as S (
  RenderStatement(stmt))
import qualified Drasil.GOOL.RendererClassesCommon as RC (BodyElim(..),
  StatementElim(statement))
import Drasil.GOOL.RendererClassesOO (OORenderSym)
import Drasil.GOOL.Helpers (toCode, onStateValue, on2StateValues)
import Drasil.GOOL.State (MS, lensMStoVS, genVarName, genLoopIndex,
  genVarNameIf, getVarScope)

import Data.Maybe (fromMaybe, isNothing)
import Data.Functor ((<&>))
import Control.Lens.Zoom (zoom)
import Text.PrettyPrint.HughesPJ (Doc, vcat)

ifExists :: (CommonRenderSym r) => SValue r -> MSBody r -> MSBody r -> MSStatement r
ifExists :: forall (r :: * -> *).
CommonRenderSym r =>
SValue r -> MSBody r -> MSBody r -> MSStatement r
ifExists SValue r
v MSBody r
ifBody = [(SValue r, MSBody r)]
-> MSBody r -> StateT MethodState Identity (r (Statement r))
forall (r :: * -> *).
ControlStatement r =>
[(SValue r, MSBody r)] -> MSBody r -> MSStatement r
IC.ifCond [(SValue r -> SValue r
forall (r :: * -> *). ValueExpression r => SValue r -> SValue r
IC.notNull SValue r
v, MSBody r
ifBody)]

decrement1 :: (CommonRenderSym r) => SVariable r -> MSStatement r
decrement1 :: forall (r :: * -> *).
CommonRenderSym r =>
SVariable r -> MSStatement r
decrement1 SVariable r
v = SVariable r
v SVariable r
-> SValue r -> StateT MethodState Identity (r (Statement r))
forall (r :: * -> *).
AssignStatement r =>
SVariable r -> SValue r -> MSStatement r
&-= Integer -> SValue r
forall (r :: * -> *). Literal r => Integer -> SValue r
IC.litInt Integer
1

increment :: (CommonRenderSym r) => SVariable r -> SValue r -> MSStatement r
increment :: forall (r :: * -> *).
CommonRenderSym r =>
SVariable r -> SValue r -> MSStatement r
increment SVariable r
vr SValue r
vl = SVariable r
vr SVariable r
-> SValue r -> StateT MethodState Identity (r (Statement r))
forall (r :: * -> *).
AssignStatement r =>
SVariable r -> SValue r -> MSStatement r
&= SVariable r -> SValue r
forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
IC.valueOf SVariable r
vr SValue r -> SValue r -> SValue r
forall (r :: * -> *).
NumericExpression r =>
SValue r -> SValue r -> SValue r
#+ SValue r
vl

increment1 :: (CommonRenderSym r) => SVariable r -> MSStatement r
increment1 :: forall (r :: * -> *).
CommonRenderSym r =>
SVariable r -> MSStatement r
increment1 SVariable r
vr = SVariable r
vr SVariable r
-> SValue r -> StateT MethodState Identity (r (Statement r))
forall (r :: * -> *).
AssignStatement r =>
SVariable r -> SValue r -> MSStatement r
&+= Integer -> SValue r
forall (r :: * -> *). Literal r => Integer -> SValue r
IC.litInt Integer
1

strat :: (CommonRenderSym r, Monad r) => MSStatement r -> MSBody r -> MS (r Doc)
strat :: forall (r :: * -> *).
(CommonRenderSym r, Monad r) =>
MSStatement r -> MSBody r -> MS (r Doc)
strat = (r (Statement r) -> r (Body r) -> r Doc)
-> StateT MethodState Identity (r (Statement r))
-> StateT MethodState Identity (r (Body r))
-> StateT MethodState Identity (r Doc)
forall a b c s.
(a -> b -> c) -> State s a -> State s b -> State s c
on2StateValues (\r (Statement r)
result r (Body r)
b -> Doc -> r Doc
forall (r :: * -> *) a. Monad r => a -> r a
toCode (Doc -> r Doc) -> Doc -> r Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat [r (Body r) -> Doc
forall (r :: * -> *). BodyElim r => r (Body r) -> Doc
RC.body r (Body r)
b, 
  r (Statement r) -> Doc
forall (r :: * -> *). StatementElim r => r (Statement r) -> Doc
RC.statement r (Statement r)
result])

runStrategy :: (CommonRenderSym r, Monad r) => Label -> [(Label, MSBody r)] -> 
  Maybe (SValue r) -> Maybe (SVariable r) -> MS (r Doc)
runStrategy :: forall (r :: * -> *).
(CommonRenderSym r, Monad r) =>
Label
-> [(Label, MSBody r)]
-> Maybe (SValue r)
-> Maybe (SVariable r)
-> MS (r Doc)
runStrategy Label
l [(Label, MSBody r)]
strats Maybe (SValue r)
rv Maybe (SVariable r)
av = MS (r Doc)
-> (MSBody r -> MS (r Doc)) -> Maybe (MSBody r) -> MS (r Doc)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
  (Label -> Label -> MS (r Doc)
forall {a}. Label -> Label -> a
strError Label
l Label
"RunStrategy called on non-existent strategy") 
  (MSStatement r -> MSBody r -> MS (r Doc)
forall (r :: * -> *).
(CommonRenderSym r, Monad r) =>
MSStatement r -> MSBody r -> MS (r Doc)
strat (MSStatement r -> MSStatement r
forall (r :: * -> *).
RenderStatement r =>
MSStatement r -> MSStatement r
S.stmt MSStatement r
resultState)) (Label -> [(Label, MSBody r)] -> Maybe (MSBody r)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Label
l [(Label, MSBody r)]
strats)
  where resultState :: MSStatement r
resultState = MSStatement r
-> (SVariable r -> MSStatement r)
-> Maybe (SVariable r)
-> MSStatement r
forall b a. b -> (a -> b) -> Maybe a -> b
maybe MSStatement r
forall (r :: * -> *). StatementSym r => MSStatement r
IC.emptyStmt SVariable r -> MSStatement r
asgState Maybe (SVariable r)
av
        asgState :: SVariable r -> MSStatement r
asgState SVariable r
v = MSStatement r
-> (SValue r -> MSStatement r) -> Maybe (SValue r) -> MSStatement r
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Label -> Label -> MSStatement r
forall {a}. Label -> Label -> a
strError Label
l 
          Label
"Attempt to assign null return to a Value") (SVariable r
v &=) Maybe (SValue r)
rv
        strError :: Label -> Label -> a
strError Label
n Label
s = Label -> a
forall a. HasCallStack => Label -> a
error (Label -> a) -> Label -> a
forall a b. (a -> b) -> a -> b
$ Label
"Strategy '" Label -> Label -> Label
forall a. [a] -> [a] -> [a]
++ Label
n Label -> Label -> Label
forall a. [a] -> [a] -> [a]
++ Label
"': " Label -> Label -> Label
forall a. [a] -> [a] -> [a]
++ Label
s Label -> Label -> Label
forall a. [a] -> [a] -> [a]
++ Label
"."

listSlice :: (CommonRenderSym r) => Maybe (SValue r) -> Maybe (SValue r) -> 
  Maybe (SValue r) -> SVariable r -> SValue r -> MSBlock r
listSlice :: forall (r :: * -> *).
CommonRenderSym r =>
Maybe (SValue r)
-> Maybe (SValue r)
-> Maybe (SValue r)
-> SVariable r
-> SValue r
-> MSBlock r
listSlice Maybe (SValue r)
beg Maybe (SValue r)
end Maybe (SValue r)
step SVariable r
vnew SValue r
vold = do
  
  Label
l_temp <- [Label] -> Label -> MS Label
genVarName [] Label
"temp"
  Label
l_i <- MS Label
genLoopIndex
  r (Variable r)
vn <- LensLike'
  (Zoomed (StateT ValueState Identity) (r (Variable r)))
  MethodState
  ValueState
-> SVariable r -> StateT MethodState Identity (r (Variable r))
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) (r (Variable r)))
  MethodState
  ValueState
(ValueState -> Focusing Identity (r (Variable r)) ValueState)
-> MethodState -> Focusing Identity (r (Variable r)) MethodState
Lens' MethodState ValueState
lensMStoVS SVariable r
vnew
  ScopeData
scpData <- Label -> MS ScopeData
getVarScope (Label -> MS ScopeData) -> Label -> MS ScopeData
forall a b. (a -> b) -> a -> b
$ r (Variable r) -> Label
forall (r :: * -> *). VariableElim r => r (Variable r) -> Label
variableName r (Variable r)
vn
  let scp :: r (Scope r)
scp = ScopeData -> r (Scope r)
forall (r :: * -> *). ScopeSym r => ScopeData -> r (Scope r)
convScope ScopeData
scpData
      var_temp :: SVariable r
var_temp = Label -> VSType r -> SVariable r
forall (r :: * -> *).
VariableSym r =>
Label -> VSType r -> SVariable r
IC.var Label
l_temp ((r (Variable r) -> r (Type r)) -> SVariable r -> VSType r
forall a b s. (a -> b) -> State s a -> State s b
onStateValue r (Variable r) -> r (Type r)
forall (r :: * -> *).
VariableElim r =>
r (Variable r) -> r (Type r)
variableType SVariable r
vnew)
      v_temp :: SValue r
v_temp = SVariable r -> SValue r
forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
IC.valueOf SVariable r
var_temp
      var_i :: SVariable r
var_i = Label -> VSType r -> SVariable r
forall (r :: * -> *).
VariableSym r =>
Label -> VSType r -> SVariable r
IC.var Label
l_i VSType r
forall (r :: * -> *). TypeSym r => VSType r
IC.int
      v_i :: SValue r
v_i = SVariable r -> SValue r
forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
IC.valueOf SVariable r
var_i

  let step' :: SValue r
step' = SValue r -> Maybe (SValue r) -> SValue r
forall a. a -> Maybe a -> a
fromMaybe (Integer -> SValue r
forall (r :: * -> *). Literal r => Integer -> SValue r
IC.litInt Integer
1) Maybe (SValue r)
step
  r (Value r)
stepV <- LensLike'
  (Zoomed (StateT ValueState Identity) (r (Value r)))
  MethodState
  ValueState
-> SValue r -> StateT MethodState Identity (r (Value r))
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) (r (Value r)))
  MethodState
  ValueState
(ValueState -> Focusing Identity (r (Value r)) ValueState)
-> MethodState -> Focusing Identity (r (Value r)) MethodState
Lens' MethodState ValueState
lensMStoVS SValue r
step'
  let mbStepV :: Maybe Integer
mbStepV = r (Value r) -> Maybe Integer
forall (r :: * -> *). ValueElim r => r (Value r) -> Maybe Integer
valueInt r (Value r)
stepV

  -- Generate fresh variable names if required
  Label
begName <- Bool -> Label -> MS Label
genVarNameIf (Maybe (SValue r) -> Bool
forall a. Maybe a -> Bool
isNothing Maybe (SValue r)
beg Bool -> Bool -> Bool
&& Maybe Integer -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Integer
mbStepV) Label
"begIdx"
  Label
endName <- Bool -> Label -> MS Label
genVarNameIf (Maybe (SValue r) -> Bool
forall a. Maybe a -> Bool
isNothing Maybe (SValue r)
end Bool -> Bool -> Bool
&& Maybe Integer -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Integer
mbStepV) Label
"endIdx"

  let (MSStatement r
setBeg, SValue r
begVal) = Label
-> SValue r
-> Maybe Integer
-> Maybe (SValue r)
-> SValue r
-> SValue r
-> r (Scope r)
-> (MSStatement r, SValue r)
forall (r :: * -> *).
CommonRenderSym r =>
Label
-> SValue r
-> Maybe Integer
-> Maybe (SValue r)
-> SValue r
-> SValue r
-> r (Scope r)
-> (MSStatement r, SValue r)
makeSetterVal Label
begName SValue r
step' Maybe Integer
mbStepV Maybe (SValue r)
beg (Integer -> SValue r
forall (r :: * -> *). Literal r => Integer -> SValue r
IC.litInt Integer
0)    (SValue r -> SValue r
forall (r :: * -> *). List r => SValue r -> SValue r
IC.listSize SValue r
vold SValue r -> SValue r -> SValue r
forall (r :: * -> *).
NumericExpression r =>
SValue r -> SValue r -> SValue r
#- Integer -> SValue r
forall (r :: * -> *). Literal r => Integer -> SValue r
IC.litInt Integer
1) r (Scope r)
scp
      (MSStatement r
setEnd, SValue r
endVal) = Label
-> SValue r
-> Maybe Integer
-> Maybe (SValue r)
-> SValue r
-> SValue r
-> r (Scope r)
-> (MSStatement r, SValue r)
forall (r :: * -> *).
CommonRenderSym r =>
Label
-> SValue r
-> Maybe Integer
-> Maybe (SValue r)
-> SValue r
-> SValue r
-> r (Scope r)
-> (MSStatement r, SValue r)
makeSetterVal Label
endName SValue r
step' Maybe Integer
mbStepV Maybe (SValue r)
end (SValue r -> SValue r
forall (r :: * -> *). List r => SValue r -> SValue r
IC.listSize SValue r
vold) (Integer -> SValue r
forall (r :: * -> *). Literal r => Integer -> SValue r
IC.litInt (-Integer
1)) r (Scope r)
scp

  Maybe Integer
mbBegV <- case Maybe (SValue r)
beg of
        Maybe (SValue r)
Nothing -> Maybe Integer -> StateT MethodState Identity (Maybe Integer)
forall a. a -> StateT MethodState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Integer
forall a. Maybe a
Nothing
        (Just SValue r
b) -> LensLike'
  (Zoomed (StateT ValueState Identity) (r (Value r)))
  MethodState
  ValueState
-> SValue r -> StateT MethodState Identity (r (Value r))
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) (r (Value r)))
  MethodState
  ValueState
(ValueState -> Focusing Identity (r (Value r)) ValueState)
-> MethodState -> Focusing Identity (r (Value r)) MethodState
Lens' MethodState ValueState
lensMStoVS SValue r
b StateT MethodState Identity (r (Value r))
-> (r (Value r) -> Maybe Integer)
-> StateT MethodState Identity (Maybe Integer)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> r (Value r) -> Maybe Integer
forall (r :: * -> *). ValueElim r => r (Value r) -> Maybe Integer
valueInt
  Maybe Integer
mbEndV <- case Maybe (SValue r)
end of
        Maybe (SValue r)
Nothing -> Maybe Integer -> StateT MethodState Identity (Maybe Integer)
forall a. a -> StateT MethodState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Integer
forall a. Maybe a
Nothing
        (Just SValue r
e) -> LensLike'
  (Zoomed (StateT ValueState Identity) (r (Value r)))
  MethodState
  ValueState
-> SValue r -> StateT MethodState Identity (r (Value r))
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) (r (Value r)))
  MethodState
  ValueState
(ValueState -> Focusing Identity (r (Value r)) ValueState)
-> MethodState -> Focusing Identity (r (Value r)) MethodState
Lens' MethodState ValueState
lensMStoVS SValue r
e StateT MethodState Identity (r (Value r))
-> (r (Value r) -> Maybe Integer)
-> StateT MethodState Identity (Maybe Integer)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> r (Value r) -> Maybe Integer
forall (r :: * -> *). ValueElim r => r (Value r) -> Maybe Integer
valueInt
  -- Get the condition for the for-loop
  let cond :: SValue r
cond = case Maybe Integer
mbStepV of
              -- If step is a litInt, do a one-sided check
              (Just Integer
s) -> if Integer
s Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0 then SValue r
v_i SValue r -> SValue r -> SValue r
forall (r :: * -> *).
Comparison r =>
SValue r -> SValue r -> SValue r
?< SValue r
endVal else SValue r
v_i SValue r -> SValue r -> SValue r
forall (r :: * -> *).
Comparison r =>
SValue r -> SValue r -> SValue r
?> SValue r
endVal
              Maybe Integer
Nothing -> case (Maybe Integer
mbBegV, Maybe Integer
mbEndV) of
                -- If both bounds are litInt's, do a two-sided check.
                -- Also, make sure step is in same direction as check.
                (Just Integer
b, Just Integer
e) -> if Integer
e Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
b 
                    then SValue r
begVal SValue r -> SValue r -> SValue r
forall (r :: * -> *).
Comparison r =>
SValue r -> SValue r -> SValue r
?<= SValue r
v_i SValue r -> SValue r -> SValue r
forall (r :: * -> *).
BooleanExpression r =>
SValue r -> SValue r -> SValue r
?&& SValue r
v_i SValue r -> SValue r -> SValue r
forall (r :: * -> *).
Comparison r =>
SValue r -> SValue r -> SValue r
?< SValue r
endVal SValue r -> SValue r -> SValue r
forall (r :: * -> *).
BooleanExpression r =>
SValue r -> SValue r -> SValue r
?&& SValue r
step' SValue r -> SValue r -> SValue r
forall (r :: * -> *).
Comparison r =>
SValue r -> SValue r -> SValue r
?> Integer -> SValue r
forall (r :: * -> *). Literal r => Integer -> SValue r
IC.litInt Integer
0
                    else SValue r
endVal SValue r -> SValue r -> SValue r
forall (r :: * -> *).
Comparison r =>
SValue r -> SValue r -> SValue r
?< SValue r
v_i SValue r -> SValue r -> SValue r
forall (r :: * -> *).
BooleanExpression r =>
SValue r -> SValue r -> SValue r
?&& SValue r
v_i SValue r -> SValue r -> SValue r
forall (r :: * -> *).
Comparison r =>
SValue r -> SValue r -> SValue r
?<= SValue r
begVal SValue r -> SValue r -> SValue r
forall (r :: * -> *).
BooleanExpression r =>
SValue r -> SValue r -> SValue r
?&& SValue r
step' SValue r -> SValue r -> SValue r
forall (r :: * -> *).
Comparison r =>
SValue r -> SValue r -> SValue r
?< Integer -> SValue r
forall (r :: * -> *). Literal r => Integer -> SValue r
IC.litInt Integer
0
                -- If bounds are not litInt's, do both two-sided checks
                (Maybe Integer, Maybe Integer)
_ ->  SValue r
begVal SValue r -> SValue r -> SValue r
forall (r :: * -> *).
Comparison r =>
SValue r -> SValue r -> SValue r
?<= SValue r
v_i SValue r -> SValue r -> SValue r
forall (r :: * -> *).
BooleanExpression r =>
SValue r -> SValue r -> SValue r
?&& SValue r
v_i SValue r -> SValue r -> SValue r
forall (r :: * -> *).
Comparison r =>
SValue r -> SValue r -> SValue r
?< SValue r
endVal SValue r -> SValue r -> SValue r
forall (r :: * -> *).
BooleanExpression r =>
SValue r -> SValue r -> SValue r
?&& SValue r
step' SValue r -> SValue r -> SValue r
forall (r :: * -> *).
Comparison r =>
SValue r -> SValue r -> SValue r
?> Integer -> SValue r
forall (r :: * -> *). Literal r => Integer -> SValue r
IC.litInt Integer
0 SValue r -> SValue r -> SValue r
forall (r :: * -> *).
BooleanExpression r =>
SValue r -> SValue r -> SValue r
?|| 
                      SValue r
endVal SValue r -> SValue r -> SValue r
forall (r :: * -> *).
Comparison r =>
SValue r -> SValue r -> SValue r
?< SValue r
v_i SValue r -> SValue r -> SValue r
forall (r :: * -> *).
BooleanExpression r =>
SValue r -> SValue r -> SValue r
?&& SValue r
v_i SValue r -> SValue r -> SValue r
forall (r :: * -> *).
Comparison r =>
SValue r -> SValue r -> SValue r
?<= SValue r
begVal SValue r -> SValue r -> SValue r
forall (r :: * -> *).
BooleanExpression r =>
SValue r -> SValue r -> SValue r
?&& SValue r
step' SValue r -> SValue r -> SValue r
forall (r :: * -> *).
Comparison r =>
SValue r -> SValue r -> SValue r
?< Integer -> SValue r
forall (r :: * -> *). Literal r => Integer -> SValue r
IC.litInt Integer
0

  [MSStatement r] -> MSBlock r
forall (r :: * -> *). BlockSym r => [MSStatement r] -> MSBlock r
IC.block [
    Integer -> SVariable r -> r (Scope r) -> MSStatement r
forall (r :: * -> *).
DeclStatement r =>
Integer -> SVariable r -> r (Scope r) -> MSStatement r
IC.listDec Integer
0 SVariable r
var_temp r (Scope r)
scp,
    MSStatement r
setBeg, MSStatement r
setEnd,
    MSStatement r
-> SValue r -> MSStatement r -> MSBody r -> MSStatement r
forall (r :: * -> *).
ControlStatement r =>
MSStatement r
-> SValue r -> MSStatement r -> MSBody r -> MSStatement r
IC.for (SVariable r -> r (Scope r) -> SValue r -> MSStatement r
forall (r :: * -> *).
DeclStatement r =>
SVariable r -> r (Scope r) -> SValue r -> MSStatement r
IC.varDecDef SVariable r
var_i r (Scope r)
forall (r :: * -> *). ScopeSym r => r (Scope r)
IC.local SValue r
begVal) SValue r
cond
      (MSStatement r
-> (SValue r -> MSStatement r) -> Maybe (SValue r) -> MSStatement r
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (SVariable r
var_i &++) (SVariable r
var_i &+=) Maybe (SValue r)
step)
      (MSStatement r -> MSBody r
forall (r :: * -> *). BodySym r => MSStatement r -> MSBody r
oneLiner (MSStatement r -> MSBody r) -> MSStatement r -> MSBody r
forall a b. (a -> b) -> a -> b
$ SValue r -> MSStatement r
forall (r :: * -> *). StatementSym r => SValue r -> MSStatement r
IC.valStmt (SValue r -> MSStatement r) -> SValue r -> MSStatement r
forall a b. (a -> b) -> a -> b
$ SValue r -> SValue r -> SValue r
forall (r :: * -> *). List r => SValue r -> SValue r -> SValue r
IC.listAppend SValue r
v_temp (SValue r -> SValue r -> SValue r
forall (r :: * -> *). List r => SValue r -> SValue r -> SValue r
IC.listAccess SValue r
vold SValue r
v_i)),
    SVariable r
vnew SVariable r -> SValue r -> MSStatement r
forall (r :: * -> *).
AssignStatement r =>
SVariable r -> SValue r -> MSStatement r
&= SValue r
v_temp]

-- Java, C#, C++, and Swift --
-- | Gets the expression and code for setting bounds in a list slice
--   Input: 
--   - String: Variable name for bound (to be created if necessary),
--   - SValue: step value
--   - Maybe Integer: literal value of step, if exists
--   - Maybe SValue: given value of bound
--   - SValue: value of bound if bound not given and step is positive
--   - SValue: value of bound if bound not given and step is negative
--   Output: (MSStatement, SValue): (setter, value) of bound
makeSetterVal :: (CommonRenderSym r) => Label -> SValue r -> Maybe Integer ->
  Maybe (SValue r) -> SValue r -> SValue r -> r (IC.Scope r) ->
  (MSStatement r, SValue r)
makeSetterVal :: forall (r :: * -> *).
CommonRenderSym r =>
Label
-> SValue r
-> Maybe Integer
-> Maybe (SValue r)
-> SValue r
-> SValue r
-> r (Scope r)
-> (MSStatement r, SValue r)
makeSetterVal Label
_     SValue r
_    Maybe Integer
_      (Just SValue r
v) SValue r
_  SValue r
_  r (Scope r)
_   = (MSStatement r
forall (r :: * -> *). StatementSym r => MSStatement r
IC.emptyStmt, SValue r
v)
makeSetterVal Label
_     SValue r
_   (Just Integer
s) Maybe (SValue r)
_       SValue r
lb SValue r
rb r (Scope r)
_   = (MSStatement r
forall (r :: * -> *). StatementSym r => MSStatement r
IC.emptyStmt, if Integer
s Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0 then SValue r
lb else SValue r
rb)
makeSetterVal Label
vName SValue r
step Maybe Integer
_       Maybe (SValue r)
_       SValue r
lb SValue r
rb  r (Scope r)
scp =
  let theVar :: SVariable r
theVar = Label -> VSType r -> SVariable r
forall (r :: * -> *).
VariableSym r =>
Label -> VSType r -> SVariable r
IC.var Label
vName VSType r
forall (r :: * -> *). TypeSym r => VSType r
IC.int
      theSetter :: MSStatement r
theSetter = SVariable r -> r (Scope r) -> SValue r -> MSStatement r
forall (r :: * -> *).
DeclStatement r =>
SVariable r -> r (Scope r) -> SValue r -> MSStatement r
IC.varDecDef SVariable r
theVar r (Scope r)
scp (SValue r -> MSStatement r) -> SValue r -> MSStatement r
forall a b. (a -> b) -> a -> b
$ SValue r -> SValue r -> SValue r -> SValue r
forall (r :: * -> *).
ValueExpression r =>
SValue r -> SValue r -> SValue r -> SValue r
IC.inlineIf (SValue r
step SValue r -> SValue r -> SValue r
forall (r :: * -> *).
Comparison r =>
SValue r -> SValue r -> SValue r
?> Integer -> SValue r
forall (r :: * -> *). Literal r => Integer -> SValue r
IC.litInt Integer
0) SValue r
lb SValue r
rb
  in (MSStatement r
theSetter, SValue r -> SValue r
forall (r :: * -> *). List r => SValue r -> SValue r
IC.intToIndex (SValue r -> SValue r) -> SValue r -> SValue r
forall a b. (a -> b) -> a -> b
$ SVariable r -> SValue r
forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
IC.valueOf SVariable r
theVar)

stringListVals :: (CommonRenderSym r) => [SVariable r] -> SValue r -> MSStatement r
stringListVals :: forall (r :: * -> *).
CommonRenderSym r =>
[SVariable r] -> SValue r -> MSStatement r
stringListVals [SVariable r]
vars SValue r
sl = LensLike'
  (Zoomed (StateT ValueState Identity) (r (Value r)))
  MethodState
  ValueState
-> SValue r -> StateT MethodState Identity (r (Value r))
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) (r (Value r)))
  MethodState
  ValueState
(ValueState -> Focusing Identity (r (Value r)) ValueState)
-> MethodState -> Focusing Identity (r (Value r)) MethodState
Lens' MethodState ValueState
lensMStoVS SValue r
sl StateT MethodState Identity (r (Value r))
-> (r (Value r) -> StateT MethodState Identity (r (Statement r)))
-> StateT MethodState Identity (r (Statement r))
forall a b.
StateT MethodState Identity a
-> (a -> StateT MethodState Identity b)
-> StateT MethodState Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\r (Value r)
slst -> [StateT MethodState Identity (r (Statement r))]
-> StateT MethodState Identity (r (Statement r))
forall (r :: * -> *).
StatementSym r =>
[MSStatement r] -> MSStatement r
multi ([StateT MethodState Identity (r (Statement r))]
 -> StateT MethodState Identity (r (Statement r)))
-> [StateT MethodState Identity (r (Statement r))]
-> StateT MethodState Identity (r (Statement r))
forall a b. (a -> b) -> a -> b
$ CodeType -> [StateT MethodState Identity (r (Statement r))]
checkList 
  (r (Type r) -> CodeType
forall (r :: * -> *). TypeElim r => r (Type r) -> CodeType
getType (r (Type r) -> CodeType) -> r (Type r) -> CodeType
forall a b. (a -> b) -> a -> b
$ r (Value r) -> r (Type r)
forall (r :: * -> *). ValueSym r => r (Value r) -> r (Type r)
valueType r (Value r)
slst))
  where checkList :: CodeType -> [StateT MethodState Identity (r (Statement r))]
checkList (List CodeType
String) = [SVariable r]
-> Integer -> [StateT MethodState Identity (r (Statement r))]
assignVals [SVariable r]
vars Integer
0
        checkList CodeType
_ = Label -> [StateT MethodState Identity (r (Statement r))]
forall a. HasCallStack => Label -> a
error 
          Label
"Value passed to stringListVals must be a list of strings"
        assignVals :: [SVariable r]
-> Integer -> [StateT MethodState Identity (r (Statement r))]
assignVals [] Integer
_ = []
        assignVals (SVariable r
v:[SVariable r]
vs) Integer
n = SVariable r
-> SValue r -> StateT MethodState Identity (r (Statement r))
forall (r :: * -> *).
AssignStatement r =>
SVariable r -> SValue r -> MSStatement r
IC.assign SVariable r
v (VSType r -> SValue r -> SValue r
forall (r :: * -> *).
RenderValue r =>
VSType r -> SValue r -> SValue r
cast ((r (Variable r) -> r (Type r)) -> SVariable r -> VSType r
forall a b s. (a -> b) -> State s a -> State s b
onStateValue r (Variable r) -> r (Type r)
forall (r :: * -> *).
VariableElim r =>
r (Variable r) -> r (Type r)
variableType SVariable r
v) 
          (SValue r -> SValue r -> SValue r
forall (r :: * -> *). List r => SValue r -> SValue r -> SValue r
IC.listAccess SValue r
sl (Integer -> SValue r
forall (r :: * -> *). Literal r => Integer -> SValue r
IC.litInt Integer
n))) StateT MethodState Identity (r (Statement r))
-> [StateT MethodState Identity (r (Statement r))]
-> [StateT MethodState Identity (r (Statement r))]
forall a. a -> [a] -> [a]
: [SVariable r]
-> Integer -> [StateT MethodState Identity (r (Statement r))]
assignVals [SVariable r]
vs (Integer
nInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
1)

stringListLists :: (CommonRenderSym r) => [SVariable r] -> SValue r -> MSStatement r
stringListLists :: forall (r :: * -> *).
CommonRenderSym r =>
[SVariable r] -> SValue r -> MSStatement r
stringListLists [SVariable r]
lsts SValue r
sl = do
  r (Value r)
slst <- LensLike'
  (Zoomed (StateT ValueState Identity) (r (Value r)))
  MethodState
  ValueState
-> SValue r -> StateT MethodState Identity (r (Value r))
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) (r (Value r)))
  MethodState
  ValueState
(ValueState -> Focusing Identity (r (Value r)) ValueState)
-> MethodState -> Focusing Identity (r (Value r)) MethodState
Lens' MethodState ValueState
lensMStoVS SValue r
sl
  Label
l_i <- MS Label
genLoopIndex
  let
    checkList :: CodeType -> MSStatement r
checkList (List CodeType
String) = (SVariable r -> StateT MethodState Identity (r (Variable r)))
-> [SVariable r] -> StateT MethodState Identity [r (Variable r)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (LensLike'
  (Zoomed (StateT ValueState Identity) (r (Variable r)))
  MethodState
  ValueState
-> SVariable r -> StateT MethodState Identity (r (Variable r))
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) (r (Variable r)))
  MethodState
  ValueState
(ValueState -> Focusing Identity (r (Variable r)) ValueState)
-> MethodState -> Focusing Identity (r (Variable r)) MethodState
Lens' MethodState ValueState
lensMStoVS) [SVariable r]
lsts StateT MethodState Identity [r (Variable r)]
-> ([r (Variable r)] -> MSStatement r) -> MSStatement r
forall a b.
StateT MethodState Identity a
-> (a -> StateT MethodState Identity b)
-> StateT MethodState Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [CodeType] -> MSStatement r
listVals ([CodeType] -> MSStatement r)
-> ([r (Variable r)] -> [CodeType])
-> [r (Variable r)]
-> MSStatement r
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      (r (Variable r) -> CodeType) -> [r (Variable r)] -> [CodeType]
forall a b. (a -> b) -> [a] -> [b]
map (r (Type r) -> CodeType
forall (r :: * -> *). TypeElim r => r (Type r) -> CodeType
getType (r (Type r) -> CodeType)
-> (r (Variable r) -> r (Type r)) -> r (Variable r) -> CodeType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r (Variable r) -> r (Type r)
forall (r :: * -> *).
VariableElim r =>
r (Variable r) -> r (Type r)
variableType)
    checkList CodeType
_ = Label -> MSStatement r
forall a. HasCallStack => Label -> a
error
      Label
"Value passed to stringListLists must be a list of strings"
    listVals :: [CodeType] -> MSStatement r
listVals [] = MSStatement r
loop
    listVals (List CodeType
_:[CodeType]
vs) = [CodeType] -> MSStatement r
listVals [CodeType]
vs
    listVals [CodeType]
_ = Label -> MSStatement r
forall a. HasCallStack => Label -> a
error
      Label
"All values passed to stringListLists must have list types"
    loop :: MSStatement r
loop = SVariable r
-> SValue r -> SValue r -> SValue r -> MSBody r -> MSStatement r
forall (r :: * -> *).
ControlStatement r =>
SVariable r
-> SValue r -> SValue r -> SValue r -> MSBody r -> MSStatement r
IC.forRange SVariable r
var_i (Integer -> SValue r
forall (r :: * -> *). Literal r => Integer -> SValue r
IC.litInt Integer
0) (SValue r -> SValue r
forall (r :: * -> *). List r => SValue r -> SValue r
IC.listSize SValue r
sl SValue r -> SValue r -> SValue r
forall (r :: * -> *).
NumericExpression r =>
SValue r -> SValue r -> SValue r
#/ SValue r
numLists)
      (Integer -> SValue r
forall (r :: * -> *). Literal r => Integer -> SValue r
IC.litInt Integer
1) ([MSStatement r] -> MSBody r
forall (r :: * -> *). BodySym r => [MSStatement r] -> MSBody r
bodyStatements ([MSStatement r] -> MSBody r) -> [MSStatement r] -> MSBody r
forall a b. (a -> b) -> a -> b
$ [SValue r] -> Integer -> [MSStatement r]
appendLists ((SVariable r -> SValue r) -> [SVariable r] -> [SValue r]
forall a b. (a -> b) -> [a] -> [b]
map SVariable r -> SValue r
forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
IC.valueOf [SVariable r]
lsts) Integer
0)
    appendLists :: [SValue r] -> Integer -> [MSStatement r]
appendLists [] Integer
_ = []
    appendLists (SValue r
v:[SValue r]
vs) Integer
n = SValue r -> MSStatement r
forall (r :: * -> *). StatementSym r => SValue r -> MSStatement r
IC.valStmt (SValue r -> SValue r -> SValue r
forall (r :: * -> *). List r => SValue r -> SValue r -> SValue r
IC.listAppend SValue r
v (VSType r -> SValue r -> SValue r
forall (r :: * -> *).
RenderValue r =>
VSType r -> SValue r -> SValue r
cast
      (VSType r -> VSType r
forall (r :: * -> *). TypeSym r => VSType r -> VSType r
IC.listInnerType (VSType r -> VSType r) -> VSType r -> VSType r
forall a b. (a -> b) -> a -> b
$ (r (Value r) -> r (Type r)) -> SValue r -> VSType r
forall a b s. (a -> b) -> State s a -> State s b
onStateValue r (Value r) -> r (Type r)
forall (r :: * -> *). ValueSym r => r (Value r) -> r (Type r)
valueType SValue r
v)
      (SValue r -> SValue r -> SValue r
forall (r :: * -> *). List r => SValue r -> SValue r -> SValue r
IC.listAccess SValue r
sl ((SValue r
v_i SValue r -> SValue r -> SValue r
forall (r :: * -> *).
NumericExpression r =>
SValue r -> SValue r -> SValue r
#* SValue r
numLists) SValue r -> SValue r -> SValue r
forall (r :: * -> *).
NumericExpression r =>
SValue r -> SValue r -> SValue r
#+ Integer -> SValue r
forall (r :: * -> *). Literal r => Integer -> SValue r
IC.litInt Integer
n))))
      MSStatement r -> [MSStatement r] -> [MSStatement r]
forall a. a -> [a] -> [a]
: [SValue r] -> Integer -> [MSStatement r]
appendLists [SValue r]
vs (Integer
nInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
1)
    numLists :: SValue r
numLists = Integer -> SValue r
forall (r :: * -> *). Literal r => Integer -> SValue r
IC.litInt (Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ [SVariable r] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [SVariable r]
lsts)
    var_i :: SVariable r
var_i = Label -> VSType r -> SVariable r
forall (r :: * -> *).
VariableSym r =>
Label -> VSType r -> SVariable r
IC.var Label
l_i VSType r
forall (r :: * -> *). TypeSym r => VSType r
IC.int
    v_i :: SValue r
v_i = SVariable r -> SValue r
forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
IC.valueOf SVariable r
var_i
  CodeType -> MSStatement r
checkList (r (Type r) -> CodeType
forall (r :: * -> *). TypeElim r => r (Type r) -> CodeType
getType (r (Type r) -> CodeType) -> r (Type r) -> CodeType
forall a b. (a -> b) -> a -> b
$ r (Value r) -> r (Type r)
forall (r :: * -> *). ValueSym r => r (Value r) -> r (Type r)
valueType r (Value r)
slst)

forRange :: (CommonRenderSym r) => SVariable r -> SValue r -> SValue r -> SValue r -> 
  MSBody r -> MSStatement r
forRange :: forall (r :: * -> *).
CommonRenderSym r =>
SVariable r
-> SValue r -> SValue r -> SValue r -> MSBody r -> MSStatement r
forRange SVariable r
i SValue r
initv SValue r
finalv SValue r
stepv = StateT MethodState Identity (r (Statement r))
-> SValue r
-> StateT MethodState Identity (r (Statement r))
-> StateT MethodState Identity (r (Body r))
-> StateT MethodState Identity (r (Statement r))
forall (r :: * -> *).
ControlStatement r =>
MSStatement r
-> SValue r -> MSStatement r -> MSBody r -> MSStatement r
IC.for (SVariable r
-> r (Scope r)
-> SValue r
-> StateT MethodState Identity (r (Statement r))
forall (r :: * -> *).
DeclStatement r =>
SVariable r -> r (Scope r) -> SValue r -> MSStatement r
IC.varDecDef SVariable r
i r (Scope r)
forall (r :: * -> *). ScopeSym r => r (Scope r)
IC.local SValue r
initv)
  (SVariable r -> SValue r
forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
IC.valueOf SVariable r
i SValue r -> SValue r -> SValue r
forall (r :: * -> *).
Comparison r =>
SValue r -> SValue r -> SValue r
?< SValue r
finalv) (SVariable r
i SVariable r
-> SValue r -> StateT MethodState Identity (r (Statement r))
forall (r :: * -> *).
AssignStatement r =>
SVariable r -> SValue r -> MSStatement r
&+= SValue r
stepv)

observerIndex :: (CommonRenderSym r) => SVariable r
observerIndex :: forall (r :: * -> *). CommonRenderSym r => SVariable r
observerIndex = Label -> VSType r -> StateT ValueState Identity (r (Variable r))
forall (r :: * -> *).
VariableSym r =>
Label -> VSType r -> SVariable r
IC.var Label
"observerIndex" VSType r
forall (r :: * -> *). TypeSym r => VSType r
IC.int

observerIdxVal :: (CommonRenderSym r) => SValue r
observerIdxVal :: forall (r :: * -> *). CommonRenderSym r => SValue r
observerIdxVal = SVariable r -> StateT ValueState Identity (r (Value r))
forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
IC.valueOf SVariable r
forall (r :: * -> *). CommonRenderSym r => SVariable r
observerIndex

obsList :: (CommonRenderSym r) => VSType r -> SValue r
obsList :: forall (r :: * -> *). CommonRenderSym r => VSType r -> SValue r
obsList VSType r
t = SVariable r -> SValue r
forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
IC.valueOf (SVariable r -> SValue r) -> SVariable r -> SValue r
forall a b. (a -> b) -> a -> b
$ Label -> VSType r -> SVariable r
forall (r :: * -> *).
VariableSym r =>
Label -> VSType r -> SVariable r
listOf Label
observerListName VSType r
t

notify :: (OORenderSym r) => VSType r -> VSFunction r -> MSBody r
notify :: forall (r :: * -> *).
OORenderSym r =>
VSType r -> VSFunction r -> MSBody r
notify VSType r
t VSFunction r
f = MSStatement r -> MSBody r
forall (r :: * -> *). BodySym r => MSStatement r -> MSBody r
oneLiner (MSStatement r -> MSBody r) -> MSStatement r -> MSBody r
forall a b. (a -> b) -> a -> b
$ SValue r -> MSStatement r
forall (r :: * -> *). StatementSym r => SValue r -> MSStatement r
IC.valStmt (SValue r -> MSStatement r) -> SValue r -> MSStatement r
forall a b. (a -> b) -> a -> b
$ SValue r -> SValue r -> SValue r
forall (r :: * -> *). List r => SValue r -> SValue r -> SValue r
at (VSType r -> SValue r
forall (r :: * -> *). CommonRenderSym r => VSType r -> SValue r
obsList VSType r
t) SValue r
forall (r :: * -> *). CommonRenderSym r => SValue r
observerIdxVal SValue r -> VSFunction r -> SValue r
forall (r :: * -> *).
OOFunctionSym r =>
SValue r -> VSFunction r -> SValue r
$. VSFunction r
f

notifyObservers :: (OORenderSym r) => VSFunction r -> VSType r -> MSStatement r
notifyObservers :: forall (r :: * -> *).
OORenderSym r =>
VSFunction r -> VSType r -> MSStatement r
notifyObservers VSFunction r
f VSType r
t = StateT MethodState Identity (r (Statement r))
-> SValue r
-> StateT MethodState Identity (r (Statement r))
-> MSBody r
-> StateT MethodState Identity (r (Statement r))
forall (r :: * -> *).
ControlStatement r =>
MSStatement r
-> SValue r -> MSStatement r -> MSBody r -> MSStatement r
IC.for StateT MethodState Identity (r (Statement r))
initv (SValue r
forall (r :: * -> *). CommonRenderSym r => SValue r
observerIdxVal SValue r -> SValue r -> SValue r
forall (r :: * -> *).
Comparison r =>
SValue r -> SValue r -> SValue r
?< SValue r -> SValue r
forall (r :: * -> *). List r => SValue r -> SValue r
IC.listSize (VSType r -> SValue r
forall (r :: * -> *). CommonRenderSym r => VSType r -> SValue r
obsList VSType r
t))
  (SVariable r
forall (r :: * -> *). CommonRenderSym r => SVariable r
observerIndex &++) (VSType r -> VSFunction r -> MSBody r
forall (r :: * -> *).
OORenderSym r =>
VSType r -> VSFunction r -> MSBody r
notify VSType r
t VSFunction r
f)
  where initv :: StateT MethodState Identity (r (Statement r))
initv = SVariable r
-> r (Scope r)
-> SValue r
-> StateT MethodState Identity (r (Statement r))
forall (r :: * -> *).
DeclStatement r =>
SVariable r -> r (Scope r) -> SValue r -> MSStatement r
IC.varDecDef SVariable r
forall (r :: * -> *). CommonRenderSym r => SVariable r
observerIndex r (Scope r)
forall (r :: * -> *). ScopeSym r => r (Scope r)
IC.local (SValue r -> StateT MethodState Identity (r (Statement r)))
-> SValue r -> StateT MethodState Identity (r (Statement r))
forall a b. (a -> b) -> a -> b
$ Integer -> SValue r
forall (r :: * -> *). Literal r => Integer -> SValue r
IC.litInt Integer
0

notifyObservers' :: (OORenderSym r) => VSFunction r -> VSType r -> MSStatement r
notifyObservers' :: forall (r :: * -> *).
OORenderSym r =>
VSFunction r -> VSType r -> MSStatement r
notifyObservers' VSFunction r
f VSType r
t = SVariable r
-> SValue r
-> SValue r
-> SValue r
-> MSBody r
-> StateT MethodState Identity (r (Statement r))
forall (r :: * -> *).
ControlStatement r =>
SVariable r
-> SValue r -> SValue r -> SValue r -> MSBody r -> MSStatement r
IC.forRange SVariable r
forall (r :: * -> *). CommonRenderSym r => SVariable r
observerIndex SValue r
initv (SValue r -> SValue r
forall (r :: * -> *). List r => SValue r -> SValue r
IC.listSize (SValue r -> SValue r) -> SValue r -> SValue r
forall a b. (a -> b) -> a -> b
$ VSType r -> SValue r
forall (r :: * -> *). CommonRenderSym r => VSType r -> SValue r
obsList VSType r
t )
    (Integer -> SValue r
forall (r :: * -> *). Literal r => Integer -> SValue r
IC.litInt Integer
1) (VSType r -> VSFunction r -> MSBody r
forall (r :: * -> *).
OORenderSym r =>
VSType r -> VSFunction r -> MSBody r
notify VSType r
t VSFunction r
f)
    where initv :: SValue r
initv = Integer -> SValue r
forall (r :: * -> *). Literal r => Integer -> SValue r
IC.litInt Integer
0