{-# LANGUAGE PostfixOperators #-}
{-# LANGUAGE FlexibleContexts #-}

-- | 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, intFunc, multiAssignError, multiReturnError,
  multiTypeError
) where

import Drasil.FileHandling.Legacy (indent)

import Drasil.Shared.CodeType (CodeType(..))
import Drasil.Shared.InterfaceCommon (UnRepr(..), Label, Library, Body,
  TypeElim(..), SVariable, Value, SValue, 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 (MSMthdType,
  InternalVarElim(variableBind), RenderValue(valFromData), ValueElim(valuePrec),
  ScopeElim(scopeData))
import qualified Drasil.Shared.RendererClassesCommon as RC
import Drasil.GOOL.RendererClassesOO (OORenderMethod(intMethod))
import Drasil.GOOL.Renderers (renderType)
import qualified Drasil.GOOL.RendererClassesOO as RO
import Drasil.Shared.AST (AttachmentTag(..), Terminator(..), ScopeData,
  TypeData, ParamData)
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 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, UnRepr r TypeData) => String ->
  VS (r TypeData) -> VS (r TypeData)
listType :: forall (r :: * -> *).
(Monad r, TypeElim r, UnRepr r TypeData) =>
String -> VS (r TypeData) -> VS (r TypeData)
listType String
lst VS (r TypeData)
t' = do
  r TypeData
t <- VS (r TypeData)
t'
  CodeType -> String -> Doc -> VS (r TypeData)
forall (r :: * -> *).
Monad r =>
CodeType -> String -> Doc -> VS (r TypeData)
typeFromData (CodeType -> CodeType
List (r TypeData -> CodeType
forall (r :: * -> *). TypeElim r => r TypeData -> CodeType
getCodeType r TypeData
t)) (String
lst
    String -> String -> String
`containing` r TypeData -> String
forall (r :: * -> *). UnRepr r TypeData => r TypeData -> String
getTypeString r TypeData
t) (Doc -> VS (r TypeData)) -> Doc -> VS (r TypeData)
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
lst Doc -> Doc -> Doc
<> Doc -> Doc
angles (r TypeData -> Doc
forall (r :: * -> *). UnRepr r TypeData => r TypeData -> Doc
renderType r TypeData
t)

setType :: (Monad r, TypeElim r, UnRepr r TypeData) => String ->
  VS (r TypeData) -> VS (r TypeData)
setType :: forall (r :: * -> *).
(Monad r, TypeElim r, UnRepr r TypeData) =>
String -> VS (r TypeData) -> VS (r TypeData)
setType String
lst VS (r TypeData)
t' = do
  r TypeData
t <- VS (r TypeData)
t'
  CodeType -> String -> Doc -> VS (r TypeData)
forall (r :: * -> *).
Monad r =>
CodeType -> String -> Doc -> VS (r TypeData)
typeFromData (CodeType -> CodeType
Set (r TypeData -> CodeType
forall (r :: * -> *). TypeElim r => r TypeData -> CodeType
getCodeType r TypeData
t)) (String
lst
    String -> String -> String
`containing` r TypeData -> String
forall (r :: * -> *). UnRepr r TypeData => r TypeData -> String
getTypeString r TypeData
t) (Doc -> VS (r TypeData)) -> Doc -> VS (r TypeData)
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
lst Doc -> Doc -> Doc
<> Doc -> Doc
angles (r TypeData -> Doc
forall (r :: * -> *). UnRepr r TypeData => r TypeData -> Doc
renderType r TypeData
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, RC.RenderVariable r) => SVariable r
self :: forall (r :: * -> *).
(OOTypeSym r, RenderVariable r) =>
SVariable r
self = do
  String
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
  String -> VS (r TypeData) -> Doc -> SVariable r
forall (r :: * -> *).
RenderVariable r =>
String -> VS (r TypeData) -> Doc -> SVariable r
mkStateVar String
R.this (String -> VS (r TypeData)
forall (r :: * -> *). OOTypeSym r => String -> VS (r TypeData)
IG.obj String
l) Doc
R.this'

-- Values --

litTrue :: (RenderValue r, IC.TypeSym r) => SValue r
litTrue :: forall (r :: * -> *). (RenderValue r, TypeSym r) => SValue r
litTrue = VS (r TypeData) -> Doc -> SValue r
forall (r :: * -> *).
RenderValue r =>
VS (r TypeData) -> Doc -> SValue r
mkStateVal VS (r TypeData)
forall (r :: * -> *). TypeSym r => VS (r TypeData)
IC.bool (String -> Doc
text String
"true")

litFalse :: (RenderValue r, IC.TypeSym r) => SValue r
litFalse :: forall (r :: * -> *). (RenderValue r, TypeSym r) => SValue r
litFalse = VS (r TypeData) -> Doc -> SValue r
forall (r :: * -> *).
RenderValue r =>
VS (r TypeData) -> Doc -> SValue r
mkStateVal VS (r TypeData)
forall (r :: * -> *). TypeSym r => VS (r TypeData)
IC.bool (String -> Doc
text String
"false")

litFloat :: (RenderValue r, IC.TypeSym r) => Float -> SValue r
litFloat :: forall (r :: * -> *).
(RenderValue r, TypeSym r) =>
Float -> SValue r
litFloat Float
f = VS (r TypeData) -> Doc -> SValue r
forall (r :: * -> *).
RenderValue r =>
VS (r TypeData) -> Doc -> SValue r
mkStateVal VS (r TypeData)
forall (r :: * -> *). TypeSym r => VS (r TypeData)
IC.float (Float -> Doc
D.float Float
f Doc -> Doc -> Doc
<> String -> Doc
text String
"f")

inlineIf
  :: (RenderValue r, ValueElim r, ValueSym r)
  => SValue r -> SValue r -> SValue r -> SValue r
inlineIf :: forall (r :: * -> *).
(RenderValue r, ValueElim r, ValueSym r) =>
SValue r -> SValue r -> SValue r -> SValue r
inlineIf SValue r
c' SValue r
v1' SValue r
v2' = do
  r Value
c <- SValue r
c'
  r Value
v1 <- SValue r
v1'
  r Value
v2 <- SValue r
v2'
  Maybe Int -> Maybe Integer -> VS (r TypeData) -> Doc -> SValue r
forall (r :: * -> *).
RenderValue r =>
Maybe Int -> Maybe Integer -> VS (r TypeData) -> Doc -> SValue r
valFromData (r Value -> Maybe Int
forall {r :: * -> *}. ValueElim r => r Value -> Maybe Int
prec r Value
c) Maybe Integer
forall a. Maybe a
Nothing (r TypeData -> VS (r TypeData)
forall a s. a -> State s a
toState (r TypeData -> VS (r TypeData)) -> r TypeData -> VS (r TypeData)
forall a b. (a -> b) -> a -> b
$ r Value -> r TypeData
forall (r :: * -> *). ValueSym r => r Value -> r TypeData
valueType r Value
v1)
    (r Value -> Doc
forall (r :: * -> *). ValueElim r => r Value -> Doc
RC.value r Value
c Doc -> Doc -> Doc
<+> String -> Doc
text String
"?" Doc -> Doc -> Doc
<+> r Value -> Doc
forall (r :: * -> *). ValueElim r => r Value -> Doc
RC.value r Value
v1 Doc -> Doc -> Doc
<+> String -> Doc
text String
":" Doc -> Doc -> Doc
<+> r Value -> Doc
forall (r :: * -> *). ValueElim r => r Value -> Doc
RC.value r Value
v2)
  where prec :: r Value -> Maybe Int
prec r Value
cd = r Value -> Maybe Int
forall {r :: * -> *}. ValueElim r => r Value -> Maybe Int
valuePrec r Value
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) => Library -> MixedCall r
libFuncAppMixedArgs :: forall (r :: * -> *). ValueExpression r => String -> MixedCall r
libFuncAppMixedArgs String
l String
n VS (r TypeData)
t [SValue r]
vs NamedArgs r
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 () -> SValue r -> SValue r
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
forall (r :: * -> *). ValueExpression r => MixedCall r
IC.funcAppMixedArgs String
n VS (r TypeData)
t [SValue r]
vs NamedArgs r
ns

libNewObjMixedArgs :: (IG.OOValueExpression r) => Library -> MixedCtorCall r
libNewObjMixedArgs :: forall (r :: * -> *).
OOValueExpression r =>
String -> MixedCtorCall r
libNewObjMixedArgs String
l VS (r TypeData)
tp [SValue r]
vs NamedArgs r
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 () -> SValue r -> SValue r
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
forall (r :: * -> *). OOValueExpression r => MixedCtorCall r
IG.newObjMixedArgs VS (r TypeData)
tp [SValue r]
vs NamedArgs r
ns

-- Functions --

listSize :: (IG.InternalValueExp r) => String -> SValue r -> SValue r
listSize :: forall (r :: * -> *).
InternalValueExp r =>
String -> SValue r -> SValue r
listSize String
fnName SValue r
list = VS (r TypeData) -> SValue r -> String -> SValue r
forall (r :: * -> *).
InternalValueExp r =>
VS (r TypeData) -> SValue r -> String -> SValue r
objMethodCallNoParams VS (r TypeData)
forall (r :: * -> *). TypeSym r => VS (r TypeData)
IC.int SValue r
list String
fnName

listSize' :: (IG.OOVariableSym r, VariableValue r) => String -> SValue r -> SValue r
listSize' :: forall (r :: * -> *).
(OOVariableSym r, VariableValue r) =>
String -> SValue r -> SValue r
listSize' String
lengthName SValue r
list = SVariable r -> SValue r
forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
valueOf (SVariable r -> SValue r) -> SVariable r -> SValue r
forall a b. (a -> b) -> a -> b
$ SValue r
list SValue r -> SVariable r -> SVariable r
forall (r :: * -> *).
OOVariableSym r =>
SValue r -> SVariable r -> SVariable r
$-> String -> VS (r TypeData) -> SVariable r
forall (r :: * -> *).
VariableSym r =>
String -> VS (r TypeData) -> SVariable r
var String
lengthName VS (r TypeData)
forall (r :: * -> *). TypeSym r => VS (r TypeData)
IC.int

-- Statements --

increment
  :: (InternalVarElim r, RC.RenderStatement r smt, ValueElim r)
  => SVariable r -> SValue r -> MS (r smt)
increment :: forall (r :: * -> *) smt.
(InternalVarElim r, RenderStatement r smt, ValueElim r) =>
SVariable r -> SValue r -> MS (r smt)
increment SVariable r
vr' SValue r
v'= do
  r Variable
vr <- LensLike'
  (Zoomed (StateT ValueState Identity) (r Variable))
  MethodState
  ValueState
-> SVariable r -> StateT MethodState Identity (r Variable)
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))
  MethodState
  ValueState
(ValueState -> Focusing Identity (r Variable) ValueState)
-> MethodState -> Focusing Identity (r Variable) MethodState
Lens' MethodState ValueState
lensMStoVS SVariable r
vr'
  r Value
v <- LensLike'
  (Zoomed (StateT ValueState Identity) (r Value))
  MethodState
  ValueState
-> SValue r -> StateT MethodState Identity (r Value)
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))
  MethodState
  ValueState
(ValueState -> Focusing Identity (r Value) ValueState)
-> MethodState -> Focusing Identity (r Value) MethodState
Lens' MethodState ValueState
lensMStoVS SValue r
v'
  Doc -> MS (r smt)
forall (r :: * -> *) smt.
RenderStatement r smt =>
Doc -> MS (r smt)
mkStmt (Doc -> MS (r smt)) -> Doc -> MS (r smt)
forall a b. (a -> b) -> a -> b
$ r Variable -> r Value -> Doc
forall (r :: * -> *).
(InternalVarElim r, ValueElim r) =>
r Variable -> r Value -> Doc
R.addAssign r Variable
vr r Value
v

increment1 :: (InternalVarElim r, RC.RenderStatement r smt) => SVariable r -> MS (r smt)
increment1 :: forall (r :: * -> *) smt.
(InternalVarElim r, RenderStatement r smt) =>
SVariable r -> MS (r smt)
increment1 SVariable r
vr' = do
  r Variable
vr <- LensLike'
  (Zoomed (StateT ValueState Identity) (r Variable))
  MethodState
  ValueState
-> SVariable r -> StateT MethodState Identity (r Variable)
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))
  MethodState
  ValueState
(ValueState -> Focusing Identity (r Variable) ValueState)
-> MethodState -> Focusing Identity (r Variable) MethodState
Lens' MethodState ValueState
lensMStoVS SVariable r
vr'
  (Doc -> MS (r smt)
forall (r :: * -> *) smt.
RenderStatement r smt =>
Doc -> MS (r smt)
mkStmt (Doc -> MS (r smt))
-> (r Variable -> Doc) -> r Variable -> MS (r smt)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r Variable -> Doc
forall (r :: * -> *). InternalVarElim r => r Variable -> Doc
R.increment) r Variable
vr

decrement1 :: (InternalVarElim r, RC.RenderStatement r smt) => SVariable r -> MS (r smt)
decrement1 :: forall (r :: * -> *) smt.
(InternalVarElim r, RenderStatement r smt) =>
SVariable r -> MS (r smt)
decrement1 SVariable r
vr' = do
  r Variable
vr <- LensLike'
  (Zoomed (StateT ValueState Identity) (r Variable))
  MethodState
  ValueState
-> SVariable r -> StateT MethodState Identity (r Variable)
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))
  MethodState
  ValueState
(ValueState -> Focusing Identity (r Variable) ValueState)
-> MethodState -> Focusing Identity (r Variable) MethodState
Lens' MethodState ValueState
lensMStoVS SVariable r
vr'
  (Doc -> MS (r smt)
forall (r :: * -> *) smt.
RenderStatement r smt =>
Doc -> MS (r smt)
mkStmt (Doc -> MS (r smt))
-> (r Variable -> Doc) -> r Variable -> MS (r smt)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r Variable -> Doc
forall (r :: * -> *). InternalVarElim r => r Variable -> Doc
R.decrement) r Variable
vr

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

varDecDef
  :: ( IC.DeclStatement r smt
     , RC.RenderStatement r smt
     , RC.StatementElim r smt
     , ValueElim r
     )
  => Terminator -> SVariable r -> r ScopeData -> SValue r -> MS (r smt)
varDecDef :: forall (r :: * -> *) smt.
(DeclStatement r smt, RenderStatement r smt, StatementElim r smt,
 ValueElim r) =>
Terminator -> SVariable r -> r ScopeData -> SValue r -> MS (r smt)
varDecDef Terminator
t SVariable r
vr r ScopeData
scp SValue r
vl' = do
  r smt
vd <- SVariable r -> r ScopeData -> MS (r smt)
forall (r :: * -> *) smt.
DeclStatement r smt =>
SVariable r -> r ScopeData -> MS (r smt)
IC.varDec SVariable r
vr r ScopeData
scp
  r Value
vl <- LensLike'
  (Zoomed (StateT ValueState Identity) (r Value))
  MethodState
  ValueState
-> SValue r -> StateT MethodState Identity (r Value)
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))
  MethodState
  ValueState
(ValueState -> Focusing Identity (r Value) ValueState)
-> MethodState -> Focusing Identity (r Value) MethodState
Lens' MethodState ValueState
lensMStoVS SValue r
vl'
  let stmtCtor :: Terminator -> Doc -> MS (r smt)
stmtCtor Terminator
Empty = Doc -> MS (r smt)
forall (r :: * -> *) smt.
RenderStatement r smt =>
Doc -> MS (r smt)
mkStmtNoEnd
      stmtCtor Terminator
Semi = Doc -> MS (r smt)
forall (r :: * -> *) smt.
RenderStatement r smt =>
Doc -> MS (r smt)
mkStmt
  Terminator -> Doc -> MS (r smt)
forall {r :: * -> *} {smt}.
RenderStatement r smt =>
Terminator -> Doc -> MS (r smt)
stmtCtor Terminator
t (r smt -> Doc
forall (r :: * -> *) smt. StatementElim r smt => r smt -> Doc
RC.statement r smt
vd Doc -> Doc -> Doc
<+> Doc
equals Doc -> Doc -> Doc
<+> r Value -> Doc
forall (r :: * -> *). ValueElim r => r Value -> Doc
RC.value r Value
vl)

setDecDef
  :: ( IC.DeclStatement r smt
     , RC.RenderStatement r smt
     , RC.StatementElim r smt
     , ValueElim r
     )
  => Terminator -> SVariable r -> r ScopeData -> SValue r -> MS (r smt)
setDecDef :: forall (r :: * -> *) smt.
(DeclStatement r smt, RenderStatement r smt, StatementElim r smt,
 ValueElim r) =>
Terminator -> SVariable r -> r ScopeData -> SValue r -> MS (r smt)
setDecDef Terminator
t SVariable r
vr r ScopeData
scp SValue r
vl' = do
  r smt
vd <- SVariable r -> r ScopeData -> MS (r smt)
forall (r :: * -> *) smt.
DeclStatement r smt =>
SVariable r -> r ScopeData -> MS (r smt)
IC.setDec SVariable r
vr r ScopeData
scp
  r Value
vl <- LensLike'
  (Zoomed (StateT ValueState Identity) (r Value))
  MethodState
  ValueState
-> SValue r -> StateT MethodState Identity (r Value)
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))
  MethodState
  ValueState
(ValueState -> Focusing Identity (r Value) ValueState)
-> MethodState -> Focusing Identity (r Value) MethodState
Lens' MethodState ValueState
lensMStoVS SValue r
vl'
  let stmtCtor :: Terminator -> Doc -> MS (r smt)
stmtCtor Terminator
Empty = Doc -> MS (r smt)
forall (r :: * -> *) smt.
RenderStatement r smt =>
Doc -> MS (r smt)
mkStmtNoEnd
      stmtCtor Terminator
Semi = Doc -> MS (r smt)
forall (r :: * -> *) smt.
RenderStatement r smt =>
Doc -> MS (r smt)
mkStmt
  Terminator -> Doc -> MS (r smt)
forall {r :: * -> *} {smt}.
RenderStatement r smt =>
Terminator -> Doc -> MS (r smt)
stmtCtor Terminator
t (r smt -> Doc
forall (r :: * -> *) smt. StatementElim r smt => r smt -> Doc
RC.statement r smt
vd Doc -> Doc -> Doc
<+> Doc
equals Doc -> Doc -> Doc
<+> r Value -> Doc
forall (r :: * -> *). ValueElim r => r Value -> Doc
RC.value r Value
vl)

listDec
  :: (IC.DeclStatement r smt, RC.RenderStatement r smt, RC.StatementElim r smt)
  => (r Value -> Doc) -> SValue r -> SVariable r -> r ScopeData -> MS (r smt)
listDec :: forall (r :: * -> *) smt.
(DeclStatement r smt, RenderStatement r smt,
 StatementElim r smt) =>
(r Value -> Doc)
-> SValue r -> SVariable r -> r ScopeData -> MS (r smt)
listDec r Value -> Doc
f SValue r
vl SVariable r
v r ScopeData
scp = do
  r Value
sz <- LensLike'
  (Zoomed (StateT ValueState Identity) (r Value))
  MethodState
  ValueState
-> SValue r -> StateT MethodState Identity (r Value)
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))
  MethodState
  ValueState
(ValueState -> Focusing Identity (r Value) ValueState)
-> MethodState -> Focusing Identity (r Value) MethodState
Lens' MethodState ValueState
lensMStoVS SValue r
vl
  r smt
vd <- SVariable r -> r ScopeData -> MS (r smt)
forall (r :: * -> *) smt.
DeclStatement r smt =>
SVariable r -> r ScopeData -> MS (r smt)
IC.varDec SVariable r
v r ScopeData
scp
  Doc -> MS (r smt)
forall (r :: * -> *) smt.
RenderStatement r smt =>
Doc -> MS (r smt)
mkStmt (r smt -> Doc
forall (r :: * -> *) smt. StatementElim r smt => r smt -> Doc
RC.statement r smt
vd Doc -> Doc -> Doc
<> r Value -> Doc
f r Value
sz)

extObjDecNew
  :: (IC.DeclStatement r smt, IG.OOValueExpression r, VariableElim r)
  => Library -> SVariable r -> r ScopeData -> [SValue r] -> MS (r smt)
extObjDecNew :: forall (r :: * -> *) smt.
(DeclStatement r smt, OOValueExpression r, VariableElim r) =>
String -> SVariable r -> r ScopeData -> [SValue r] -> MS (r smt)
extObjDecNew String
l SVariable r
v r ScopeData
scp [SValue r]
vs = SVariable r -> r ScopeData -> SValue r -> MS (r smt)
forall (r :: * -> *) smt.
DeclStatement r smt =>
SVariable r -> r ScopeData -> SValue r -> MS (r smt)
IC.varDecDef SVariable r
v r ScopeData
scp
  (String -> PosCtorCall r
forall (r :: * -> *).
OOValueExpression r =>
String -> PosCtorCall r
extNewObj String
l ((r Variable -> r TypeData)
-> SVariable r -> State ValueState (r TypeData)
forall a b s. (a -> b) -> State s a -> State s b
onStateValue r Variable -> r TypeData
forall (r :: * -> *). VariableElim r => r Variable -> r TypeData
variableType SVariable r
v) [SValue r]
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
     , RC.RenderStatement r smt
     , RC.StatementElim r smt
     , ValueElim r
     )
  => (Doc -> Doc)
  -> MS (r smt)
  -> SValue r
  -> [(SValue r, MS (r Body))]
  -> MS (r Body)
  -> MS (r smt)
switch :: forall (r :: * -> *) smt.
(BodyElim r, RenderStatement r smt, StatementElim r smt,
 ValueElim r) =>
(Doc -> Doc)
-> MS (r smt)
-> SValue r
-> [(SValue r, MS (r Doc))]
-> MS (r Doc)
-> MS (r smt)
switch Doc -> Doc
f MS (r smt)
st SValue r
v [(SValue r, MS (r Doc))]
cs MS (r Doc)
bod = do
  r smt
s <- MS (r smt) -> MS (r smt)
forall (r :: * -> *) smt.
RenderStatement r smt =>
MS (r smt) -> MS (r smt)
RC.stmt MS (r smt)
st
  r Value
val <- LensLike'
  (Zoomed (StateT ValueState Identity) (r Value))
  MethodState
  ValueState
-> SValue r -> StateT MethodState Identity (r Value)
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))
  MethodState
  ValueState
(ValueState -> Focusing Identity (r Value) ValueState)
-> MethodState -> Focusing Identity (r Value) MethodState
Lens' MethodState ValueState
lensMStoVS SValue r
v
  [r Value]
vals <- ((SValue r, MS (r Doc)) -> StateT MethodState Identity (r Value))
-> [(SValue r, MS (r Doc))]
-> StateT MethodState Identity [r Value]
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 Value))
  MethodState
  ValueState
-> SValue r -> StateT MethodState Identity (r Value)
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))
  MethodState
  ValueState
(ValueState -> Focusing Identity (r Value) ValueState)
-> MethodState -> Focusing Identity (r Value) MethodState
Lens' MethodState ValueState
lensMStoVS (SValue r -> StateT MethodState Identity (r Value))
-> ((SValue r, MS (r Doc)) -> SValue r)
-> (SValue r, MS (r Doc))
-> StateT MethodState Identity (r Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SValue r, MS (r Doc)) -> SValue r
forall a b. (a, b) -> a
fst) [(SValue r, MS (r Doc))]
cs
  [r Doc]
bods <- ((SValue r, MS (r Doc)) -> MS (r Doc))
-> [(SValue r, MS (r Doc))] -> StateT MethodState Identity [r Doc]
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 (SValue r, MS (r Doc)) -> MS (r Doc)
forall a b. (a, b) -> b
snd [(SValue r, MS (r Doc))]
cs
  r Doc
dflt <- MS (r Doc)
bod
  Doc -> MS (r smt)
forall (r :: * -> *) smt.
RenderStatement r smt =>
Doc -> MS (r smt)
mkStmt (Doc -> MS (r smt)) -> Doc -> MS (r smt)
forall a b. (a -> b) -> a -> b
$ (Doc -> Doc)
-> r smt -> r Value -> r Doc -> [(r Value, r Doc)] -> Doc
forall (r :: * -> *) smt.
(BodyElim r, StatementElim r smt, ValueElim r) =>
(Doc -> Doc)
-> r smt -> r Value -> r Doc -> [(r Value, r Doc)] -> Doc
R.switch Doc -> Doc
f r smt
s r Value
val r Doc
dflt ([r Value] -> [r Doc] -> [(r Value, r Doc)]
forall a b. [a] -> [b] -> [(a, b)]
zip [r Value]
vals [r Doc]
bods)

for
  :: ( RC.BodyElim r
     , RC.RenderStatement r smt
     , RC.StatementElim r smt
     , ValueElim r
     )
  => Doc
  -> Doc
  -> MS (r smt)
  -> SValue r
  -> MS (r smt)
  -> MS (r Body)
  -> MS (r smt)
for :: forall (r :: * -> *) smt.
(BodyElim r, RenderStatement r smt, StatementElim r smt,
 ValueElim r) =>
Doc
-> Doc
-> MS (r smt)
-> SValue r
-> MS (r smt)
-> MS (r Doc)
-> MS (r smt)
for Doc
bStart Doc
bEnd MS (r smt)
sInit SValue r
vGuard MS (r smt)
sUpdate MS (r Doc)
b = do
  r smt
initl <- MS (r smt) -> MS (r smt)
forall (r :: * -> *) smt.
RenderStatement r smt =>
MS (r smt) -> MS (r smt)
RC.loopStmt MS (r smt)
sInit
  r Value
guard <- LensLike'
  (Zoomed (StateT ValueState Identity) (r Value))
  MethodState
  ValueState
-> SValue r -> StateT MethodState Identity (r Value)
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))
  MethodState
  ValueState
(ValueState -> Focusing Identity (r Value) ValueState)
-> MethodState -> Focusing Identity (r Value) MethodState
Lens' MethodState ValueState
lensMStoVS SValue r
vGuard
  r smt
upd <- MS (r smt) -> MS (r smt)
forall (r :: * -> *) smt.
RenderStatement r smt =>
MS (r smt) -> MS (r smt)
RC.loopStmt MS (r smt)
sUpdate
  r Doc
bod <- MS (r Doc)
b
  Doc -> MS (r smt)
forall (r :: * -> *) smt.
RenderStatement r smt =>
Doc -> MS (r smt)
mkStmtNoEnd (Doc -> MS (r smt)) -> Doc -> MS (r smt)
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat [
    Doc
forLabel Doc -> Doc -> Doc
<+> Doc -> Doc
parens (r smt -> Doc
forall (r :: * -> *) smt. StatementElim r smt => r smt -> Doc
RC.statement r smt
initl Doc -> Doc -> Doc
<> Doc
semi Doc -> Doc -> Doc
<+> r Value -> Doc
forall (r :: * -> *). ValueElim r => r Value -> Doc
RC.value r Value
guard Doc -> Doc -> Doc
<>
      Doc
semi Doc -> Doc -> Doc
<+> r smt -> Doc
forall (r :: * -> *) smt. StatementElim r smt => r smt -> Doc
RC.statement r smt
upd) Doc -> Doc -> Doc
<+> Doc
bStart,
    Doc -> Doc
indent (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ r Doc -> Doc
forall (r :: * -> *). BodyElim r => r Doc -> Doc
RC.body r Doc
bod,
    Doc
bEnd]

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

-- Methods --

intFunc :: (OORenderMethod r vis md att) => Bool -> Label -> r vis ->
  r att -> MSMthdType r -> [MS (r ParamData)] -> MS (r Body) ->
  MS (r md)
intFunc :: forall (r :: * -> *) vis md att.
OORenderMethod r vis md att =>
Bool
-> String
-> r vis
-> r att
-> MSMthdType r
-> [MS (r ParamData)]
-> MS (r Doc)
-> MS (r md)
intFunc = Bool
-> String
-> r vis
-> r att
-> MSMthdType r
-> [MS (r ParamData)]
-> MS (r Doc)
-> MS (r md)
forall (r :: * -> *) vis md att.
OORenderMethod r vis md att =>
Bool
-> String
-> r vis
-> r att
-> MSMthdType r
-> [MS (r ParamData)]
-> MS (r Doc)
-> MS (r md)
intMethod

-- Error Messages --

multiAssignError :: String -> String
multiAssignError :: String -> String
multiAssignError String
l = String
"No multiple assignment statements in " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
l

multiReturnError :: String -> String
multiReturnError :: String -> String
multiReturnError String
l = String
"Cannot return multiple values in " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
l

multiTypeError :: String -> String
multiTypeError :: String -> String
multiTypeError String
l = String
"Multi-types not supported in " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
l