{-# LANGUAGE PostfixOperators #-}
module GOOL.Drasil.LanguageRenderer.CLike (charRender, float, double, char,
listType, void, notOp, andOp, orOp, self, litTrue, litFalse, litFloat,
inlineIf, libFuncAppMixedArgs, libNewObjMixedArgs, listSize, increment1,
decrement1, varDec, varDecDef, listDec, extObjDecNew, switch, for, while,
intFunc, multiAssignError, multiReturnError, multiTypeError
) where
import Utils.Drasil (indent)
import GOOL.Drasil.CodeType (CodeType(..))
import GOOL.Drasil.ClassInterface (Label, Library, MSBody, VSType, SVariable,
SValue, MSStatement, MSParameter, SMethod, MixedCall, MixedCtorCall,
PermanenceSym(..), TypeElim(getType, getTypeString),
VariableElim(..), ValueSym(Value, valueType), extNewObj, ($.), ScopeSym(..))
import qualified GOOL.Drasil.ClassInterface as S (TypeSym(bool, float, obj),
ValueExpression(funcAppMixedArgs, newObjMixedArgs),
DeclStatement(varDec, varDecDef))
import GOOL.Drasil.RendererClasses (MSMthdType, RenderSym, RenderType(..),
InternalVarElim(variableBind), RenderValue(valFromData),
ValueElim(valuePrec), RenderMethod(intMethod))
import qualified GOOL.Drasil.RendererClasses as S (
InternalListFunc(listSizeFunc), RenderStatement(stmt, loopStmt))
import qualified GOOL.Drasil.RendererClasses as RC (PermElim(..), BodyElim(..),
InternalTypeElim(..), InternalVarElim(variable), ValueElim(value),
StatementElim(statement))
import GOOL.Drasil.AST (Binding(..), Terminator(..))
import GOOL.Drasil.Helpers (angles, toState, onStateValue)
import GOOL.Drasil.LanguageRenderer (forLabel, whileLabel, containing)
import qualified GOOL.Drasil.LanguageRenderer as R (switch, increment,
decrement, this', this)
import GOOL.Drasil.LanguageRenderer.Constructors (mkStmt, mkStmtNoEnd,
mkStateVal, mkStateVar, VSOp, unOpPrec, andPrec, orPrec)
import GOOL.Drasil.State (lensMStoVS, lensVStoMS, addLibImportVS, getClassName,
useVarName)
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 (float)
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 :: (RenderSym r) => VSType r
float :: forall (r :: * -> *). RenderSym r => VSType r
float = forall (r :: * -> *).
RenderType r =>
CodeType -> String -> Doc -> VSType r
typeFromData CodeType
Float String
floatRender (String -> Doc
text String
floatRender)
double :: (RenderSym r) => VSType r
double :: forall (r :: * -> *). RenderSym r => VSType r
double = forall (r :: * -> *).
RenderType r =>
CodeType -> String -> Doc -> VSType r
typeFromData CodeType
Double String
doubleRender (String -> Doc
text String
doubleRender)
char :: (RenderSym r) => VSType r
char :: forall (r :: * -> *). RenderSym r => VSType r
char = forall (r :: * -> *).
RenderType r =>
CodeType -> String -> Doc -> VSType r
typeFromData CodeType
Char String
charRender (String -> Doc
text String
charRender)
listType :: (RenderSym r) => String -> VSType r -> VSType r
listType :: forall (r :: * -> *). RenderSym r => String -> VSType r -> VSType r
listType String
lst VSType r
t' = do
r (Type r)
t <- VSType r
t'
forall (r :: * -> *).
RenderType r =>
CodeType -> String -> Doc -> VSType r
typeFromData (CodeType -> CodeType
List (forall (r :: * -> *). TypeElim r => r (Type r) -> CodeType
getType r (Type r)
t)) (String
lst
String -> String -> String
`containing` forall (r :: * -> *). TypeElim r => r (Type r) -> String
getTypeString r (Type r)
t) forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
lst Doc -> Doc -> Doc
<> Doc -> Doc
angles (forall (r :: * -> *). InternalTypeElim r => r (Type r) -> Doc
RC.type' r (Type r)
t)
void :: (RenderSym r) => VSType r
void :: forall (r :: * -> *). RenderSym r => VSType r
void = forall (r :: * -> *).
RenderType r =>
CodeType -> String -> Doc -> VSType r
typeFromData CodeType
Void String
voidRender (String -> Doc
text String
voidRender)
notOp :: (Monad r) => VSOp r
notOp :: forall (r :: * -> *). Monad r => VSOp r
notOp = forall (r :: * -> *). Monad r => String -> VSOp r
unOpPrec String
"!"
andOp :: (Monad r) => VSOp r
andOp :: forall (r :: * -> *). Monad r => VSOp r
andOp = forall (r :: * -> *). Monad r => String -> VSOp r
andPrec String
"&&"
orOp :: (Monad r) => VSOp r
orOp :: forall (r :: * -> *). Monad r => VSOp r
orOp = forall (r :: * -> *). Monad r => String -> VSOp r
orPrec String
"||"
self :: (RenderSym r) => SVariable r
self :: forall (r :: * -> *). RenderSym r => SVariable r
self = do
String
l <- forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom Lens' ValueState MethodState
lensVStoMS MS String
getClassName
forall (r :: * -> *).
RenderSym r =>
String -> VSType r -> Doc -> SVariable r
mkStateVar String
R.this (forall (r :: * -> *). TypeSym r => String -> VSType r
S.obj String
l) Doc
R.this'
litTrue :: (RenderSym r) => SValue r
litTrue :: forall (r :: * -> *). RenderSym r => SValue r
litTrue = forall (r :: * -> *). RenderSym r => VSType r -> Doc -> SValue r
mkStateVal forall (r :: * -> *). TypeSym r => VSType r
S.bool (String -> Doc
text String
"true")
litFalse :: (RenderSym r) => SValue r
litFalse :: forall (r :: * -> *). RenderSym r => SValue r
litFalse = forall (r :: * -> *). RenderSym r => VSType r -> Doc -> SValue r
mkStateVal forall (r :: * -> *). TypeSym r => VSType r
S.bool (String -> Doc
text String
"false")
litFloat :: (RenderSym r) => Float -> SValue r
litFloat :: forall (r :: * -> *). RenderSym r => Float -> SValue r
litFloat Float
f = forall (r :: * -> *). RenderSym r => VSType r -> Doc -> SValue r
mkStateVal forall (r :: * -> *). TypeSym r => VSType r
S.float (Float -> Doc
D.float Float
f Doc -> Doc -> Doc
<> String -> Doc
text String
"f")
inlineIf :: (RenderSym r) => SValue r -> SValue r -> SValue r -> SValue r
inlineIf :: forall (r :: * -> *).
RenderSym r =>
SValue r -> SValue r -> SValue r -> SValue r
inlineIf SValue r
c' SValue r
v1' SValue r
v2' = do
r (Value r)
c <- SValue r
c'
r (Value r)
v1 <- SValue r
v1'
r (Value r)
v2 <- SValue r
v2'
forall (r :: * -> *).
RenderValue r =>
Maybe Int -> VSType r -> Doc -> SValue r
valFromData (forall {r :: * -> *}. ValueElim r => r (Value r) -> Maybe Int
prec r (Value r)
c) (forall a s. a -> State s a
toState forall a b. (a -> b) -> a -> b
$ forall (r :: * -> *). ValueSym r => r (Value r) -> r (Type r)
valueType r (Value r)
v1)
(forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value r (Value r)
c Doc -> Doc -> Doc
<+> String -> Doc
text String
"?" Doc -> Doc -> Doc
<+> forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value r (Value r)
v1 Doc -> Doc -> Doc
<+> String -> Doc
text String
":" Doc -> Doc -> Doc
<+> forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value r (Value r)
v2)
where prec :: r (Value r) -> Maybe Int
prec r (Value r)
cd = forall {r :: * -> *}. ValueElim r => r (Value r) -> Maybe Int
valuePrec r (Value r)
cd forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. a -> Maybe a
Just Int
0
libFuncAppMixedArgs :: (RenderSym r) => Library -> MixedCall r
libFuncAppMixedArgs :: forall (r :: * -> *). RenderSym r => String -> MixedCall r
libFuncAppMixedArgs String
l String
n VSType r
t [SValue r]
vs NamedArgs r
ns = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (String -> ValueState -> ValueState
addLibImportVS String
l) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
forall (r :: * -> *). ValueExpression r => MixedCall r
S.funcAppMixedArgs String
n VSType r
t [SValue r]
vs NamedArgs r
ns
libNewObjMixedArgs :: (RenderSym r) => Library -> MixedCtorCall r
libNewObjMixedArgs :: forall (r :: * -> *). RenderSym r => String -> MixedCtorCall r
libNewObjMixedArgs String
l VSType r
tp [SValue r]
vs NamedArgs r
ns = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (String -> ValueState -> ValueState
addLibImportVS String
l) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
forall (r :: * -> *). ValueExpression r => MixedCtorCall r
S.newObjMixedArgs VSType r
tp [SValue r]
vs NamedArgs r
ns
listSize :: (RenderSym r) => SValue r -> SValue r
listSize :: forall (r :: * -> *). RenderSym r => SValue r -> SValue r
listSize SValue r
v = SValue r
v forall (r :: * -> *).
FunctionSym r =>
SValue r -> VSFunction r -> SValue r
$. forall (r :: * -> *). InternalListFunc r => VSFunction r
S.listSizeFunc
increment1 :: (RenderSym r) => SVariable r -> MSStatement r
increment1 :: forall (r :: * -> *). RenderSym r => SVariable r -> MSStatement r
increment1 SVariable r
vr' = do
r (Variable r)
vr <- forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom Lens' MethodState ValueState
lensMStoVS SVariable r
vr'
(forall (r :: * -> *). RenderSym r => Doc -> MSStatement r
mkStmt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (r :: * -> *). RenderSym r => r (Variable r) -> Doc
R.increment) r (Variable r)
vr
decrement1 :: (RenderSym r) => SVariable r -> MSStatement r
decrement1 :: forall (r :: * -> *). RenderSym r => SVariable r -> MSStatement r
decrement1 SVariable r
vr' = do
r (Variable r)
vr <- forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom Lens' MethodState ValueState
lensMStoVS SVariable r
vr'
(forall (r :: * -> *). RenderSym r => Doc -> MSStatement r
mkStmt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (r :: * -> *). RenderSym r => r (Variable r) -> Doc
R.decrement) r (Variable r)
vr
varDec :: (RenderSym r) => r (Permanence r) -> r (Permanence r) -> Doc ->
SVariable r -> MSStatement r
varDec :: forall (r :: * -> *).
RenderSym r =>
r (Permanence r)
-> r (Permanence r) -> Doc -> SVariable r -> MSStatement r
varDec r (Permanence r)
s r (Permanence r)
d Doc
pdoc SVariable r
v' = do
r (Variable r)
v <- forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom Lens' MethodState ValueState
lensMStoVS SVariable r
v'
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ String -> MethodState -> MethodState
useVarName (forall (r :: * -> *). VariableElim r => r (Variable r) -> String
variableName r (Variable r)
v)
forall (r :: * -> *). RenderSym r => Doc -> MSStatement r
mkStmt (forall (r :: * -> *). PermElim r => r (Permanence r) -> Doc
RC.perm (Binding -> r (Permanence r)
bind forall a b. (a -> b) -> a -> b
$ forall (r :: * -> *).
InternalVarElim r =>
r (Variable r) -> Binding
variableBind r (Variable r)
v)
Doc -> Doc -> Doc
<+> forall (r :: * -> *). InternalTypeElim r => r (Type r) -> Doc
RC.type' (forall (r :: * -> *).
VariableElim r =>
r (Variable r) -> r (Type r)
variableType r (Variable r)
v) Doc -> Doc -> Doc
<+> (CodeType -> Doc
ptrdoc (forall (r :: * -> *). TypeElim r => r (Type r) -> CodeType
getType (forall (r :: * -> *).
VariableElim r =>
r (Variable r) -> r (Type r)
variableType r (Variable r)
v)) Doc -> Doc -> Doc
<>
forall (r :: * -> *). InternalVarElim r => r (Variable r) -> Doc
RC.variable r (Variable r)
v))
where bind :: Binding -> r (Permanence r)
bind Binding
Static = r (Permanence r)
s
bind Binding
Dynamic = r (Permanence r)
d
ptrdoc :: CodeType -> Doc
ptrdoc (List CodeType
_) = Doc
pdoc
ptrdoc CodeType
_ = Doc
empty
varDecDef :: (RenderSym r) => Terminator -> SVariable r -> SValue r ->
MSStatement r
varDecDef :: forall (r :: * -> *).
RenderSym r =>
Terminator -> SVariable r -> SValue r -> MSStatement r
varDecDef Terminator
t SVariable r
vr SValue r
vl' = do
r (Statement r)
vd <- forall (r :: * -> *).
DeclStatement r =>
SVariable r -> MSStatement r
S.varDec SVariable r
vr
r (Value r)
vl <- forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom Lens' MethodState ValueState
lensMStoVS SValue r
vl'
let stmtCtor :: Terminator -> Doc -> MSStatement r
stmtCtor Terminator
Empty = forall (r :: * -> *). RenderSym r => Doc -> MSStatement r
mkStmtNoEnd
stmtCtor Terminator
Semi = forall (r :: * -> *). RenderSym r => Doc -> MSStatement r
mkStmt
forall {r :: * -> *}.
RenderSym r =>
Terminator -> Doc -> MSStatement r
stmtCtor Terminator
t (forall (r :: * -> *). StatementElim r => r (Statement r) -> Doc
RC.statement r (Statement r)
vd Doc -> Doc -> Doc
<+> Doc
equals Doc -> Doc -> Doc
<+> forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value r (Value r)
vl)
listDec :: (RenderSym r) => (r (Value r) -> Doc) -> SValue r -> SVariable r ->
MSStatement r
listDec :: forall (r :: * -> *).
RenderSym r =>
(r (Value r) -> Doc) -> SValue r -> SVariable r -> MSStatement r
listDec r (Value r) -> Doc
f SValue r
vl SVariable r
v = do
r (Value r)
sz <- forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom Lens' MethodState ValueState
lensMStoVS SValue r
vl
r (Statement r)
vd <- forall (r :: * -> *).
DeclStatement r =>
SVariable r -> MSStatement r
S.varDec SVariable r
v
forall (r :: * -> *). RenderSym r => Doc -> MSStatement r
mkStmt (forall (r :: * -> *). StatementElim r => r (Statement r) -> Doc
RC.statement r (Statement r)
vd Doc -> Doc -> Doc
<> r (Value r) -> Doc
f r (Value r)
sz)
extObjDecNew :: (RenderSym r) => Library -> SVariable r -> [SValue r] ->
MSStatement r
extObjDecNew :: forall (r :: * -> *).
RenderSym r =>
String -> SVariable r -> [SValue r] -> MSStatement r
extObjDecNew String
l SVariable r
v [SValue r]
vs = forall (r :: * -> *).
DeclStatement r =>
SVariable r -> SValue r -> MSStatement r
S.varDecDef SVariable r
v (forall (r :: * -> *). ValueExpression r => String -> PosCtorCall r
extNewObj String
l (forall a b s. (a -> b) -> State s a -> State s b
onStateValue forall (r :: * -> *).
VariableElim r =>
r (Variable r) -> r (Type r)
variableType SVariable r
v)
[SValue r]
vs)
switch :: (RenderSym r) => (Doc -> Doc) -> MSStatement r -> SValue r ->
[(SValue r, MSBody r)] -> MSBody r -> MSStatement r
switch :: forall (r :: * -> *).
RenderSym r =>
(Doc -> Doc)
-> MSStatement r
-> SValue r
-> [(SValue r, MSBody r)]
-> MSBody r
-> MSStatement r
switch Doc -> Doc
f MSStatement r
st SValue r
v [(SValue r, MSBody r)]
cs MSBody r
bod = do
r (Statement r)
s <- forall (r :: * -> *).
RenderStatement r =>
MSStatement r -> MSStatement r
S.stmt MSStatement r
st
r (Value r)
val <- forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom Lens' MethodState ValueState
lensMStoVS SValue r
v
[r (Value r)]
vals <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom Lens' MethodState ValueState
lensMStoVS forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(SValue r, MSBody r)]
cs
[r (Body r)]
bods <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a b. (a, b) -> b
snd [(SValue r, MSBody r)]
cs
r (Body r)
dflt <- MSBody r
bod
forall (r :: * -> *). RenderSym r => Doc -> MSStatement r
mkStmt forall a b. (a -> b) -> a -> b
$ forall (r :: * -> *).
RenderSym r =>
(Doc -> Doc)
-> r (Statement r)
-> r (Value r)
-> r (Body r)
-> [(r (Value r), r (Body r))]
-> Doc
R.switch Doc -> Doc
f r (Statement r)
s r (Value r)
val r (Body r)
dflt (forall a b. [a] -> [b] -> [(a, b)]
zip [r (Value r)]
vals [r (Body r)]
bods)
for :: (RenderSym r) => Doc -> Doc -> MSStatement r -> SValue r ->
MSStatement r -> MSBody r -> MSStatement r
for :: forall (r :: * -> *).
RenderSym r =>
Doc
-> Doc
-> MSStatement r
-> SValue r
-> MSStatement r
-> MSBody r
-> MSStatement r
for Doc
bStart Doc
bEnd MSStatement r
sInit SValue r
vGuard MSStatement r
sUpdate MSBody r
b = do
r (Statement r)
initl <- forall (r :: * -> *).
RenderStatement r =>
MSStatement r -> MSStatement r
S.loopStmt MSStatement r
sInit
r (Value r)
guard <- forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom Lens' MethodState ValueState
lensMStoVS SValue r
vGuard
r (Statement r)
upd <- forall (r :: * -> *).
RenderStatement r =>
MSStatement r -> MSStatement r
S.loopStmt MSStatement r
sUpdate
r (Body r)
bod <- MSBody r
b
forall (r :: * -> *). RenderSym r => Doc -> MSStatement r
mkStmtNoEnd forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat [
Doc
forLabel Doc -> Doc -> Doc
<+> Doc -> Doc
parens (forall (r :: * -> *). StatementElim r => r (Statement r) -> Doc
RC.statement r (Statement r)
initl Doc -> Doc -> Doc
<> Doc
semi Doc -> Doc -> Doc
<+> forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value r (Value r)
guard Doc -> Doc -> Doc
<>
Doc
semi Doc -> Doc -> Doc
<+> forall (r :: * -> *). StatementElim r => r (Statement r) -> Doc
RC.statement r (Statement r)
upd) Doc -> Doc -> Doc
<+> Doc
bStart,
Doc -> Doc
indent forall a b. (a -> b) -> a -> b
$ forall (r :: * -> *). BodyElim r => r (Body r) -> Doc
RC.body r (Body r)
bod,
Doc
bEnd]
while :: (RenderSym r) => (Doc -> Doc) -> Doc -> Doc -> SValue r -> MSBody r ->
MSStatement r
while :: forall (r :: * -> *).
RenderSym r =>
(Doc -> Doc) -> Doc -> Doc -> SValue r -> MSBody r -> MSStatement r
while Doc -> Doc
f Doc
bStart Doc
bEnd SValue r
v' MSBody r
b'= do
r (Value r)
v <- forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom Lens' MethodState ValueState
lensMStoVS SValue r
v'
r (Body r)
b <- MSBody r
b'
forall (r :: * -> *). RenderSym r => Doc -> MSStatement r
mkStmtNoEnd ([Doc] -> Doc
vcat [Doc
whileLabel Doc -> Doc -> Doc
<+> Doc -> Doc
f (forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value r (Value r)
v) Doc -> Doc -> Doc
<+> Doc
bStart,
Doc -> Doc
indent forall a b. (a -> b) -> a -> b
$ forall (r :: * -> *). BodyElim r => r (Body r) -> Doc
RC.body r (Body r)
b,
Doc
bEnd])
intFunc :: (RenderSym r) => Bool -> Label -> r (Scope r) -> r (Permanence r) ->
MSMthdType r -> [MSParameter r] -> MSBody r -> SMethod r
intFunc :: forall (r :: * -> *).
RenderSym r =>
Bool
-> String
-> r (Scope r)
-> r (Permanence r)
-> MSMthdType r
-> [MSParameter r]
-> MSBody r
-> SMethod r
intFunc = forall (r :: * -> *).
RenderMethod r =>
Bool
-> String
-> r (Scope r)
-> r (Permanence r)
-> MSMthdType r
-> [MSParameter r]
-> MSBody r
-> SMethod r
intMethod
multiAssignError :: String -> String
multiAssignError :: String -> String
multiAssignError String
l = String
"No multiple assignment statements in " forall a. [a] -> [a] -> [a]
++ String
l
multiReturnError :: String -> String
multiReturnError :: String -> String
multiReturnError String
l = String
"Cannot return multiple values in " forall a. [a] -> [a] -> [a]
++ String
l
multiTypeError :: String -> String
multiTypeError :: String -> String
multiTypeError String
l = String
"Multi-types not supported in " forall a. [a] -> [a] -> [a]
++ String
l