-- | Implementations for C-like renderers are defined here.
module Drasil.Shared.LanguageRenderer.CLike (charRender, float, double, char,
  listType, setType, void, notOp, andOp, orOp, self, litTrue, litFalse, litFloat,
  inlineIf, libFuncAppMixedArgs, libNewObjMixedArgs, listSize, listSize',
  increment, increment1, decrement1, varDec, varDecDef, setDecDef, listDec,
  extObjDecNew, switch, for, while, multiAssignError, multiReturnError,
  multiTypeError
) where

import Drasil.FileHandling.Legacy (indent)

import Drasil.Shared.CodeType (CodeType(..))
import Drasil.Shared.InterfaceCommon (UnRepr(..), Library, TypeElim(..),
  MixedCall, MixedCtorCall, VariableSym(..), VariableValue(..), VariableElim(..),
  ValueSym(valueType), getCodeType, getTypeString)
import qualified Drasil.Shared.InterfaceCommon as IC
import Drasil.GOOL.InterfaceGOOL (extNewObj, objMethodCallNoParams, ($->))
import qualified Drasil.GOOL.InterfaceGOOL as IG
import Drasil.Shared.RendererClassesCommon (InternalVarElim(variableBind),
  RenderValue(valFromData), ValueElim(valuePrec), ScopeElim(scopeData))
import qualified Drasil.Shared.RendererClassesCommon as RC
import Drasil.GOOL.Renderers (renderType)
import qualified Drasil.GOOL.RendererClassesOO as RO
import Drasil.Shared.AST (AttachmentTag(..), Terminator(..), ScopeData,
  TypeData)
import Drasil.Shared.Helpers (angles, toState, onStateValue)
import Drasil.Shared.LanguageRenderer (forLabel, whileLabel, containing)
import qualified Drasil.Shared.LanguageRenderer as R
import Drasil.Shared.LanguageRenderer.Constructors (typeFromData, mkStmt,
  mkStmtNoEnd, mkStateVal, mkStateVar, VSOp, unOpPrec, andPrec, orPrec)
import Drasil.Shared.State (MS, VS, lensMStoVS, lensVStoMS, addLibImportVS,
  getClassName, useVarName, setVarScope)

import Prelude hiding (break,(<>))
import qualified Prelude as P ((<>))
import Control.Applicative ((<|>))
import Control.Monad.State (modify)
import Control.Lens.Zoom (zoom)
import Text.PrettyPrint.HughesPJ (Doc, text, (<>), (<+>), parens, vcat, semi,
  equals, empty)
import qualified Text.PrettyPrint.HughesPJ as D

-- Types --

floatRender, doubleRender, charRender, voidRender :: String
floatRender :: String
floatRender = String
"float"
doubleRender :: String
doubleRender = String
"double"
charRender :: String
charRender = String
"char"
voidRender :: String
voidRender = String
"void"

float :: (Monad r) => VS (r TypeData)
float :: forall (r :: * -> *). Monad r => VS (r TypeData)
float = CodeType -> String -> Doc -> VS (r TypeData)
forall (r :: * -> *).
Monad r =>
CodeType -> String -> Doc -> VS (r TypeData)
typeFromData CodeType
Float String
floatRender (String -> Doc
text String
floatRender)

double :: (Monad r) => VS (r TypeData)
double :: forall (r :: * -> *). Monad r => VS (r TypeData)
double = CodeType -> String -> Doc -> VS (r TypeData)
forall (r :: * -> *).
Monad r =>
CodeType -> String -> Doc -> VS (r TypeData)
typeFromData CodeType
Double String
doubleRender (String -> Doc
text String
doubleRender)

char :: (Monad r) => VS (r TypeData)
char :: forall (r :: * -> *). Monad r => VS (r TypeData)
char = CodeType -> String -> Doc -> VS (r TypeData)
forall (r :: * -> *).
Monad r =>
CodeType -> String -> Doc -> VS (r TypeData)
typeFromData CodeType
Char String
charRender (String -> Doc
text String
charRender)

listType
  :: (Monad r, TypeElim r TypeData, UnRepr r TypeData)
  => String -> VS (r TypeData) -> VS (r TypeData)
listType :: forall (r :: * -> *).
(Monad r, TypeElim r TypeData, UnRepr r TypeData) =>
String -> VS (r TypeData) -> VS (r TypeData)
listType String
lst VS (r TypeData)
t' = do
  t <- VS (r TypeData)
t'
  typeFromData (List (getCodeType t)) (lst
    `containing` getTypeString t) $ text lst <> angles (renderType t)

setType
  :: (Monad r, TypeElim r TypeData, UnRepr r TypeData)
  => String -> VS (r TypeData) -> VS (r TypeData)
setType :: forall (r :: * -> *).
(Monad r, TypeElim r TypeData, UnRepr r TypeData) =>
String -> VS (r TypeData) -> VS (r TypeData)
setType String
lst VS (r TypeData)
t' = do
  t <- VS (r TypeData)
t'
  typeFromData (Set (getCodeType t)) (lst
    `containing` getTypeString t) $ text lst <> angles (renderType t)

void :: (Monad r) => VS (r TypeData)
void :: forall (r :: * -> *). Monad r => VS (r TypeData)
void = CodeType -> String -> Doc -> VS (r TypeData)
forall (r :: * -> *).
Monad r =>
CodeType -> String -> Doc -> VS (r TypeData)
typeFromData CodeType
Void String
voidRender (String -> Doc
text String
voidRender)

-- Unary Operators --

notOp :: (Monad r) => VSOp r
notOp :: forall (r :: * -> *). Monad r => VSOp r
notOp = String -> VSOp r
forall (r :: * -> *). Monad r => String -> VSOp r
unOpPrec String
"!"

-- Binary Operators --

andOp :: (Monad r) => VSOp r
andOp :: forall (r :: * -> *). Monad r => VSOp r
andOp = String -> VSOp r
forall (r :: * -> *). Monad r => String -> VSOp r
andPrec String
"&&"

orOp :: (Monad r) => VSOp r
orOp :: forall (r :: * -> *). Monad r => VSOp r
orOp = String -> VSOp r
forall (r :: * -> *). Monad r => String -> VSOp r
orPrec String
"||"
-- Variables --

self :: (IG.OOTypeSym r typ, RC.RenderVariable r var typ) => VS (r var)
self :: forall {k} (r :: k -> *) (typ :: k) (var :: k).
(OOTypeSym r typ, RenderVariable r var typ) =>
VS (r var)
self = do
  l <- LensLike'
  (Zoomed (StateT MethodState Identity) String)
  ValueState
  MethodState
-> StateT MethodState Identity String
-> StateT ValueState Identity String
forall c.
LensLike'
  (Zoomed (StateT MethodState Identity) c) ValueState MethodState
-> StateT MethodState 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 MethodState Identity) String)
  ValueState
  MethodState
(MethodState -> Focusing Identity String MethodState)
-> ValueState -> Focusing Identity String ValueState
Lens' ValueState MethodState
lensVStoMS StateT MethodState Identity String
getClassName
  mkStateVar R.this (IG.obj l) R.this'

-- Values --

litTrue :: (RenderValue r var val typ, IC.TypeSym r typ) => VS (r val)
litTrue :: forall {k} (r :: k -> *) (var :: k) (val :: k) (typ :: k).
(RenderValue r var val typ, TypeSym r typ) =>
VS (r val)
litTrue = VS (r typ) -> Doc -> VS (r val)
forall {k} (r :: k -> *) (var :: k) (val :: k) (typ :: k).
RenderValue r var val typ =>
VS (r typ) -> Doc -> VS (r val)
mkStateVal VS (r typ)
forall {k} (r :: k -> *) (typ :: k). TypeSym r typ => VS (r typ)
IC.bool (String -> Doc
text String
"true")

litFalse :: (RenderValue r var val typ, IC.TypeSym r typ) => VS (r val)
litFalse :: forall {k} (r :: k -> *) (var :: k) (val :: k) (typ :: k).
(RenderValue r var val typ, TypeSym r typ) =>
VS (r val)
litFalse = VS (r typ) -> Doc -> VS (r val)
forall {k} (r :: k -> *) (var :: k) (val :: k) (typ :: k).
RenderValue r var val typ =>
VS (r typ) -> Doc -> VS (r val)
mkStateVal VS (r typ)
forall {k} (r :: k -> *) (typ :: k). TypeSym r typ => VS (r typ)
IC.bool (String -> Doc
text String
"false")

litFloat :: (RenderValue r var val typ, IC.TypeSym r typ) => Float -> VS (r val)
litFloat :: forall {k} (r :: k -> *) (var :: k) (val :: k) (typ :: k).
(RenderValue r var val typ, TypeSym r typ) =>
Float -> VS (r val)
litFloat Float
f = VS (r typ) -> Doc -> VS (r val)
forall {k} (r :: k -> *) (var :: k) (val :: k) (typ :: k).
RenderValue r var val typ =>
VS (r typ) -> Doc -> VS (r val)
mkStateVal VS (r typ)
forall {k} (r :: k -> *) (typ :: k). TypeSym r typ => VS (r typ)
IC.float (Float -> Doc
D.float Float
f Doc -> Doc -> Doc
<> String -> Doc
text String
"f")

inlineIf
  :: (RenderValue r var val typ, ValueElim r val, ValueSym r val typ)
  => VS (r val) -> VS (r val) -> VS (r val) -> VS (r val)
inlineIf :: forall {k} (r :: k -> *) (var :: k) (val :: k) (typ :: k).
(RenderValue r var val typ, ValueElim r val, ValueSym r val typ) =>
VS (r val) -> VS (r val) -> VS (r val) -> VS (r val)
inlineIf VS (r val)
c' VS (r val)
v1' VS (r val)
v2' = do
  c <- VS (r val)
c'
  v1 <- v1'
  v2 <- v2'
  valFromData (prec c) Nothing (toState $ valueType v1)
    (RC.value c <+> text "?" <+> RC.value v1 <+> text ":" <+> RC.value v2)
  where prec :: r val -> Maybe Int
prec r val
cd = r val -> Maybe Int
forall {k} {r :: k -> *} {val :: k}.
ValueElim r val =>
r val -> Maybe Int
valuePrec r val
cd Maybe Int -> Maybe Int -> Maybe Int
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0

libFuncAppMixedArgs
  :: (IC.ValueExpression r var val binder typ)
  => Library -> MixedCall r var val typ
libFuncAppMixedArgs :: forall {k} (r :: k -> *) (var :: k) (val :: k) (binder :: k)
       (typ :: k).
ValueExpression r var val binder typ =>
String -> MixedCall r var val typ
libFuncAppMixedArgs String
l String
n VS (r typ)
t [VS (r val)]
vs NamedArgs r var val
ns = (ValueState -> ValueState) -> StateT ValueState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (String -> ValueState -> ValueState
addLibImportVS String
l) StateT ValueState Identity () -> VS (r val) -> VS (r val)
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
>>
  MixedCall r var val typ
forall {k} (r :: k -> *) (var :: k) (val :: k) (binder :: k)
       (typ :: k).
ValueExpression r var val binder typ =>
MixedCall r var val typ
IC.funcAppMixedArgs String
n VS (r typ)
t [VS (r val)]
vs NamedArgs r var val
ns

libNewObjMixedArgs
  :: (IG.OOValueExpression r var val typ)
  => Library -> MixedCtorCall r var val typ
libNewObjMixedArgs :: forall {k} (r :: k -> *) (var :: k) (val :: k) (typ :: k).
OOValueExpression r var val typ =>
String -> MixedCtorCall r var val typ
libNewObjMixedArgs String
l VS (r typ)
tp [VS (r val)]
vs NamedArgs r var val
ns = (ValueState -> ValueState) -> StateT ValueState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (String -> ValueState -> ValueState
addLibImportVS String
l) StateT ValueState Identity () -> VS (r val) -> VS (r val)
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
>>
  MixedCtorCall r var val typ
forall {k} (r :: k -> *) (var :: k) (val :: k) (typ :: k).
OOValueExpression r var val typ =>
MixedCtorCall r var val typ
IG.newObjMixedArgs VS (r typ)
tp [VS (r val)]
vs NamedArgs r var val
ns

-- Functions --

listSize
  :: (IC.TypeSym r typ, IG.InternalValueExp r var val typ)
  => String -> VS (r val) -> VS (r val)
listSize :: forall {k} (r :: k -> *) (typ :: k) (var :: k) (val :: k).
(TypeSym r typ, InternalValueExp r var val typ) =>
String -> VS (r val) -> VS (r val)
listSize String
fnName VS (r val)
list = VS (r typ) -> VS (r val) -> String -> VS (r val)
forall {k} (r :: k -> *) (var :: k) (val :: k) (typ :: k).
InternalValueExp r var val typ =>
VS (r typ) -> VS (r val) -> String -> VS (r val)
objMethodCallNoParams VS (r typ)
forall {k} (r :: k -> *) (typ :: k). TypeSym r typ => VS (r typ)
IC.int VS (r val)
list String
fnName

listSize'
  ::
    ( IC.TypeSym r typ
    , VariableSym r var typ
    , IG.OOVariableSym r var val typ
    , VariableValue r var val
    )
  => String -> VS (r val) -> VS (r val)
listSize' :: forall {k} (r :: k -> *) (typ :: k) (var :: k) (val :: k).
(TypeSym r typ, VariableSym r var typ, OOVariableSym r var val typ,
 VariableValue r var val) =>
String -> VS (r val) -> VS (r val)
listSize' String
lengthName VS (r val)
list = VS (r var) -> VS (r val)
forall {k} (r :: k -> *) (var :: k) (val :: k).
VariableValue r var val =>
VS (r var) -> VS (r val)
valueOf (VS (r var) -> VS (r val)) -> VS (r var) -> VS (r val)
forall a b. (a -> b) -> a -> b
$ VS (r val)
list VS (r val) -> VS (r var) -> VS (r var)
forall {k} (r :: k -> *) (var :: k) (val :: k) (typ :: k).
OOVariableSym r var val typ =>
VS (r val) -> VS (r var) -> VS (r var)
$-> String -> VS (r typ) -> VS (r var)
forall {k} (r :: k -> *) (var :: k) (typ :: k).
VariableSym r var typ =>
String -> VS (r typ) -> VS (r var)
var String
lengthName VS (r typ)
forall {k} (r :: k -> *) (typ :: k). TypeSym r typ => VS (r typ)
IC.int

-- Statements --

increment
  :: (InternalVarElim r var, RC.RenderStatement r stmt, ValueElim r val)
  => VS (r var) -> VS (r val) -> MS (r stmt)
increment :: forall {k} (r :: k -> *) (var :: k) (stmt :: k) (val :: k).
(InternalVarElim r var, RenderStatement r stmt, ValueElim r val) =>
VS (r var) -> VS (r val) -> MS (r stmt)
increment VS (r var)
vr' VS (r val)
v'= do
  vr <- LensLike'
  (Zoomed (StateT ValueState Identity) (r var))
  MethodState
  ValueState
-> VS (r var) -> StateT MethodState Identity (r var)
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 var))
  MethodState
  ValueState
(ValueState -> Focusing Identity (r var) ValueState)
-> MethodState -> Focusing Identity (r var) MethodState
Lens' MethodState ValueState
lensMStoVS VS (r var)
vr'
  v <- zoom lensMStoVS v'
  mkStmt $ R.addAssign vr v

increment1
  :: (InternalVarElim r var, RC.RenderStatement r stmt)
  => VS (r var) -> MS (r stmt)
increment1 :: forall {k} (r :: k -> *) (var :: k) (stmt :: k).
(InternalVarElim r var, RenderStatement r stmt) =>
VS (r var) -> MS (r stmt)
increment1 VS (r var)
vr' = do
  vr <- LensLike'
  (Zoomed (StateT ValueState Identity) (r var))
  MethodState
  ValueState
-> VS (r var) -> StateT MethodState Identity (r var)
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 var))
  MethodState
  ValueState
(ValueState -> Focusing Identity (r var) ValueState)
-> MethodState -> Focusing Identity (r var) MethodState
Lens' MethodState ValueState
lensMStoVS VS (r var)
vr'
  (mkStmt . R.increment) vr

decrement1
  :: (InternalVarElim r var, RC.RenderStatement r stmt)
  => VS (r var) -> MS (r stmt)
decrement1 :: forall {k} (r :: k -> *) (var :: k) (stmt :: k).
(InternalVarElim r var, RenderStatement r stmt) =>
VS (r var) -> MS (r stmt)
decrement1 VS (r var)
vr' = do
  vr <- LensLike'
  (Zoomed (StateT ValueState Identity) (r var))
  MethodState
  ValueState
-> VS (r var) -> StateT MethodState Identity (r var)
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 var))
  MethodState
  ValueState
(ValueState -> Focusing Identity (r var) ValueState)
-> MethodState -> Focusing Identity (r var) MethodState
Lens' MethodState ValueState
lensMStoVS VS (r var)
vr'
  (mkStmt . R.decrement) vr

varDec
  :: ( InternalVarElim r var
     , RO.PermElim r attch
     , RC.RenderStatement r stmt
     , ScopeElim r ScopeData
     , UnRepr r TypeData
     , TypeElim r TypeData
     , VariableElim r var TypeData
     )
  => r attch -> r attch -> Doc -> VS (r var) -> r ScopeData -> MS (r stmt)
varDec :: forall (r :: * -> *) var attch stmt.
(InternalVarElim r var, PermElim r attch, RenderStatement r stmt,
 ScopeElim r ScopeData, UnRepr r TypeData, TypeElim r TypeData,
 VariableElim r var TypeData) =>
r attch
-> r attch -> Doc -> VS (r var) -> r ScopeData -> MS (r stmt)
varDec r attch
s r attch
d Doc
pdoc VS (r var)
v' r ScopeData
scp = do
  v <- LensLike'
  (Zoomed (StateT ValueState Identity) (r var))
  MethodState
  ValueState
-> VS (r var) -> StateT MethodState Identity (r var)
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 var))
  MethodState
  ValueState
(ValueState -> Focusing Identity (r var) ValueState)
-> MethodState -> Focusing Identity (r var) MethodState
Lens' MethodState ValueState
lensMStoVS VS (r var)
v'
  modify $ useVarName (variableName v)
  modify $ setVarScope (variableName v) (scopeData scp)
  mkStmt (RO.perm (bind $ variableBind v)
    <+> renderType (variableType v) <+> (ptrdoc (getCodeType (variableType v)) <>
    RC.variable v))
  where bind :: AttachmentTag -> r attch
bind AttachmentTag
ClassLevel = r attch
s
        bind AttachmentTag
InstanceLevel = r attch
d
        ptrdoc :: CodeType -> Doc
ptrdoc (List CodeType
_) = Doc
pdoc
        ptrdoc (Set CodeType
_) = Doc
pdoc
        ptrdoc CodeType
_ = Doc
empty

varDecDef
  :: ( IC.DeclStatement r bod stmt var scope val
     , RC.RenderStatement r stmt
     , RC.StatementElim r stmt
     , ValueElim r val
     )
  => Terminator -> VS (r var) -> r scope -> VS (r val) -> MS (r stmt)
varDecDef :: forall {k} (r :: k -> *) (bod :: k) (stmt :: k) (var :: k)
       (scope :: k) (val :: k).
(DeclStatement r bod stmt var scope val, RenderStatement r stmt,
 StatementElim r stmt, ValueElim r val) =>
Terminator -> VS (r var) -> r scope -> VS (r val) -> MS (r stmt)
varDecDef Terminator
t VS (r var)
vr r scope
scp VS (r val)
vl' = do
  vd <- VS (r var) -> r scope -> MS (r stmt)
forall {k} (r :: k -> *) (bod :: k) (stmt :: k) (var :: k)
       (scope :: k) (val :: k).
DeclStatement r bod stmt var scope val =>
VS (r var) -> r scope -> MS (r stmt)
IC.varDec VS (r var)
vr r scope
scp
  vl <- zoom lensMStoVS vl'
  let stmtCtor Terminator
Empty = Doc -> MS (r stmt)
forall {k} (r :: k -> *) (stmt :: k).
RenderStatement r stmt =>
Doc -> MS (r stmt)
mkStmtNoEnd
      stmtCtor Terminator
Semi = Doc -> MS (r stmt)
forall {k} (r :: k -> *) (stmt :: k).
RenderStatement r stmt =>
Doc -> MS (r stmt)
mkStmt
  stmtCtor t (RC.statement vd <+> equals <+> RC.value vl)

setDecDef
  :: ( IC.DeclStatement r bod stmt var scope val
     , RC.RenderStatement r stmt
     , RC.StatementElim r stmt
     , ValueElim r val
     )
  => Terminator -> VS (r var) -> r scope -> VS (r val) -> MS (r stmt)
setDecDef :: forall {k} (r :: k -> *) (bod :: k) (stmt :: k) (var :: k)
       (scope :: k) (val :: k).
(DeclStatement r bod stmt var scope val, RenderStatement r stmt,
 StatementElim r stmt, ValueElim r val) =>
Terminator -> VS (r var) -> r scope -> VS (r val) -> MS (r stmt)
setDecDef Terminator
t VS (r var)
vr r scope
scp VS (r val)
vl' = do
  vd <- VS (r var) -> r scope -> MS (r stmt)
forall {k} (r :: k -> *) (bod :: k) (stmt :: k) (var :: k)
       (scope :: k) (val :: k).
DeclStatement r bod stmt var scope val =>
VS (r var) -> r scope -> MS (r stmt)
IC.setDec VS (r var)
vr r scope
scp
  vl <- zoom lensMStoVS vl'
  let stmtCtor Terminator
Empty = Doc -> MS (r stmt)
forall {k} (r :: k -> *) (stmt :: k).
RenderStatement r stmt =>
Doc -> MS (r stmt)
mkStmtNoEnd
      stmtCtor Terminator
Semi = Doc -> MS (r stmt)
forall {k} (r :: k -> *) (stmt :: k).
RenderStatement r stmt =>
Doc -> MS (r stmt)
mkStmt
  stmtCtor t (RC.statement vd <+> equals <+> RC.value vl)

listDec
  ::
    ( IC.DeclStatement r bod stmt var scope val
    , RC.RenderStatement r stmt
    , RC.StatementElim r stmt
    )
  => (r val -> Doc) -> VS (r val) -> VS (r var) -> r scope -> MS (r stmt)
listDec :: forall {k} (r :: k -> *) (bod :: k) (stmt :: k) (var :: k)
       (scope :: k) (val :: k).
(DeclStatement r bod stmt var scope val, RenderStatement r stmt,
 StatementElim r stmt) =>
(r val -> Doc)
-> VS (r val) -> VS (r var) -> r scope -> MS (r stmt)
listDec r val -> Doc
f VS (r val)
vl VS (r var)
v r scope
scp = do
  sz <- LensLike'
  (Zoomed (StateT ValueState Identity) (r val))
  MethodState
  ValueState
-> VS (r val) -> StateT MethodState Identity (r val)
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 val))
  MethodState
  ValueState
(ValueState -> Focusing Identity (r val) ValueState)
-> MethodState -> Focusing Identity (r val) MethodState
Lens' MethodState ValueState
lensMStoVS VS (r val)
vl
  vd <- IC.varDec v scp
  mkStmt (RC.statement vd <> f sz)

extObjDecNew
  ::
    ( IC.DeclStatement r bod stmt var scope val
    , IG.OOValueExpression r var val typ
    , VariableElim r var typ
    )
  => Library -> VS (r var) -> r scope -> [VS (r val)] -> MS (r stmt)
extObjDecNew :: forall {k} (r :: k -> *) (bod :: k) (stmt :: k) (var :: k)
       (scope :: k) (val :: k) (typ :: k).
(DeclStatement r bod stmt var scope val,
 OOValueExpression r var val typ, VariableElim r var typ) =>
String -> VS (r var) -> r scope -> [VS (r val)] -> MS (r stmt)
extObjDecNew String
l VS (r var)
v r scope
scp [VS (r val)]
vs = VS (r var) -> r scope -> VS (r val) -> MS (r stmt)
forall {k} (r :: k -> *) (bod :: k) (stmt :: k) (var :: k)
       (scope :: k) (val :: k).
DeclStatement r bod stmt var scope val =>
VS (r var) -> r scope -> VS (r val) -> MS (r stmt)
IC.varDecDef VS (r var)
v r scope
scp
  (String -> PosCtorCall r val typ
forall {k} (r :: k -> *) (var :: k) (val :: k) (typ :: k).
OOValueExpression r var val typ =>
String -> PosCtorCall r val typ
extNewObj String
l ((r var -> r typ) -> VS (r var) -> State ValueState (r typ)
forall a b s. (a -> b) -> State s a -> State s b
onStateValue r var -> r typ
forall {k} (r :: k -> *) (var :: k) (typ :: k).
VariableElim r var typ =>
r var -> r typ
variableType VS (r var)
v) [VS (r val)]
vs)

-- 1st parameter is a Doc function to apply to the render of the control value (i.e. parens)
-- 2nd parameter is a statement to end every case with
switch
  :: ( RC.BodyElim r bod
     , RC.RenderStatement r stmt
     , RC.StatementElim r stmt
     , ValueElim r val
     )
  => (Doc -> Doc)
  -> MS (r stmt)
  -> VS (r val)
  -> [(VS (r val), MS (r bod))]
  -> MS (r bod)
  -> MS (r stmt)
switch :: forall {k} (r :: k -> *) (bod :: k) (stmt :: k) (val :: k).
(BodyElim r bod, RenderStatement r stmt, StatementElim r stmt,
 ValueElim r val) =>
(Doc -> Doc)
-> MS (r stmt)
-> VS (r val)
-> [(VS (r val), MS (r bod))]
-> MS (r bod)
-> MS (r stmt)
switch Doc -> Doc
f MS (r stmt)
st VS (r val)
v [(VS (r val), MS (r bod))]
cs MS (r bod)
bod = do
  s <- MS (r stmt) -> MS (r stmt)
forall {k} (r :: k -> *) (stmt :: k).
RenderStatement r stmt =>
MS (r stmt) -> MS (r stmt)
RC.stmt MS (r stmt)
st
  val <- zoom lensMStoVS v
  vals <- mapM (zoom lensMStoVS . fst) cs
  bods <- mapM snd cs
  dflt <- bod
  mkStmt $ R.switch f s val dflt (zip vals bods)

for
  :: ( RC.BodyElim r bod
     , RC.RenderStatement r stmt
     , RC.StatementElim r stmt
     , ValueElim r val
     )
  => Doc
  -> Doc
  -> MS (r stmt)
  -> VS (r val)
  -> MS (r stmt)
  -> MS (r bod)
  -> MS (r stmt)
for :: forall {k} (r :: k -> *) (bod :: k) (stmt :: k) (val :: k).
(BodyElim r bod, RenderStatement r stmt, StatementElim r stmt,
 ValueElim r val) =>
Doc
-> Doc
-> MS (r stmt)
-> VS (r val)
-> MS (r stmt)
-> MS (r bod)
-> MS (r stmt)
for Doc
bStart Doc
bEnd MS (r stmt)
sInit VS (r val)
vGuard MS (r stmt)
sUpdate MS (r bod)
b = do
  initl <- MS (r stmt) -> MS (r stmt)
forall {k} (r :: k -> *) (stmt :: k).
RenderStatement r stmt =>
MS (r stmt) -> MS (r stmt)
RC.loopStmt MS (r stmt)
sInit
  guard <- zoom lensMStoVS vGuard
  upd <- RC.loopStmt sUpdate
  bod <- b
  mkStmtNoEnd $ vcat [
    forLabel <+> parens (RC.statement initl <> semi <+> RC.value guard <>
      semi <+> RC.statement upd) <+> bStart,
    indent $ RC.body bod,
    bEnd]

-- Doc function parameter is applied to the render of the while-condition
while
  :: (RC.BodyElim r bod, RC.RenderStatement r stmt, ValueElim r val)
  => (Doc -> Doc) -> Doc -> Doc -> VS (r val) -> MS (r bod) -> MS (r stmt)
while :: forall {k} (r :: k -> *) (bod :: k) (stmt :: k) (val :: k).
(BodyElim r bod, RenderStatement r stmt, ValueElim r val) =>
(Doc -> Doc)
-> Doc -> Doc -> VS (r val) -> MS (r bod) -> MS (r stmt)
while Doc -> Doc
f Doc
bStart Doc
bEnd VS (r val)
v' MS (r bod)
b'= do
  v <- LensLike'
  (Zoomed (StateT ValueState Identity) (r val))
  MethodState
  ValueState
-> VS (r val) -> StateT MethodState Identity (r val)
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 val))
  MethodState
  ValueState
(ValueState -> Focusing Identity (r val) ValueState)
-> MethodState -> Focusing Identity (r val) MethodState
Lens' MethodState ValueState
lensMStoVS VS (r val)
v'
  b <- b'
  mkStmtNoEnd (vcat [whileLabel <+> f (RC.value v) <+> bStart,
    indent $ RC.body b,
    bEnd])

-- Error Messages --

multiAssignError :: String -> String
multiAssignError :: String -> String
multiAssignError String
l = String
"No multiple assignment statements in " String -> String -> String
forall a. Semigroup a => a -> a -> a
P.<> String
l

multiReturnError :: String -> String
multiReturnError :: String -> String
multiReturnError String
l = String
"Cannot return multiple values in " String -> String -> String
forall a. Semigroup a => a -> a -> a
P.<> String
l

multiTypeError :: String -> String
multiTypeError :: String -> String
multiTypeError String
l = String
"Multi-types not supported in " String -> String -> String
forall a. Semigroup a => a -> a -> a
P.<> String
l