{-# LANGUAGE TypeFamilies #-}

-- | The logic to render Python code is contained in this module
module GOOL.Drasil.LanguageRenderer.PythonRenderer (
  -- * Python Code Configuration -- defines syntax of all Python code
  PythonCode(..), pyName, pyVersion
) where

import Utils.Drasil (blank, indent)

import GOOL.Drasil.CodeType (CodeType(..))
import GOOL.Drasil.ClassInterface (Label, Library, VSType, SVariable, SValue, 
  VSFunction, MSStatement, MixedCtorCall, OOProg, ProgramSym(..), FileSym(..),
  PermanenceSym(..), BodySym(..), BlockSym(..), TypeSym(..), TypeElim(..),
  VariableSym(..), VariableElim(..), ValueSym(..), Argument(..), Literal(..),
  litZero, MathConstant(..), VariableValue(..), CommandLineArgs(..),
  NumericExpression(..), BooleanExpression(..), Comparison(..),
  ValueExpression(..), funcApp, selfFuncApp, extFuncApp, extNewObj,
  InternalValueExp(..), objMethodCall, FunctionSym(..), GetSet(..), List(..),
  InternalList(..), ThunkSym(..), VectorType(..), VectorDecl(..),
  VectorThunk(..), VectorExpression(..), ThunkAssign(..), StatementSym(..),
  AssignStatement(..), (&=), DeclStatement(..), IOStatement(..),
  StringStatement(..), FuncAppStatement(..), CommentStatement(..),
  ControlStatement(..), switchAsIf, StatePattern(..), ObserverPattern(..),
  StrategyPattern(..), ScopeSym(..), ParameterSym(..), MethodSym(..),
  StateVarSym(..), ClassSym(..), ModuleSym(..))
import GOOL.Drasil.RendererClasses (RenderSym, RenderFile(..), ImportSym(..), 
  ImportElim, PermElim(binding), RenderBody(..), BodyElim, RenderBlock(..), 
  BlockElim, RenderType(..), InternalTypeElim, UnaryOpSym(..), BinaryOpSym(..), 
  OpElim(uOpPrec, bOpPrec), RenderVariable(..), InternalVarElim(variableBind), 
  RenderValue(..), ValueElim(valuePrec), InternalGetSet(..), 
  InternalListFunc(..), RenderFunction(..), 
  FunctionElim(functionType), InternalAssignStmt(..), InternalIOStmt(..), 
  InternalControlStmt(..), RenderStatement(..), StatementElim(statementTerm), 
  RenderScope(..), ScopeElim, MethodTypeSym(..), RenderParam(..), 
  ParamElim(parameterName, parameterType), RenderMethod(..), MethodElim, 
  StateVarElim, RenderClass(..), ClassElim, RenderMod(..), ModuleElim, 
  BlockCommentSym(..), BlockCommentElim)
import qualified GOOL.Drasil.RendererClasses as RC (import', perm, body, block, 
  type', uOp, bOp, variable, value, function, statement, scope, parameter,
  method, stateVar, class', module', blockComment')
import GOOL.Drasil.LanguageRenderer (classDec, dot, ifLabel, elseLabel, 
  forLabel, inLabel, whileLabel, tryLabel, importLabel, exceptionObj', listSep',
  argv, printLabel, listSep, piLabel, access, functionDox, variableList, 
  parameterList)
import qualified GOOL.Drasil.LanguageRenderer as R (sqrt, fabs, log10, 
  log, exp, sin, cos, tan, asin, acos, atan, floor, ceil, multiStmt, body, 
  classVar, listSetFunc, castObj, dynamic, break, continue, addComments, 
  commentedMod, commentedItem)
import GOOL.Drasil.LanguageRenderer.Constructors (mkStmtNoEnd, mkStateVal, 
  mkVal, mkStateVar, VSOp, unOpPrec, powerPrec, multPrec, andPrec, orPrec, 
  unExpr, unExpr', typeUnExpr, binExpr, typeBinExpr)
import qualified GOOL.Drasil.LanguageRenderer.LanguagePolymorphic as G (
  multiBody, block, multiBlock, listInnerType, obj, negateOp, csc, sec, cot,
  equalOp, notEqualOp, greaterOp, greaterEqualOp, lessOp, lessEqualOp, plusOp,
  minusOp, multOp, divideOp, moduloOp, var, staticVar, objVar, arrayElem,
  litChar, litDouble, litInt, litString, valueOf, arg, argsList, objAccess,
  objMethodCall, call, funcAppMixedArgs, selfFuncAppMixedArgs, newObjMixedArgs,
  lambda, func, get, set, listAdd, listAppend, listAccess, listSet, getFunc,
  setFunc, listAppendFunc, stmt, loopStmt, emptyStmt, assign, subAssign,
  increment, objDecNew, print, closeFile, returnStmt, valStmt, comment, throw,
  ifCond, tryCatch, construct, param, method, getMethod, setMethod, function,
  buildClass, implementingClass, commentedClass, modFromData, fileDoc,
  fileFromData)
import qualified GOOL.Drasil.LanguageRenderer.CommonPseudoOO as CP (int,
  constructor, doxFunc, doxClass, doxMod, extVar, classVar, objVarSelf,
  extFuncAppMixedArgs, indexOf, listAddFunc, discardFileLine, intClass, 
  funcType, buildModule, bindingError, notNull, listDecDef, destructorError, 
  stateVarDef, constVar, litArray, listSetFunc, extraClass, listAccessFunc, 
  multiAssign, multiReturn, listDec, funcDecDef, inOutCall, forLoopError, 
  mainBody, inOutFunc, docInOutFunc')
import qualified GOOL.Drasil.LanguageRenderer.Macros as M (ifExists, 
  decrement1, increment1, runStrategy, stringListVals, stringListLists, 
  notifyObservers', checkState)
import GOOL.Drasil.AST (Terminator(..), FileType(..), FileData(..), fileD, 
  FuncData(..), fd, ModData(..), md, updateMod, MethodData(..), mthd,
  updateMthd, OpData(..), ParamData(..), pd, ProgData(..), progD, TypeData(..),
  td, ValData(..), vd, VarData(..), vard, CommonThunk, pureValue, vectorize,
  vectorize2, sumComponents, commonVecIndex, commonThunkElim, commonThunkDim)
import GOOL.Drasil.Helpers (vibcat, emptyIfEmpty, toCode, toState, onCodeValue,
  onStateValue, on2CodeValues, on2StateValues, onCodeList, onStateList, on2StateWrapped)
import GOOL.Drasil.State (MS, VS, lensGStoFS, lensMStoVS, lensVStoMS, 
  revFiles, addLangImportVS, getLangImports, addLibImportVS, 
  getLibImports, addModuleImport, addModuleImportVS, getModuleImports, 
  setFileType, getClassName, setCurrMain, getClassMap, getMainDoc, useVarName,
  genLoopIndex)

import Prelude hiding (break,print,sin,cos,tan,floor,(<>))
import Data.Maybe (fromMaybe)
import Control.Applicative (liftA2)
import Control.Lens.Zoom (zoom)
import Control.Monad (join)
import Control.Monad.State (modify)
import Data.List (intercalate, sort)
import qualified Data.Map as Map (lookup)
import Text.PrettyPrint.HughesPJ (Doc, text, (<>), (<+>), parens, empty, equals,
  vcat, colon, brackets, isEmpty, quotes)
import GOOL.Drasil.LanguageRenderer.LanguagePolymorphic (OptionalSpace(..))

pyExt :: String
pyExt :: String
pyExt = String
"py"

newtype PythonCode a = PC {forall a. PythonCode a -> a
unPC :: a}

instance Functor PythonCode where
  fmap :: forall a b. (a -> b) -> PythonCode a -> PythonCode b
fmap a -> b
f (PC a
x) = forall a. a -> PythonCode a
PC (a -> b
f a
x)

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

instance Monad PythonCode where
  PC a
x >>= :: forall a b. PythonCode a -> (a -> PythonCode b) -> PythonCode b
>>= a -> PythonCode b
f = a -> PythonCode b
f a
x

instance OOProg PythonCode

instance ProgramSym PythonCode where
  type Program PythonCode = ProgData 
  prog :: String -> String -> [SFile PythonCode] -> GSProgram PythonCode
prog String
n String
st [SFile PythonCode]
files = do
    [PythonCode FileData]
fs <- 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' GOOLState FileState
lensGStoFS) [SFile PythonCode]
files
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify GOOLState -> GOOLState
revFiles
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b. Monad m => ([a] -> b) -> [m a] -> m b
onCodeList (String -> String -> [FileData] -> ProgData
progD String
n String
st) [PythonCode FileData]
fs

instance RenderSym PythonCode

instance FileSym PythonCode where
  type File PythonCode = FileData
  fileDoc :: FSModule PythonCode -> SFile PythonCode
fileDoc FSModule PythonCode
m = do
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (FileType -> FileState -> FileState
setFileType FileType
Combined)
    forall (r :: * -> *).
RenderSym r =>
String
-> (r (Module r) -> r (Block r))
-> r (Block r)
-> FSModule r
-> SFile r
G.fileDoc String
pyExt forall (r :: * -> *). RenderFile r => r (Module r) -> r (Block r)
top forall (r :: * -> *). RenderFile r => r (Block r)
bottom FSModule PythonCode
m

  docMod :: String
-> [String] -> String -> SFile PythonCode -> SFile PythonCode
docMod = forall (r :: * -> *).
RenderSym r =>
String -> String -> [String] -> String -> SFile r -> SFile r
CP.doxMod String
pyExt

instance RenderFile PythonCode where
  top :: PythonCode (Module PythonCode) -> PythonCode (Block PythonCode)
top PythonCode (Module PythonCode)
_ = forall (r :: * -> *) a. Monad r => a -> r a
toCode Doc
empty
  bottom :: PythonCode (Block PythonCode)
bottom = forall (r :: * -> *) a. Monad r => a -> r a
toCode Doc
empty
  
  commentedMod :: SFile PythonCode
-> FS (PythonCode (BlockComment PythonCode)) -> SFile PythonCode
commentedMod = forall a b c s.
(a -> b -> c) -> State s a -> State s b -> State s c
on2StateValues (forall (r :: * -> *) a b c.
Applicative r =>
(a -> b -> c) -> r a -> r b -> r c
on2CodeValues FileData -> Doc -> FileData
R.commentedMod)

  fileFromData :: String -> FSModule PythonCode -> SFile PythonCode
fileFromData = forall (r :: * -> *).
RenderSym r =>
(String -> r (Module r) -> r (File r))
-> String -> FSModule r -> SFile r
G.fileFromData (forall (r :: * -> *) a b. Functor r => (a -> b) -> r a -> r b
onCodeValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ModData -> FileData
fileD)

instance ImportSym PythonCode where
  type Import PythonCode = Doc
  langImport :: String -> PythonCode (Import PythonCode)
langImport String
n = forall (r :: * -> *) a. Monad r => a -> r a
toCode forall a b. (a -> b) -> a -> b
$ Doc
importLabel Doc -> Doc -> Doc
<+> String -> Doc
text String
n
  modImport :: String -> PythonCode (Import PythonCode)
modImport = forall (r :: * -> *). ImportSym r => String -> r (Import r)
langImport

instance ImportElim PythonCode where
  import' :: PythonCode (Import PythonCode) -> Doc
import' = forall a. PythonCode a -> a
unPC

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

instance PermElim PythonCode where
  perm :: PythonCode (Permanence PythonCode) -> Doc
perm = forall a. PythonCode a -> a
unPC
  binding :: PythonCode (Permanence PythonCode) -> Binding
binding = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String -> String
CP.bindingError String
pyName

instance BodySym PythonCode where
  type Body PythonCode = Doc
  body :: [MSBlock PythonCode] -> MSBody PythonCode
body = forall a b s. ([a] -> b) -> [State s a] -> State s b
onStateList (forall (m :: * -> *) a b. Monad m => ([a] -> b) -> [m a] -> m b
onCodeList [Doc] -> Doc
R.body)

  addComments :: String -> MSBody PythonCode -> MSBody PythonCode
addComments String
s = forall a b s. (a -> b) -> State s a -> State s b
onStateValue (forall (r :: * -> *) a b. Functor r => (a -> b) -> r a -> r b
onCodeValue (String -> Doc -> Doc -> Doc
R.addComments String
s Doc
pyCommentStart))

instance RenderBody PythonCode where
  multiBody :: [MSBody PythonCode] -> MSBody PythonCode
multiBody = forall (r :: * -> *).
(RenderSym r, Monad r) =>
[MSBody r] -> MS (r Doc)
G.multiBody 

instance BodyElim PythonCode where
  body :: PythonCode (Body PythonCode) -> Doc
body = forall a. PythonCode a -> a
unPC

instance BlockSym PythonCode where
  type Block PythonCode = Doc
  block :: [MSStatement PythonCode] -> MSBlock PythonCode
block = forall (r :: * -> *).
(RenderSym r, Monad r) =>
[MSStatement r] -> MS (r Doc)
G.block

instance RenderBlock PythonCode where
  multiBlock :: [MSBlock PythonCode] -> MSBlock PythonCode
multiBlock = forall (r :: * -> *).
(RenderSym r, Monad r) =>
[MSBlock r] -> MS (r Doc)
G.multiBlock

instance BlockElim PythonCode where
  block :: PythonCode (Block PythonCode) -> Doc
block = forall a. PythonCode a -> a
unPC

instance TypeSym PythonCode where
  type Type PythonCode = TypeData
  bool :: VSType PythonCode
bool = forall (r :: * -> *).
RenderType r =>
CodeType -> String -> Doc -> VSType r
typeFromData CodeType
Boolean String
"" Doc
empty
  int :: VSType PythonCode
int = forall (r :: * -> *). RenderSym r => VSType r
CP.int
  float :: VSType PythonCode
float = forall a. HasCallStack => String -> a
error String
pyFloatError
  double :: VSType PythonCode
double = forall (r :: * -> *).
RenderType r =>
CodeType -> String -> Doc -> VSType r
typeFromData CodeType
Double String
pyDouble (String -> Doc
text String
pyDouble)
  char :: VSType PythonCode
char = forall (r :: * -> *).
RenderType r =>
CodeType -> String -> Doc -> VSType r
typeFromData CodeType
Char String
"" Doc
empty
  string :: VSType PythonCode
string = forall (r :: * -> *). RenderSym r => VSType r
pyStringType
  infile :: VSType PythonCode
infile = forall (r :: * -> *).
RenderType r =>
CodeType -> String -> Doc -> VSType r
typeFromData CodeType
InFile String
"" Doc
empty
  outfile :: VSType PythonCode
outfile = forall (r :: * -> *).
RenderType r =>
CodeType -> String -> Doc -> VSType r
typeFromData CodeType
OutFile String
"" Doc
empty
  listType :: VSType PythonCode -> VSType PythonCode
listType VSType PythonCode
t' = VSType PythonCode
t' forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=(\PythonCode TypeData
t -> forall (r :: * -> *).
RenderType r =>
CodeType -> String -> Doc -> VSType r
typeFromData (CodeType -> CodeType
List (forall (r :: * -> *). TypeElim r => r (Type r) -> CodeType
getType PythonCode TypeData
t)) String
"" Doc
empty)
  arrayType :: VSType PythonCode -> VSType PythonCode
arrayType = forall (r :: * -> *). TypeSym r => VSType r -> VSType r
listType
  listInnerType :: VSType PythonCode -> VSType PythonCode
listInnerType = forall (r :: * -> *). RenderSym r => VSType r -> VSType r
G.listInnerType
  obj :: String -> VSType PythonCode
obj = forall (r :: * -> *). RenderSym r => String -> VSType r
G.obj
  funcType :: [VSType PythonCode] -> VSType PythonCode -> VSType PythonCode
funcType = forall (r :: * -> *).
RenderSym r =>
[VSType r] -> VSType r -> VSType r
CP.funcType
  void :: VSType PythonCode
void = forall (r :: * -> *).
RenderType r =>
CodeType -> String -> Doc -> VSType r
typeFromData CodeType
Void String
pyVoid (String -> Doc
text String
pyVoid)

instance TypeElim PythonCode where
  getType :: PythonCode (Type PythonCode) -> CodeType
getType = TypeData -> CodeType
cType forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. PythonCode a -> a
unPC
  getTypeString :: PythonCode (Type PythonCode) -> String
getTypeString = TypeData -> String
typeString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. PythonCode a -> a
unPC

instance RenderType PythonCode where
  multiType :: [VSType PythonCode] -> VSType PythonCode
multiType [VSType PythonCode]
_ = forall (r :: * -> *).
RenderType r =>
CodeType -> String -> Doc -> VSType r
typeFromData CodeType
Void String
"" Doc
empty
  typeFromData :: CodeType -> String -> Doc -> VSType PythonCode
typeFromData CodeType
t String
s Doc
d = forall a s. a -> State s a
toState forall a b. (a -> b) -> a -> b
$ forall (r :: * -> *) a. Monad r => a -> r a
toCode forall a b. (a -> b) -> a -> b
$ CodeType -> String -> Doc -> TypeData
td CodeType
t String
s Doc
d

instance InternalTypeElim PythonCode where
  type' :: PythonCode (Type PythonCode) -> Doc
type' = TypeData -> Doc
typeDoc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. PythonCode a -> a
unPC

instance UnaryOpSym PythonCode where
  type UnaryOp PythonCode = OpData
  notOp :: VSUnOp PythonCode
notOp = forall (r :: * -> *). Monad r => VSOp r
pyNotOp
  negateOp :: VSUnOp PythonCode
negateOp = forall (r :: * -> *). Monad r => VSOp r
G.negateOp
  sqrtOp :: VSUnOp PythonCode
sqrtOp = forall (r :: * -> *). Monad r => VSOp r
pySqrtOp
  absOp :: VSUnOp PythonCode
absOp = forall (r :: * -> *). Monad r => VSOp r
pyAbsOp
  logOp :: VSUnOp PythonCode
logOp = forall (r :: * -> *). Monad r => VSOp r
pyLogOp
  lnOp :: VSUnOp PythonCode
lnOp = forall (r :: * -> *). Monad r => VSOp r
pyLnOp
  expOp :: VSUnOp PythonCode
expOp = forall (r :: * -> *). Monad r => VSOp r
pyExpOp
  sinOp :: VSUnOp PythonCode
sinOp = forall (r :: * -> *). Monad r => VSOp r
pySinOp
  cosOp :: VSUnOp PythonCode
cosOp = forall (r :: * -> *). Monad r => VSOp r
pyCosOp
  tanOp :: VSUnOp PythonCode
tanOp = forall (r :: * -> *). Monad r => VSOp r
pyTanOp
  asinOp :: VSUnOp PythonCode
asinOp = forall (r :: * -> *). Monad r => VSOp r
pyAsinOp
  acosOp :: VSUnOp PythonCode
acosOp = forall (r :: * -> *). Monad r => VSOp r
pyAcosOp
  atanOp :: VSUnOp PythonCode
atanOp = forall (r :: * -> *). Monad r => VSOp r
pyAtanOp
  floorOp :: VSUnOp PythonCode
floorOp = forall (r :: * -> *). Monad r => VSOp r
pyFloorOp 
  ceilOp :: VSUnOp PythonCode
ceilOp = forall (r :: * -> *). Monad r => VSOp r
pyCeilOp

instance BinaryOpSym PythonCode where
  type BinaryOp PythonCode = OpData
  equalOp :: VSBinOp PythonCode
equalOp = forall (r :: * -> *). Monad r => VSOp r
G.equalOp
  notEqualOp :: VSBinOp PythonCode
notEqualOp = forall (r :: * -> *). Monad r => VSOp r
G.notEqualOp
  greaterOp :: VSBinOp PythonCode
greaterOp = forall (r :: * -> *). Monad r => VSOp r
G.greaterOp
  greaterEqualOp :: VSBinOp PythonCode
greaterEqualOp = forall (r :: * -> *). Monad r => VSOp r
G.greaterEqualOp
  lessOp :: VSBinOp PythonCode
lessOp = forall (r :: * -> *). Monad r => VSOp r
G.lessOp
  lessEqualOp :: VSBinOp PythonCode
lessEqualOp = forall (r :: * -> *). Monad r => VSOp r
G.lessEqualOp
  plusOp :: VSBinOp PythonCode
plusOp = forall (r :: * -> *). Monad r => VSOp r
G.plusOp
  minusOp :: VSBinOp PythonCode
minusOp = forall (r :: * -> *). Monad r => VSOp r
G.minusOp
  multOp :: VSBinOp PythonCode
multOp = forall (r :: * -> *). Monad r => VSOp r
G.multOp
  divideOp :: VSBinOp PythonCode
divideOp = forall (r :: * -> *). Monad r => VSOp r
G.divideOp
  powerOp :: VSBinOp PythonCode
powerOp = forall (r :: * -> *). Monad r => String -> VSOp r
powerPrec String
pyPower
  moduloOp :: VSBinOp PythonCode
moduloOp = forall (r :: * -> *). Monad r => VSOp r
G.moduloOp
  andOp :: VSBinOp PythonCode
andOp = forall (r :: * -> *). Monad r => String -> VSOp r
andPrec String
pyAnd
  orOp :: VSBinOp PythonCode
orOp = forall (r :: * -> *). Monad r => String -> VSOp r
orPrec String
pyOr

instance OpElim PythonCode where
  uOp :: PythonCode (UnaryOp PythonCode) -> Doc
uOp = OpData -> Doc
opDoc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. PythonCode a -> a
unPC
  bOp :: PythonCode (BinaryOp PythonCode) -> Doc
bOp = OpData -> Doc
opDoc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. PythonCode a -> a
unPC
  uOpPrec :: PythonCode (UnaryOp PythonCode) -> Int
uOpPrec = OpData -> Int
opPrec forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. PythonCode a -> a
unPC
  bOpPrec :: PythonCode (BinaryOp PythonCode) -> Int
bOpPrec = OpData -> Int
opPrec forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. PythonCode a -> a
unPC

instance VariableSym PythonCode where
  type Variable PythonCode = VarData
  var :: String -> VSType PythonCode -> SVariable PythonCode
var = forall (r :: * -> *).
RenderSym r =>
String -> VSType r -> SVariable r
G.var
  staticVar :: String -> VSType PythonCode -> SVariable PythonCode
staticVar = forall (r :: * -> *).
RenderSym r =>
String -> VSType r -> SVariable r
G.staticVar
  constant :: String -> VSType PythonCode -> SVariable PythonCode
constant = forall (r :: * -> *).
VariableSym r =>
String -> VSType r -> SVariable r
var
  extVar :: String -> String -> VSType PythonCode -> SVariable PythonCode
extVar String
l String
n VSType PythonCode
t = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (String -> ValueState -> ValueState
addModuleImportVS String
l) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (r :: * -> *).
RenderSym r =>
String -> String -> VSType r -> SVariable r
CP.extVar String
l String
n VSType PythonCode
t
  self :: SVariable PythonCode
self = 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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\String
l -> forall (r :: * -> *).
RenderSym r =>
String -> VSType r -> Doc -> SVariable r
mkStateVar String
pySelf (forall (r :: * -> *). TypeSym r => String -> VSType r
obj String
l) (String -> Doc
text String
pySelf))
  classVar :: VSType PythonCode -> SVariable PythonCode -> SVariable PythonCode
classVar = forall (r :: * -> *).
RenderSym r =>
(Doc -> Doc -> Doc) -> VSType r -> SVariable r -> SVariable r
CP.classVar Doc -> Doc -> Doc
R.classVar
  extClassVar :: VSType PythonCode -> SVariable PythonCode -> SVariable PythonCode
extClassVar VSType PythonCode
c SVariable PythonCode
v = forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall a b. (a -> b) -> a -> b
$ forall a b c s.
(a -> b -> c) -> State s a -> State s b -> State s c
on2StateValues (\PythonCode (Type PythonCode)
t Map String String
cm -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
(>>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall b c a. (b -> c) -> (a -> b) -> a -> c
. 
    String -> ValueState -> ValueState
addModuleImportVS) (forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (forall (r :: * -> *). TypeElim r => r (Type r) -> String
getTypeString PythonCode (Type PythonCode)
t) Map String String
cm) forall a b. (a -> b) -> a -> b
$ 
    forall (r :: * -> *).
RenderSym r =>
(Doc -> Doc -> Doc) -> VSType r -> SVariable r -> SVariable r
CP.classVar Doc -> Doc -> Doc
pyClassVar (forall a s. a -> State s a
toState PythonCode (Type PythonCode)
t) SVariable PythonCode
v) VSType PythonCode
c VS (Map String String)
getClassMap
  objVar :: SVariable PythonCode
-> SVariable PythonCode -> SVariable PythonCode
objVar = forall (r :: * -> *).
RenderSym r =>
SVariable r -> SVariable r -> SVariable r
G.objVar
  objVarSelf :: SVariable PythonCode -> SVariable PythonCode
objVarSelf = forall (r :: * -> *). RenderSym r => SVariable r -> SVariable r
CP.objVarSelf
  arrayElem :: Integer -> SVariable PythonCode -> SVariable PythonCode
arrayElem Integer
i = forall (r :: * -> *).
RenderSym r =>
SValue r -> SVariable r -> SVariable r
G.arrayElem (forall (r :: * -> *). Literal r => Integer -> SValue r
litInt Integer
i)

instance VariableElim PythonCode where
  variableName :: PythonCode (Variable PythonCode) -> String
variableName = VarData -> String
varName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. PythonCode a -> a
unPC
  variableType :: PythonCode (Variable PythonCode) -> PythonCode (Type PythonCode)
variableType = forall (r :: * -> *) a b. Functor r => (a -> b) -> r a -> r b
onCodeValue VarData -> TypeData
varType

instance InternalVarElim PythonCode where
  variableBind :: PythonCode (Variable PythonCode) -> Binding
variableBind = VarData -> Binding
varBind forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. PythonCode a -> a
unPC
  variable :: PythonCode (Variable PythonCode) -> Doc
variable = VarData -> Doc
varDoc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. PythonCode a -> a
unPC

instance RenderVariable PythonCode where
  varFromData :: Binding
-> String -> VSType PythonCode -> Doc -> SVariable PythonCode
varFromData Binding
b String
n VSType PythonCode
t' Doc
d = do 
    PythonCode TypeData
t <- VSType PythonCode
t'
    forall a s. a -> State s a
toState forall a b. (a -> b) -> a -> b
$ forall (r :: * -> *) a b c.
Applicative r =>
(a -> b -> c) -> r a -> r b -> r c
on2CodeValues (Binding -> String -> TypeData -> Doc -> VarData
vard Binding
b String
n) PythonCode TypeData
t (forall (r :: * -> *) a. Monad r => a -> r a
toCode Doc
d)

instance ValueSym PythonCode where
  type Value PythonCode = ValData
  valueType :: PythonCode (Value PythonCode) -> PythonCode (Type PythonCode)
valueType = forall (r :: * -> *) a b. Functor r => (a -> b) -> r a -> r b
onCodeValue ValData -> TypeData
valType

instance Argument PythonCode where
  pointerArg :: SValue PythonCode -> SValue PythonCode
pointerArg = forall a. a -> a
id

instance Literal PythonCode where
  litTrue :: SValue PythonCode
litTrue = forall (r :: * -> *). RenderSym r => VSType r -> Doc -> SValue r
mkStateVal forall (r :: * -> *). TypeSym r => VSType r
bool Doc
pyTrue
  litFalse :: SValue PythonCode
litFalse = forall (r :: * -> *). RenderSym r => VSType r -> Doc -> SValue r
mkStateVal forall (r :: * -> *). TypeSym r => VSType r
bool Doc
pyFalse
  litChar :: Char -> SValue PythonCode
litChar = forall (r :: * -> *).
RenderSym r =>
(Doc -> Doc) -> Char -> SValue r
G.litChar Doc -> Doc
quotes
  litDouble :: Double -> SValue PythonCode
litDouble = forall (r :: * -> *). RenderSym r => Double -> SValue r
G.litDouble
  litFloat :: Float -> SValue PythonCode
litFloat = forall a. HasCallStack => String -> a
error String
pyFloatError
  litInt :: Integer -> SValue PythonCode
litInt = forall (r :: * -> *). RenderSym r => Integer -> SValue r
G.litInt
  litString :: String -> SValue PythonCode
litString = forall (r :: * -> *). RenderSym r => String -> SValue r
G.litString
  litArray :: VSType PythonCode -> [SValue PythonCode] -> SValue PythonCode
litArray = forall (r :: * -> *).
RenderSym r =>
(Doc -> Doc) -> VSType r -> [SValue r] -> SValue r
CP.litArray Doc -> Doc
brackets
  litList :: VSType PythonCode -> [SValue PythonCode] -> SValue PythonCode
litList = forall (r :: * -> *).
Literal r =>
VSType r -> [SValue r] -> SValue r
litArray

instance MathConstant PythonCode where
  pi :: SValue PythonCode
pi = forall a. VS a -> VS a
addmathImport forall a b. (a -> b) -> a -> b
$ forall (r :: * -> *). RenderSym r => VSType r -> Doc -> SValue r
mkStateVal forall (r :: * -> *). TypeSym r => VSType r
double Doc
pyPi

instance VariableValue PythonCode where
  valueOf :: SVariable PythonCode -> SValue PythonCode
valueOf = forall (r :: * -> *). RenderSym r => SVariable r -> SValue r
G.valueOf

instance CommandLineArgs PythonCode where
  arg :: Integer -> SValue PythonCode
arg Integer
n = forall (r :: * -> *).
RenderSym r =>
SValue r -> SValue r -> SValue r
G.arg (forall (r :: * -> *). Literal r => Integer -> SValue r
litInt forall a b. (a -> b) -> a -> b
$ Integer
nforall a. Num a => a -> a -> a
+Integer
1) forall (r :: * -> *). CommandLineArgs r => SValue r
argsList
  argsList :: SValue PythonCode
argsList = do
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (String -> ValueState -> ValueState
addLangImportVS String
pySys)
    forall (r :: * -> *). RenderSym r => String -> SValue r
G.argsList forall a b. (a -> b) -> a -> b
$ String
pySys String -> String -> String
`access` String
argv
  argExists :: Integer -> SValue PythonCode
argExists Integer
i = forall (r :: * -> *). List r => SValue r -> SValue r
listSize forall (r :: * -> *). CommandLineArgs r => SValue r
argsList forall (r :: * -> *).
Comparison r =>
SValue r -> SValue r -> SValue r
?> forall (r :: * -> *). Literal r => Integer -> SValue r
litInt (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Integer
iforall a. Num a => a -> a -> a
+Integer
1)

instance NumericExpression PythonCode where
  #~ :: SValue PythonCode -> SValue PythonCode
(#~) = forall (r :: * -> *).
RenderSym r =>
VSUnOp r -> SValue r -> SValue r
unExpr' forall (r :: * -> *). UnaryOpSym r => VSUnOp r
negateOp
  #/^ :: SValue PythonCode -> SValue PythonCode
(#/^) = forall (r :: * -> *).
RenderSym r =>
VSUnOp r -> SValue r -> SValue r
unExpr forall (r :: * -> *). UnaryOpSym r => VSUnOp r
sqrtOp
  #| :: SValue PythonCode -> SValue PythonCode
(#|) = forall (r :: * -> *).
RenderSym r =>
VSUnOp r -> SValue r -> SValue r
unExpr forall (r :: * -> *). UnaryOpSym r => VSUnOp r
absOp
  #+ :: SValue PythonCode -> SValue PythonCode -> SValue PythonCode
(#+) = forall (r :: * -> *).
RenderSym r =>
VSBinOp r -> SValue r -> SValue r -> SValue r
binExpr forall (r :: * -> *). BinaryOpSym r => VSBinOp r
plusOp
  #- :: SValue PythonCode -> SValue PythonCode -> SValue PythonCode
(#-) = forall (r :: * -> *).
RenderSym r =>
VSBinOp r -> SValue r -> SValue r -> SValue r
binExpr forall (r :: * -> *). BinaryOpSym r => VSBinOp r
minusOp
  #* :: SValue PythonCode -> SValue PythonCode -> SValue PythonCode
(#*) = forall (r :: * -> *).
RenderSym r =>
VSBinOp r -> SValue r -> SValue r -> SValue r
binExpr forall (r :: * -> *). BinaryOpSym r => VSBinOp r
multOp
  #/ :: SValue PythonCode -> SValue PythonCode -> SValue PythonCode
(#/) SValue PythonCode
v1' SValue PythonCode
v2' = do
    PythonCode ValData
v1 <- SValue PythonCode
v1'
    PythonCode ValData
v2 <- SValue PythonCode
v2'
    let pyDivision :: CodeType -> CodeType -> SValue r -> SValue r -> SValue r
pyDivision CodeType
Integer CodeType
Integer = forall (r :: * -> *).
RenderSym r =>
VSBinOp r -> SValue r -> SValue r -> SValue r
binExpr (forall (r :: * -> *). Monad r => String -> VSOp r
multPrec String
pyIntDiv)
        pyDivision CodeType
_ CodeType
_ = forall (r :: * -> *).
RenderSym r =>
VSBinOp r -> SValue r -> SValue r -> SValue r
binExpr forall (r :: * -> *). BinaryOpSym r => VSBinOp r
divideOp
    forall {r :: * -> *}.
(BinaryOp r ~ OpData, RenderSym r, Monad r) =>
CodeType -> CodeType -> SValue r -> SValue r -> SValue r
pyDivision (forall (r :: * -> *). TypeElim r => r (Type r) -> CodeType
getType forall a b. (a -> b) -> a -> b
$ forall (r :: * -> *). ValueSym r => r (Value r) -> r (Type r)
valueType PythonCode ValData
v1) (forall (r :: * -> *). TypeElim r => r (Type r) -> CodeType
getType forall a b. (a -> b) -> a -> b
$ forall (r :: * -> *). ValueSym r => r (Value r) -> r (Type r)
valueType PythonCode ValData
v2) (forall (f :: * -> *) a. Applicative f => a -> f a
pure PythonCode ValData
v1) 
      (forall (f :: * -> *) a. Applicative f => a -> f a
pure PythonCode ValData
v2)
  #% :: SValue PythonCode -> SValue PythonCode -> SValue PythonCode
(#%) = forall (r :: * -> *).
RenderSym r =>
VSBinOp r -> SValue r -> SValue r -> SValue r
binExpr forall (r :: * -> *). BinaryOpSym r => VSBinOp r
moduloOp
  #^ :: SValue PythonCode -> SValue PythonCode -> SValue PythonCode
(#^) = forall (r :: * -> *).
RenderSym r =>
VSBinOp r -> SValue r -> SValue r -> SValue r
binExpr forall (r :: * -> *). BinaryOpSym r => VSBinOp r
powerOp

  log :: SValue PythonCode -> SValue PythonCode
log = forall (r :: * -> *).
RenderSym r =>
VSUnOp r -> SValue r -> SValue r
unExpr forall (r :: * -> *). UnaryOpSym r => VSUnOp r
logOp
  ln :: SValue PythonCode -> SValue PythonCode
ln = forall (r :: * -> *).
RenderSym r =>
VSUnOp r -> SValue r -> SValue r
unExpr forall (r :: * -> *). UnaryOpSym r => VSUnOp r
lnOp
  exp :: SValue PythonCode -> SValue PythonCode
exp = forall (r :: * -> *).
RenderSym r =>
VSUnOp r -> SValue r -> SValue r
unExpr forall (r :: * -> *). UnaryOpSym r => VSUnOp r
expOp
  sin :: SValue PythonCode -> SValue PythonCode
sin = forall (r :: * -> *).
RenderSym r =>
VSUnOp r -> SValue r -> SValue r
unExpr forall (r :: * -> *). UnaryOpSym r => VSUnOp r
sinOp
  cos :: SValue PythonCode -> SValue PythonCode
cos = forall (r :: * -> *).
RenderSym r =>
VSUnOp r -> SValue r -> SValue r
unExpr forall (r :: * -> *). UnaryOpSym r => VSUnOp r
cosOp
  tan :: SValue PythonCode -> SValue PythonCode
tan = forall (r :: * -> *).
RenderSym r =>
VSUnOp r -> SValue r -> SValue r
unExpr forall (r :: * -> *). UnaryOpSym r => VSUnOp r
tanOp
  csc :: SValue PythonCode -> SValue PythonCode
csc = forall (r :: * -> *). RenderSym r => SValue r -> SValue r
G.csc
  sec :: SValue PythonCode -> SValue PythonCode
sec = forall (r :: * -> *). RenderSym r => SValue r -> SValue r
G.sec
  cot :: SValue PythonCode -> SValue PythonCode
cot = forall (r :: * -> *). RenderSym r => SValue r -> SValue r
G.cot
  arcsin :: SValue PythonCode -> SValue PythonCode
arcsin = forall (r :: * -> *).
RenderSym r =>
VSUnOp r -> SValue r -> SValue r
unExpr forall (r :: * -> *). UnaryOpSym r => VSUnOp r
asinOp
  arccos :: SValue PythonCode -> SValue PythonCode
arccos = forall (r :: * -> *).
RenderSym r =>
VSUnOp r -> SValue r -> SValue r
unExpr forall (r :: * -> *). UnaryOpSym r => VSUnOp r
acosOp
  arctan :: SValue PythonCode -> SValue PythonCode
arctan = forall (r :: * -> *).
RenderSym r =>
VSUnOp r -> SValue r -> SValue r
unExpr forall (r :: * -> *). UnaryOpSym r => VSUnOp r
atanOp
  floor :: SValue PythonCode -> SValue PythonCode
floor = forall (r :: * -> *).
RenderSym r =>
VSUnOp r -> SValue r -> SValue r
unExpr forall (r :: * -> *). UnaryOpSym r => VSUnOp r
floorOp
  ceil :: SValue PythonCode -> SValue PythonCode
ceil = forall (r :: * -> *).
RenderSym r =>
VSUnOp r -> SValue r -> SValue r
unExpr forall (r :: * -> *). UnaryOpSym r => VSUnOp r
ceilOp

instance BooleanExpression PythonCode where
  ?! :: SValue PythonCode -> SValue PythonCode
(?!) = forall (r :: * -> *).
RenderSym r =>
VSUnOp r -> VSType r -> SValue r -> SValue r
typeUnExpr forall (r :: * -> *). UnaryOpSym r => VSUnOp r
notOp forall (r :: * -> *). TypeSym r => VSType r
bool
  ?&& :: SValue PythonCode -> SValue PythonCode -> SValue PythonCode
(?&&) = forall (r :: * -> *).
RenderSym r =>
VSBinOp r -> VSType r -> SValue r -> SValue r -> SValue r
typeBinExpr forall (r :: * -> *). BinaryOpSym r => VSBinOp r
andOp forall (r :: * -> *). TypeSym r => VSType r
bool
  ?|| :: SValue PythonCode -> SValue PythonCode -> SValue PythonCode
(?||) = forall (r :: * -> *).
RenderSym r =>
VSBinOp r -> VSType r -> SValue r -> SValue r -> SValue r
typeBinExpr forall (r :: * -> *). BinaryOpSym r => VSBinOp r
orOp forall (r :: * -> *). TypeSym r => VSType r
bool

instance Comparison PythonCode where
  ?< :: SValue PythonCode -> SValue PythonCode -> SValue PythonCode
(?<) = forall (r :: * -> *).
RenderSym r =>
VSBinOp r -> VSType r -> SValue r -> SValue r -> SValue r
typeBinExpr forall (r :: * -> *). BinaryOpSym r => VSBinOp r
lessOp forall (r :: * -> *). TypeSym r => VSType r
bool
  ?<= :: SValue PythonCode -> SValue PythonCode -> SValue PythonCode
(?<=) = forall (r :: * -> *).
RenderSym r =>
VSBinOp r -> VSType r -> SValue r -> SValue r -> SValue r
typeBinExpr forall (r :: * -> *). BinaryOpSym r => VSBinOp r
lessEqualOp forall (r :: * -> *). TypeSym r => VSType r
bool
  ?> :: SValue PythonCode -> SValue PythonCode -> SValue PythonCode
(?>) = forall (r :: * -> *).
RenderSym r =>
VSBinOp r -> VSType r -> SValue r -> SValue r -> SValue r
typeBinExpr forall (r :: * -> *). BinaryOpSym r => VSBinOp r
greaterOp forall (r :: * -> *). TypeSym r => VSType r
bool
  ?>= :: SValue PythonCode -> SValue PythonCode -> SValue PythonCode
(?>=) = forall (r :: * -> *).
RenderSym r =>
VSBinOp r -> VSType r -> SValue r -> SValue r -> SValue r
typeBinExpr forall (r :: * -> *). BinaryOpSym r => VSBinOp r
greaterEqualOp forall (r :: * -> *). TypeSym r => VSType r
bool
  ?== :: SValue PythonCode -> SValue PythonCode -> SValue PythonCode
(?==) = forall (r :: * -> *).
RenderSym r =>
VSBinOp r -> VSType r -> SValue r -> SValue r -> SValue r
typeBinExpr forall (r :: * -> *). BinaryOpSym r => VSBinOp r
equalOp forall (r :: * -> *). TypeSym r => VSType r
bool
  ?!= :: SValue PythonCode -> SValue PythonCode -> SValue PythonCode
(?!=) = forall (r :: * -> *).
RenderSym r =>
VSBinOp r -> VSType r -> SValue r -> SValue r -> SValue r
typeBinExpr forall (r :: * -> *). BinaryOpSym r => VSBinOp r
notEqualOp forall (r :: * -> *). TypeSym r => VSType r
bool

instance ValueExpression PythonCode where
  inlineIf :: SValue PythonCode
-> SValue PythonCode -> SValue PythonCode -> SValue PythonCode
inlineIf = forall (r :: * -> *).
RenderSym r =>
SValue r -> SValue r -> SValue r -> SValue r
pyInlineIf

  funcAppMixedArgs :: MixedCall PythonCode
funcAppMixedArgs = forall (r :: * -> *). RenderSym r => MixedCall r
G.funcAppMixedArgs
  selfFuncAppMixedArgs :: MixedCall PythonCode
selfFuncAppMixedArgs = forall (r :: * -> *).
RenderSym r =>
Doc -> SVariable r -> MixedCall r
G.selfFuncAppMixedArgs Doc
dot forall (r :: * -> *). VariableSym r => SVariable r
self
  extFuncAppMixedArgs :: String -> MixedCall PythonCode
extFuncAppMixedArgs String
l String
n VSType PythonCode
t [SValue PythonCode]
ps NamedArgs PythonCode
ns = do
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (String -> ValueState -> ValueState
addModuleImportVS String
l)
    forall (r :: * -> *). RenderSym r => String -> MixedCall r
CP.extFuncAppMixedArgs String
l String
n VSType PythonCode
t [SValue PythonCode]
ps NamedArgs PythonCode
ns
  libFuncAppMixedArgs :: String -> MixedCall PythonCode
libFuncAppMixedArgs String
l String
n VSType PythonCode
t [SValue PythonCode]
ps NamedArgs PythonCode
ns = do
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (String -> ValueState -> ValueState
addLibImportVS String
l)
    forall (r :: * -> *). RenderSym r => String -> MixedCall r
CP.extFuncAppMixedArgs String
l String
n VSType PythonCode
t [SValue PythonCode]
ps NamedArgs PythonCode
ns
  newObjMixedArgs :: MixedCtorCall PythonCode
newObjMixedArgs = forall (r :: * -> *). RenderSym r => MixedCall r
G.newObjMixedArgs String
""
  extNewObjMixedArgs :: MixedCall PythonCode
extNewObjMixedArgs String
l VSType PythonCode
tp [SValue PythonCode]
ps NamedArgs PythonCode
ns = do
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (String -> ValueState -> ValueState
addModuleImportVS String
l)
    forall (r :: * -> *). RenderSym r => MixedCall r
pyExtNewObjMixedArgs String
l VSType PythonCode
tp [SValue PythonCode]
ps NamedArgs PythonCode
ns
  libNewObjMixedArgs :: MixedCall PythonCode
libNewObjMixedArgs String
l VSType PythonCode
tp [SValue PythonCode]
ps NamedArgs PythonCode
ns = do
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (String -> ValueState -> ValueState
addLibImportVS String
l)
    forall (r :: * -> *). RenderSym r => MixedCall r
pyExtNewObjMixedArgs String
l VSType PythonCode
tp [SValue PythonCode]
ps NamedArgs PythonCode
ns

  lambda :: [SVariable PythonCode] -> SValue PythonCode -> SValue PythonCode
lambda = forall (r :: * -> *).
RenderSym r =>
([r (Variable r)] -> r (Value r) -> Doc)
-> [SVariable r] -> SValue r -> SValue r
G.lambda forall (r :: * -> *).
RenderSym r =>
[r (Variable r)] -> r (Value r) -> Doc
pyLambda

  notNull :: SValue PythonCode -> SValue PythonCode
notNull = forall (r :: * -> *). RenderSym r => String -> SValue r -> SValue r
CP.notNull String
pyNull

instance RenderValue PythonCode where
  inputFunc :: SValue PythonCode
inputFunc = forall (r :: * -> *). RenderSym r => VSType r -> Doc -> SValue r
mkStateVal forall (r :: * -> *). TypeSym r => VSType r
string Doc
pyInputFunc
  printFunc :: SValue PythonCode
printFunc = forall (r :: * -> *). RenderSym r => VSType r -> Doc -> SValue r
mkStateVal forall (r :: * -> *). TypeSym r => VSType r
void Doc
pyPrintFunc
  printLnFunc :: SValue PythonCode
printLnFunc = forall (r :: * -> *). RenderSym r => VSType r -> Doc -> SValue r
mkStateVal forall (r :: * -> *). TypeSym r => VSType r
void Doc
empty
  printFileFunc :: SValue PythonCode -> SValue PythonCode
printFileFunc SValue PythonCode
_ = forall (r :: * -> *). RenderSym r => VSType r -> Doc -> SValue r
mkStateVal forall (r :: * -> *). TypeSym r => VSType r
void Doc
empty
  printFileLnFunc :: SValue PythonCode -> SValue PythonCode
printFileLnFunc SValue PythonCode
_ = forall (r :: * -> *). RenderSym r => VSType r -> Doc -> SValue r
mkStateVal forall (r :: * -> *). TypeSym r => VSType r
void Doc
empty
  
  cast :: VSType PythonCode -> SValue PythonCode -> SValue PythonCode
cast = forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> m c) -> m a -> m b -> m c
on2StateWrapped (\PythonCode TypeData
t PythonCode ValData
v-> forall (r :: * -> *). RenderSym r => r (Type r) -> Doc -> SValue r
mkVal PythonCode TypeData
t forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Doc -> Doc
R.castObj (forall (r :: * -> *). InternalTypeElim r => r (Type r) -> Doc
RC.type' PythonCode TypeData
t) 
    forall a b. (a -> b) -> a -> b
$ forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value PythonCode ValData
v)
  
  call :: Maybe String -> Maybe Doc -> MixedCall PythonCode
call = forall (r :: * -> *).
RenderSym r =>
Doc -> Maybe String -> Maybe Doc -> MixedCall r
G.call Doc
pyNamedArgSep

  valFromData :: Maybe Int -> VSType PythonCode -> Doc -> SValue PythonCode
valFromData Maybe Int
p VSType PythonCode
t' Doc
d = do 
    PythonCode TypeData
t <- VSType PythonCode
t'
    forall a s. a -> State s a
toState forall a b. (a -> b) -> a -> b
$ forall (r :: * -> *) a b c.
Applicative r =>
(a -> b -> c) -> r a -> r b -> r c
on2CodeValues (Maybe Int -> TypeData -> Doc -> ValData
vd Maybe Int
p) PythonCode TypeData
t (forall (r :: * -> *) a. Monad r => a -> r a
toCode Doc
d)

instance ValueElim PythonCode where
  valuePrec :: PythonCode (Value PythonCode) -> Maybe Int
valuePrec = ValData -> Maybe Int
valPrec forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. PythonCode a -> a
unPC
  value :: PythonCode (Value PythonCode) -> Doc
value = ValData -> Doc
val forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. PythonCode a -> a
unPC

instance InternalValueExp PythonCode where
  objMethodCallMixedArgs' :: String
-> VSType PythonCode
-> SValue PythonCode
-> [SValue PythonCode]
-> NamedArgs PythonCode
-> SValue PythonCode
objMethodCallMixedArgs' = forall (r :: * -> *).
RenderSym r =>
String
-> VSType r -> SValue r -> [SValue r] -> NamedArgs r -> SValue r
G.objMethodCall

instance FunctionSym PythonCode where
  type Function PythonCode = FuncData
  func :: String
-> VSType PythonCode
-> [SValue PythonCode]
-> VSFunction PythonCode
func = forall (r :: * -> *).
RenderSym r =>
String -> VSType r -> [SValue r] -> VSFunction r
G.func
  objAccess :: SValue PythonCode -> VSFunction PythonCode -> SValue PythonCode
objAccess = forall (r :: * -> *).
RenderSym r =>
SValue r -> VSFunction r -> SValue r
G.objAccess

instance GetSet PythonCode where
  get :: SValue PythonCode -> SVariable PythonCode -> SValue PythonCode
get = forall (r :: * -> *).
RenderSym r =>
SValue r -> SVariable r -> SValue r
G.get
  set :: SValue PythonCode
-> SVariable PythonCode -> SValue PythonCode -> SValue PythonCode
set = forall (r :: * -> *).
RenderSym r =>
SValue r -> SVariable r -> SValue r -> SValue r
G.set

instance List PythonCode where
  listSize :: SValue PythonCode -> SValue PythonCode
listSize = forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> m c) -> m a -> m b -> m c
on2StateWrapped(\PythonCode FuncData
f PythonCode ValData
v-> forall (r :: * -> *). RenderSym r => r (Type r) -> Doc -> SValue r
mkVal (forall (r :: * -> *).
FunctionElim r =>
r (Function r) -> r (Type r)
functionType PythonCode FuncData
f) 
    (Doc -> Doc -> Doc
pyListSize (forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value PythonCode ValData
v) (forall (r :: * -> *). FunctionElim r => r (Function r) -> Doc
RC.function PythonCode FuncData
f))) forall (r :: * -> *). InternalListFunc r => VSFunction r
listSizeFunc
  listAdd :: SValue PythonCode
-> SValue PythonCode -> SValue PythonCode -> SValue PythonCode
listAdd = forall (r :: * -> *).
RenderSym r =>
SValue r -> SValue r -> SValue r -> SValue r
G.listAdd
  listAppend :: SValue PythonCode -> SValue PythonCode -> SValue PythonCode
listAppend = forall (r :: * -> *).
RenderSym r =>
SValue r -> SValue r -> SValue r
G.listAppend
  listAccess :: SValue PythonCode -> SValue PythonCode -> SValue PythonCode
listAccess = forall (r :: * -> *).
RenderSym r =>
SValue r -> SValue r -> SValue r
G.listAccess
  listSet :: SValue PythonCode
-> SValue PythonCode -> SValue PythonCode -> SValue PythonCode
listSet = forall (r :: * -> *).
RenderSym r =>
SValue r -> SValue r -> SValue r -> SValue r
G.listSet
  indexOf :: SValue PythonCode -> SValue PythonCode -> SValue PythonCode
indexOf = forall (r :: * -> *).
RenderSym r =>
String -> SValue r -> SValue r -> SValue r
CP.indexOf String
pyIndex

instance InternalList PythonCode where
  listSlice' :: Maybe (SValue PythonCode)
-> Maybe (SValue PythonCode)
-> Maybe (SValue PythonCode)
-> SVariable PythonCode
-> SValue PythonCode
-> MSBlock PythonCode
listSlice' Maybe (SValue PythonCode)
b Maybe (SValue PythonCode)
e Maybe (SValue PythonCode)
s SVariable PythonCode
vn SValue PythonCode
vo = forall (r :: * -> *).
(RenderSym r, Monad r) =>
SVariable r
-> SValue r -> SValue r -> SValue r -> SValue r -> MS (r Doc)
pyListSlice SVariable PythonCode
vn SValue PythonCode
vo (Maybe (SValue PythonCode) -> SValue PythonCode
getVal Maybe (SValue PythonCode)
b) (Maybe (SValue PythonCode) -> SValue PythonCode
getVal Maybe (SValue PythonCode)
e) (Maybe (SValue PythonCode) -> SValue PythonCode
getVal Maybe (SValue PythonCode)
s)
    where getVal :: Maybe (SValue PythonCode) -> SValue PythonCode
getVal = forall a. a -> Maybe a -> a
fromMaybe (forall (r :: * -> *). RenderSym r => VSType r -> Doc -> SValue r
mkStateVal forall (r :: * -> *). TypeSym r => VSType r
void Doc
empty)

instance InternalGetSet PythonCode where
  getFunc :: SVariable PythonCode -> VSFunction PythonCode
getFunc = forall (r :: * -> *). RenderSym r => SVariable r -> VSFunction r
G.getFunc
  setFunc :: VSType PythonCode
-> SVariable PythonCode
-> SValue PythonCode
-> VSFunction PythonCode
setFunc = forall (r :: * -> *).
RenderSym r =>
VSType r -> SVariable r -> SValue r -> VSFunction r
G.setFunc

instance InternalListFunc PythonCode where
  listSizeFunc :: VSFunction PythonCode
listSizeFunc = forall (r :: * -> *).
RenderFunction r =>
Doc -> VSType r -> VSFunction r
funcFromData Doc
pyListSizeFunc forall (r :: * -> *). TypeSym r => VSType r
int
  listAddFunc :: SValue PythonCode
-> SValue PythonCode -> SValue PythonCode -> VSFunction PythonCode
listAddFunc SValue PythonCode
_ = forall (r :: * -> *).
RenderSym r =>
String -> SValue r -> SValue r -> VSFunction r
CP.listAddFunc String
pyInsert
  listAppendFunc :: SValue PythonCode -> VSFunction PythonCode
listAppendFunc = forall (r :: * -> *).
RenderSym r =>
String -> SValue r -> VSFunction r
G.listAppendFunc String
pyAppendFunc
  listAccessFunc :: VSType PythonCode -> SValue PythonCode -> VSFunction PythonCode
listAccessFunc = forall (r :: * -> *).
RenderSym r =>
VSType r -> SValue r -> VSFunction r
CP.listAccessFunc
  listSetFunc :: SValue PythonCode
-> SValue PythonCode -> SValue PythonCode -> VSFunction PythonCode
listSetFunc = forall (r :: * -> *).
RenderSym r =>
(Doc -> Doc -> Doc)
-> SValue r -> SValue r -> SValue r -> VSFunction r
CP.listSetFunc Doc -> Doc -> Doc
R.listSetFunc

instance ThunkSym PythonCode where
  type Thunk PythonCode = CommonThunk VS

instance ThunkAssign PythonCode where
  thunkAssign :: SVariable PythonCode
-> VSThunk PythonCode -> MSStatement PythonCode
thunkAssign SVariable PythonCode
v VSThunk PythonCode
t = do
    String
iName <- MS String
genLoopIndex
    let
      i :: SVariable PythonCode
i = forall (r :: * -> *).
VariableSym r =>
String -> VSType r -> SVariable r
var String
iName forall (r :: * -> *). TypeSym r => VSType r
int
      dim :: StateT ValueState Identity (PythonCode ValData)
dim = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ VSThunk PythonCode
t forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (s :: * -> *).
(s ValData -> s ValData) -> CommonThunk s -> s ValData
commonThunkDim (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. PythonCode a -> a
unPC forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (r :: * -> *). List r => SValue r -> SValue r
listSize forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (f :: * -> *) a. Applicative f => a -> f a
pure) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. PythonCode a -> a
unPC
      loopInit :: MSStatement PythonCode
loopInit = 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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. PythonCode a -> a
unPC VSThunk PythonCode
t) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (s :: * -> *) a.
(CommonThunk s -> a) -> (CommonThunk s -> a) -> CommonThunk s -> a
commonThunkElim
        (forall a b. a -> b -> a
const forall (r :: * -> *). RenderStatement r => MSStatement r
emptyStmt) (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (r :: * -> *).
AssignStatement r =>
SVariable r -> SValue r -> MSStatement r
assign SVariable PythonCode
v forall a b. (a -> b) -> a -> b
$ forall (r :: * -> *).
(TypeElim r, Literal r) =>
VSType r -> SValue r
litZero forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (r :: * -> *).
VariableElim r =>
r (Variable r) -> r (Type r)
variableType SVariable PythonCode
v)
      loopBody :: MSStatement PythonCode
loopBody = 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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. PythonCode a -> a
unPC VSThunk PythonCode
t) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (s :: * -> *) a.
(CommonThunk s -> a) -> (CommonThunk s -> a) -> CommonThunk s -> a
commonThunkElim
        (forall (r :: * -> *). StatementSym r => SValue r -> MSStatement r
valStmt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (r :: * -> *).
List r =>
SValue r -> SValue r -> SValue r -> SValue r
listSet (forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
valueOf SVariable PythonCode
v) (forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
valueOf SVariable PythonCode
i) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (r :: * -> *).
VectorExpression r =>
SValue r -> VSThunk r -> SValue r
vecIndex (forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
valueOf SVariable PythonCode
i) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure)
        ((SVariable PythonCode
v forall (r :: * -> *).
AssignStatement r =>
SVariable r -> SValue r -> MSStatement r
&+=) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (r :: * -> *).
VectorExpression r =>
SValue r -> VSThunk r -> SValue r
vecIndex (forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
valueOf SVariable PythonCode
i) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure)
    forall (r :: * -> *).
StatementSym r =>
[MSStatement r] -> MSStatement r
multi [MSStatement PythonCode
loopInit,
      forall (r :: * -> *).
ControlStatement r =>
SVariable r
-> SValue r -> SValue r -> SValue r -> MSBody r -> MSStatement r
forRange SVariable PythonCode
i (forall (r :: * -> *). Literal r => Integer -> SValue r
litInt Integer
0) StateT ValueState Identity (PythonCode ValData)
dim (forall (r :: * -> *). Literal r => Integer -> SValue r
litInt Integer
1) forall a b. (a -> b) -> a -> b
$ forall (r :: * -> *). BodySym r => [MSBlock r] -> MSBody r
body [forall (r :: * -> *). BlockSym r => [MSStatement r] -> MSBlock r
block [MSStatement PythonCode
loopBody]]]

instance VectorType PythonCode where
  vecType :: VSType PythonCode -> VSType PythonCode
vecType = forall (r :: * -> *). TypeSym r => VSType r -> VSType r
listType

instance VectorDecl PythonCode where
  vecDec :: Integer -> SVariable PythonCode -> MSStatement PythonCode
vecDec = forall (r :: * -> *).
DeclStatement r =>
Integer -> SVariable r -> MSStatement r
listDec
  vecDecDef :: SVariable PythonCode
-> [SValue PythonCode] -> MSStatement PythonCode
vecDecDef = forall (r :: * -> *).
DeclStatement r =>
SVariable r -> [SValue r] -> MSStatement r
listDecDef

instance VectorThunk PythonCode where
  vecThunk :: SVariable PythonCode -> VSThunk PythonCode
vecThunk = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (s :: * -> *). s ValData -> CommonThunk s
pureValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. PythonCode a -> a
unPC forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
valueOf

instance VectorExpression PythonCode where
  vecScale :: SValue PythonCode -> VSThunk PythonCode -> VSThunk PythonCode
vecScale SValue PythonCode
k = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a -> b) -> a -> b
$ forall (s :: * -> *).
(s ValData -> s ValData) -> CommonThunk s -> CommonThunk s
vectorize (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. PythonCode a -> a
unPC forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SValue PythonCode
k forall (r :: * -> *).
NumericExpression r =>
SValue r -> SValue r -> SValue r
#*) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (f :: * -> *) a. Applicative f => a -> f a
pure)
  vecAdd :: VSThunk PythonCode -> VSThunk PythonCode -> VSThunk PythonCode
vecAdd = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a b. (a -> b) -> a -> b
$ forall (s :: * -> *).
(s ValData -> s ValData -> s ValData)
-> CommonThunk s -> CommonThunk s -> CommonThunk s
vectorize2 (\StateT ValueState Identity ValData
v1 StateT ValueState Identity ValData
v2 -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. PythonCode a -> a
unPC forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (f :: * -> *) a. Applicative f => a -> f a
pure StateT ValueState Identity ValData
v1 forall (r :: * -> *).
NumericExpression r =>
SValue r -> SValue r -> SValue r
#+ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (f :: * -> *) a. Applicative f => a -> f a
pure StateT ValueState Identity ValData
v2)
  vecIndex :: SValue PythonCode -> VSThunk PythonCode -> SValue PythonCode
vecIndex SValue PythonCode
i = (forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (s :: * -> *).
(s ValData -> s ValData) -> CommonThunk s -> s ValData
commonVecIndex (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. PythonCode a -> a
unPC forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (r :: * -> *). List r => SValue r -> SValue r -> SValue r
listAccess SValue PythonCode
i forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (f :: * -> *) a. Applicative f => a -> f a
pure) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. PythonCode a -> a
unPC)
  vecDot :: VSThunk PythonCode -> VSThunk PythonCode -> VSThunk PythonCode
vecDot = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (s :: * -> *). CommonThunk s -> CommonThunk s
sumComponents forall (r :: * -> *) a b. Functor r => (a -> b) -> r a -> r b
<$> forall (s :: * -> *).
(s ValData -> s ValData -> s ValData)
-> CommonThunk s -> CommonThunk s -> CommonThunk s
vectorize2 (\StateT ValueState Identity ValData
v1 StateT ValueState Identity ValData
v2 -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. PythonCode a -> a
unPC forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (f :: * -> *) a. Applicative f => a -> f a
pure StateT ValueState Identity ValData
v1 forall (r :: * -> *).
NumericExpression r =>
SValue r -> SValue r -> SValue r
#* forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (f :: * -> *) a. Applicative f => a -> f a
pure StateT ValueState Identity ValData
v2)

instance RenderFunction PythonCode where
  funcFromData :: Doc -> VSType PythonCode -> VSFunction PythonCode
funcFromData Doc
d = forall a b s. (a -> b) -> State s a -> State s b
onStateValue (forall (r :: * -> *) a b. Functor r => (a -> b) -> r a -> r b
onCodeValue (TypeData -> Doc -> FuncData
`fd` Doc
d))
  
instance FunctionElim PythonCode where
  functionType :: PythonCode (Function PythonCode) -> PythonCode (Type PythonCode)
functionType = forall (r :: * -> *) a b. Functor r => (a -> b) -> r a -> r b
onCodeValue FuncData -> TypeData
fType
  function :: PythonCode (Function PythonCode) -> Doc
function = FuncData -> Doc
funcDoc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. PythonCode a -> a
unPC

instance InternalAssignStmt PythonCode where
  multiAssign :: [SVariable PythonCode]
-> [SValue PythonCode] -> MSStatement PythonCode
multiAssign = forall (r :: * -> *).
RenderSym r =>
(Doc -> Doc) -> [SVariable r] -> [SValue r] -> MSStatement r
CP.multiAssign forall a. a -> a
id

instance InternalIOStmt PythonCode where
  printSt :: Bool
-> Maybe (SValue PythonCode)
-> SValue PythonCode
-> SValue PythonCode
-> MSStatement PythonCode
printSt = Bool
-> Maybe (SValue PythonCode)
-> SValue PythonCode
-> SValue PythonCode
-> MSStatement PythonCode
pyPrint

instance InternalControlStmt PythonCode where
  multiReturn :: [SValue PythonCode] -> MSStatement PythonCode
multiReturn = forall (r :: * -> *).
RenderSym r =>
(Doc -> Doc) -> [SValue r] -> MSStatement r
CP.multiReturn forall a. a -> a
id

instance RenderStatement PythonCode where
  stmt :: MSStatement PythonCode -> MSStatement PythonCode
stmt = forall (r :: * -> *). RenderSym r => MSStatement r -> MSStatement r
G.stmt
  loopStmt :: MSStatement PythonCode -> MSStatement PythonCode
loopStmt = forall (r :: * -> *). RenderSym r => MSStatement r -> MSStatement r
G.loopStmt
  
  emptyStmt :: MSStatement PythonCode
emptyStmt = forall (r :: * -> *). RenderSym r => MSStatement r
G.emptyStmt

  stmtFromData :: Doc -> Terminator -> MSStatement PythonCode
stmtFromData Doc
d Terminator
t = forall a s. a -> State s a
toState forall a b. (a -> b) -> a -> b
$ forall (r :: * -> *) a. Monad r => a -> r a
toCode (Doc
d, Terminator
t)

instance StatementElim PythonCode where
  statement :: PythonCode (Statement PythonCode) -> Doc
statement = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. PythonCode a -> a
unPC
  statementTerm :: PythonCode (Statement PythonCode) -> Terminator
statementTerm = forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. PythonCode a -> a
unPC

instance StatementSym PythonCode where
  -- Terminator determines how statements end
  type Statement PythonCode = (Doc, Terminator)
  valStmt :: SValue PythonCode -> MSStatement PythonCode
valStmt = forall (r :: * -> *).
RenderSym r =>
Terminator -> SValue r -> MSStatement r
G.valStmt Terminator
Empty
  multi :: [MSStatement PythonCode] -> MSStatement PythonCode
multi = forall a b s. ([a] -> b) -> [State s a] -> State s b
onStateList (forall (m :: * -> *) a b. Monad m => ([a] -> b) -> [m a] -> m b
onCodeList [(Doc, Terminator)] -> (Doc, Terminator)
R.multiStmt)

instance AssignStatement PythonCode where
  assign :: SVariable PythonCode -> SValue PythonCode -> MSStatement PythonCode
assign = forall (r :: * -> *).
RenderSym r =>
Terminator -> SVariable r -> SValue r -> MSStatement r
G.assign Terminator
Empty
  &-= :: SVariable PythonCode -> SValue PythonCode -> MSStatement PythonCode
(&-=) = forall (r :: * -> *).
RenderSym r =>
Terminator -> SVariable r -> SValue r -> MSStatement r
G.subAssign Terminator
Empty
  &+= :: SVariable PythonCode -> SValue PythonCode -> MSStatement PythonCode
(&+=) = forall (r :: * -> *).
RenderSym r =>
SVariable r -> SValue r -> MSStatement r
G.increment
  &++ :: SVariable PythonCode -> MSStatement PythonCode
(&++) = forall (r :: * -> *). RenderSym r => SVariable r -> MSStatement r
M.increment1
  &-- :: SVariable PythonCode -> MSStatement PythonCode
(&--) = forall (r :: * -> *). RenderSym r => SVariable r -> MSStatement r
M.decrement1

instance DeclStatement PythonCode where
  varDec :: SVariable PythonCode -> MSStatement PythonCode
varDec SVariable PythonCode
v = do
    PythonCode VarData
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 PythonCode
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 PythonCode VarData
v')
    forall (r :: * -> *). RenderSym r => Doc -> MSStatement r
mkStmtNoEnd Doc
empty
  varDecDef :: SVariable PythonCode -> SValue PythonCode -> MSStatement PythonCode
varDecDef SVariable PythonCode
v SValue PythonCode
e = do
    PythonCode VarData
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 PythonCode
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 PythonCode VarData
v')
    forall (r :: * -> *).
AssignStatement r =>
SVariable r -> SValue r -> MSStatement r
assign SVariable PythonCode
v SValue PythonCode
e
  listDec :: Integer -> SVariable PythonCode -> MSStatement PythonCode
listDec Integer
_ = forall (r :: * -> *). RenderSym r => SVariable r -> MSStatement r
CP.listDec
  listDecDef :: SVariable PythonCode
-> [SValue PythonCode] -> MSStatement PythonCode
listDecDef = forall (r :: * -> *).
RenderSym r =>
SVariable r -> [SValue r] -> MSStatement r
CP.listDecDef
  arrayDec :: Integer -> SVariable PythonCode -> MSStatement PythonCode
arrayDec = forall (r :: * -> *).
DeclStatement r =>
Integer -> SVariable r -> MSStatement r
listDec
  arrayDecDef :: SVariable PythonCode
-> [SValue PythonCode] -> MSStatement PythonCode
arrayDecDef = forall (r :: * -> *).
DeclStatement r =>
SVariable r -> [SValue r] -> MSStatement r
listDecDef
  objDecDef :: SVariable PythonCode -> SValue PythonCode -> MSStatement PythonCode
objDecDef = forall (r :: * -> *).
DeclStatement r =>
SVariable r -> SValue r -> MSStatement r
varDecDef
  objDecNew :: SVariable PythonCode
-> [SValue PythonCode] -> MSStatement PythonCode
objDecNew = forall (r :: * -> *).
RenderSym r =>
SVariable r -> [SValue r] -> MSStatement r
G.objDecNew
  extObjDecNew :: String
-> SVariable PythonCode
-> [SValue PythonCode]
-> MSStatement PythonCode
extObjDecNew String
lib SVariable PythonCode
v [SValue PythonCode]
vs = do
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (String -> MethodState -> MethodState
addModuleImport String
lib)
    forall (r :: * -> *).
DeclStatement r =>
SVariable r -> SValue r -> MSStatement r
varDecDef SVariable PythonCode
v (forall (r :: * -> *). ValueExpression r => String -> PosCtorCall r
extNewObj String
lib (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 PythonCode
v) [SValue PythonCode]
vs)
  constDecDef :: SVariable PythonCode -> SValue PythonCode -> MSStatement PythonCode
constDecDef = forall (r :: * -> *).
DeclStatement r =>
SVariable r -> SValue r -> MSStatement r
varDecDef
  funcDecDef :: SVariable PythonCode
-> [SVariable PythonCode]
-> MSBody PythonCode
-> MSStatement PythonCode
funcDecDef = forall (r :: * -> *).
RenderSym r =>
SVariable r -> [SVariable r] -> MSBody r -> MSStatement r
CP.funcDecDef

instance IOStatement PythonCode where
  print :: SValue PythonCode -> MSStatement PythonCode
print      = forall (r :: * -> *).
RenderSym r =>
Bool -> Maybe (SValue r) -> SValue r -> SValue r -> MSStatement r
pyOut Bool
False forall a. Maybe a
Nothing forall (r :: * -> *). RenderValue r => SValue r
printFunc
  printLn :: SValue PythonCode -> MSStatement PythonCode
printLn    = forall (r :: * -> *).
RenderSym r =>
Bool -> Maybe (SValue r) -> SValue r -> SValue r -> MSStatement r
pyOut Bool
True  forall a. Maybe a
Nothing forall (r :: * -> *). RenderValue r => SValue r
printFunc
  printStr :: String -> MSStatement PythonCode
printStr   = forall (r :: * -> *). IOStatement r => SValue r -> MSStatement r
print   forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (r :: * -> *). Literal r => String -> SValue r
litString
  printStrLn :: String -> MSStatement PythonCode
printStrLn = forall (r :: * -> *). IOStatement r => SValue r -> MSStatement r
printLn forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (r :: * -> *). Literal r => String -> SValue r
litString

  printFile :: SValue PythonCode -> SValue PythonCode -> MSStatement PythonCode
printFile SValue PythonCode
f      = forall (r :: * -> *).
RenderSym r =>
Bool -> Maybe (SValue r) -> SValue r -> SValue r -> MSStatement r
pyOut Bool
False (forall a. a -> Maybe a
Just SValue PythonCode
f) forall (r :: * -> *). RenderValue r => SValue r
printFunc
  printFileLn :: SValue PythonCode -> SValue PythonCode -> MSStatement PythonCode
printFileLn SValue PythonCode
f    = forall (r :: * -> *).
RenderSym r =>
Bool -> Maybe (SValue r) -> SValue r -> SValue r -> MSStatement r
pyOut Bool
True  (forall a. a -> Maybe a
Just SValue PythonCode
f) forall (r :: * -> *). RenderValue r => SValue r
printFunc
  printFileStr :: SValue PythonCode -> String -> MSStatement PythonCode
printFileStr SValue PythonCode
f   = forall (r :: * -> *).
IOStatement r =>
SValue r -> SValue r -> MSStatement r
printFile SValue PythonCode
f   forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (r :: * -> *). Literal r => String -> SValue r
litString
  printFileStrLn :: SValue PythonCode -> String -> MSStatement PythonCode
printFileStrLn SValue PythonCode
f = forall (r :: * -> *).
IOStatement r =>
SValue r -> SValue r -> MSStatement r
printFileLn SValue PythonCode
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (r :: * -> *). Literal r => String -> SValue r
litString

  getInput :: SVariable PythonCode -> MSStatement PythonCode
getInput = SValue PythonCode -> SVariable PythonCode -> MSStatement PythonCode
pyInput forall (r :: * -> *). RenderValue r => SValue r
inputFunc
  discardInput :: MSStatement PythonCode
discardInput = forall (r :: * -> *). StatementSym r => SValue r -> MSStatement r
valStmt forall (r :: * -> *). RenderValue r => SValue r
inputFunc
  getFileInput :: SValue PythonCode -> SVariable PythonCode -> MSStatement PythonCode
getFileInput SValue PythonCode
f = SValue PythonCode -> SVariable PythonCode -> MSStatement PythonCode
pyInput (forall (r :: * -> *). RenderSym r => SValue r -> SValue r
readline SValue PythonCode
f)
  discardFileInput :: SValue PythonCode -> MSStatement PythonCode
discardFileInput SValue PythonCode
f = forall (r :: * -> *). StatementSym r => SValue r -> MSStatement r
valStmt (forall (r :: * -> *). RenderSym r => SValue r -> SValue r
readline SValue PythonCode
f)

  openFileR :: SVariable PythonCode -> SValue PythonCode -> MSStatement PythonCode
openFileR SVariable PythonCode
f SValue PythonCode
n = SVariable PythonCode
f forall (r :: * -> *).
AssignStatement r =>
SVariable r -> SValue r -> MSStatement r
&= forall (r :: * -> *). RenderSym r => SValue r -> SValue r
openRead SValue PythonCode
n
  openFileW :: SVariable PythonCode -> SValue PythonCode -> MSStatement PythonCode
openFileW SVariable PythonCode
f SValue PythonCode
n = SVariable PythonCode
f forall (r :: * -> *).
AssignStatement r =>
SVariable r -> SValue r -> MSStatement r
&= forall (r :: * -> *). RenderSym r => SValue r -> SValue r
openWrite SValue PythonCode
n
  openFileA :: SVariable PythonCode -> SValue PythonCode -> MSStatement PythonCode
openFileA SVariable PythonCode
f SValue PythonCode
n = SVariable PythonCode
f forall (r :: * -> *).
AssignStatement r =>
SVariable r -> SValue r -> MSStatement r
&= forall (r :: * -> *). RenderSym r => SValue r -> SValue r
openAppend SValue PythonCode
n
  closeFile :: SValue PythonCode -> MSStatement PythonCode
closeFile = forall (r :: * -> *).
RenderSym r =>
String -> SValue r -> MSStatement r
G.closeFile String
pyClose

  getFileInputLine :: SValue PythonCode -> SVariable PythonCode -> MSStatement PythonCode
getFileInputLine = forall (r :: * -> *).
IOStatement r =>
SValue r -> SVariable r -> MSStatement r
getFileInput
  discardFileLine :: SValue PythonCode -> MSStatement PythonCode
discardFileLine = forall (r :: * -> *).
RenderSym r =>
String -> SValue r -> MSStatement r
CP.discardFileLine String
pyReadline
  getFileInputAll :: SValue PythonCode -> SVariable PythonCode -> MSStatement PythonCode
getFileInputAll SValue PythonCode
f SVariable PythonCode
v = SVariable PythonCode
v forall (r :: * -> *).
AssignStatement r =>
SVariable r -> SValue r -> MSStatement r
&= forall (r :: * -> *). RenderSym r => SValue r -> SValue r
readlines SValue PythonCode
f
  
instance StringStatement PythonCode where
  stringSplit :: Char
-> SVariable PythonCode
-> SValue PythonCode
-> MSStatement PythonCode
stringSplit Char
d SVariable PythonCode
vnew SValue PythonCode
s = forall (r :: * -> *).
AssignStatement r =>
SVariable r -> SValue r -> MSStatement r
assign SVariable PythonCode
vnew (forall (r :: * -> *).
FunctionSym r =>
SValue r -> VSFunction r -> SValue r
objAccess SValue PythonCode
s (forall (r :: * -> *). RenderSym r => Char -> VSFunction r
splitFunc Char
d))

  stringListVals :: [SVariable PythonCode]
-> SValue PythonCode -> MSStatement PythonCode
stringListVals = forall (r :: * -> *).
RenderSym r =>
[SVariable r] -> SValue r -> MSStatement r
M.stringListVals
  stringListLists :: [SVariable PythonCode]
-> SValue PythonCode -> MSStatement PythonCode
stringListLists = forall (r :: * -> *).
RenderSym r =>
[SVariable r] -> SValue r -> MSStatement r
M.stringListLists

instance FuncAppStatement PythonCode where
  inOutCall :: InOutCall PythonCode
inOutCall = forall (r :: * -> *).
RenderSym r =>
(String -> VSType r -> [SValue r] -> SValue r)
-> String
-> [SValue r]
-> [SVariable r]
-> [SVariable r]
-> MSStatement r
CP.inOutCall forall (r :: * -> *). ValueExpression r => String -> PosCtorCall r
funcApp
  selfInOutCall :: InOutCall PythonCode
selfInOutCall = forall (r :: * -> *).
RenderSym r =>
(String -> VSType r -> [SValue r] -> SValue r)
-> String
-> [SValue r]
-> [SVariable r]
-> [SVariable r]
-> MSStatement r
CP.inOutCall forall (r :: * -> *). ValueExpression r => String -> PosCtorCall r
selfFuncApp
  extInOutCall :: String -> InOutCall PythonCode
extInOutCall String
m = forall (r :: * -> *).
RenderSym r =>
(String -> VSType r -> [SValue r] -> SValue r)
-> String
-> [SValue r]
-> [SVariable r]
-> [SVariable r]
-> MSStatement r
CP.inOutCall (forall (r :: * -> *). ValueExpression r => String -> PosCall r
extFuncApp String
m)

instance CommentStatement PythonCode where
  comment :: String -> MSStatement PythonCode
comment = forall (r :: * -> *). RenderSym r => Doc -> String -> MSStatement r
G.comment Doc
pyCommentStart

instance ControlStatement PythonCode where
  break :: MSStatement PythonCode
break = forall (r :: * -> *). RenderSym r => Doc -> MSStatement r
mkStmtNoEnd Doc
R.break
  continue :: MSStatement PythonCode
continue = forall (r :: * -> *). RenderSym r => Doc -> MSStatement r
mkStmtNoEnd Doc
R.continue

  returnStmt :: SValue PythonCode -> MSStatement PythonCode
returnStmt = forall (r :: * -> *).
RenderSym r =>
Terminator -> SValue r -> MSStatement r
G.returnStmt Terminator
Empty

  throw :: String -> MSStatement PythonCode
throw = forall (r :: * -> *).
RenderSym r =>
(r (Value r) -> Doc) -> Terminator -> String -> MSStatement r
G.throw forall (r :: * -> *). RenderSym r => r (Value r) -> Doc
pyThrow Terminator
Empty

  ifCond :: [(SValue PythonCode, MSBody PythonCode)]
-> MSBody PythonCode -> MSStatement PythonCode
ifCond = forall (r :: * -> *).
RenderSym r =>
(Doc -> Doc)
-> Doc
-> OptionalSpace
-> Doc
-> Doc
-> [(SValue r, MSBody r)]
-> MSBody r
-> MSStatement r
G.ifCond Doc -> Doc
parens Doc
pyBodyStart OptionalSpace
pySpace Doc
pyElseIf Doc
pyBodyEnd
  switch :: SValue PythonCode
-> [(SValue PythonCode, MSBody PythonCode)]
-> MSBody PythonCode
-> MSStatement PythonCode
switch = forall (r :: * -> *).
(ControlStatement r, Comparison r) =>
SValue r -> [(SValue r, MSBody r)] -> MSBody r -> MSStatement r
switchAsIf

  ifExists :: SValue PythonCode
-> MSBody PythonCode -> MSBody PythonCode -> MSStatement PythonCode
ifExists = forall (r :: * -> *).
RenderSym r =>
SValue r -> MSBody r -> MSBody r -> MSStatement r
M.ifExists

  for :: MSStatement PythonCode
-> SValue PythonCode
-> MSStatement PythonCode
-> MSBody PythonCode
-> MSStatement PythonCode
for MSStatement PythonCode
_ SValue PythonCode
_ MSStatement PythonCode
_ MSBody PythonCode
_ = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String -> String
CP.forLoopError String
pyName
  forRange :: SVariable PythonCode
-> SValue PythonCode
-> SValue PythonCode
-> SValue PythonCode
-> MSBody PythonCode
-> MSStatement PythonCode
forRange SVariable PythonCode
i SValue PythonCode
initv SValue PythonCode
finalv SValue PythonCode
stepv = forall (r :: * -> *).
ControlStatement r =>
SVariable r -> SValue r -> MSBody r -> MSStatement r
forEach SVariable PythonCode
i (forall (r :: * -> *).
RenderSym r =>
SValue r -> SValue r -> SValue r -> SValue r
range SValue PythonCode
initv SValue PythonCode
finalv SValue PythonCode
stepv)
  forEach :: SVariable PythonCode
-> SValue PythonCode -> MSBody PythonCode -> MSStatement PythonCode
forEach SVariable PythonCode
i' SValue PythonCode
v' MSBody PythonCode
b' = do
    PythonCode VarData
i <- 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 PythonCode
i'
    PythonCode ValData
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 PythonCode
v'
    PythonCode Doc
b <- MSBody PythonCode
b'
    forall (r :: * -> *). RenderSym r => Doc -> MSStatement r
mkStmtNoEnd (forall (r :: * -> *).
RenderSym r =>
r (Variable r) -> r (Value r) -> r (Body r) -> Doc
pyForEach PythonCode VarData
i PythonCode ValData
v PythonCode Doc
b)
  while :: SValue PythonCode -> MSBody PythonCode -> MSStatement PythonCode
while SValue PythonCode
v' MSBody PythonCode
b' = do 
    PythonCode ValData
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 PythonCode
v'
    PythonCode Doc
b <- MSBody PythonCode
b'
    forall (r :: * -> *). RenderSym r => Doc -> MSStatement r
mkStmtNoEnd (forall (r :: * -> *).
RenderSym r =>
r (Value r) -> r (Body r) -> Doc
pyWhile PythonCode ValData
v PythonCode Doc
b)

  tryCatch :: MSBody PythonCode -> MSBody PythonCode -> MSStatement PythonCode
tryCatch = forall (r :: * -> *).
RenderSym r =>
(r (Body r) -> r (Body r) -> Doc)
-> MSBody r -> MSBody r -> MSStatement r
G.tryCatch forall (r :: * -> *).
RenderSym r =>
r (Body r) -> r (Body r) -> Doc
pyTryCatch

instance StatePattern PythonCode where 
  checkState :: String
-> [(SValue PythonCode, MSBody PythonCode)]
-> MSBody PythonCode
-> MSStatement PythonCode
checkState = forall (r :: * -> *).
RenderSym r =>
String -> [(SValue r, MSBody r)] -> MSBody r -> MSStatement r
M.checkState

instance ObserverPattern PythonCode where
  notifyObservers :: VSFunction PythonCode
-> VSType PythonCode -> MSStatement PythonCode
notifyObservers = forall (r :: * -> *).
RenderSym r =>
VSFunction r -> VSType r -> MSStatement r
M.notifyObservers'

instance StrategyPattern PythonCode where
  runStrategy :: String
-> [(String, MSBody PythonCode)]
-> Maybe (SValue PythonCode)
-> Maybe (SVariable PythonCode)
-> MSBlock PythonCode
runStrategy = forall (r :: * -> *).
(RenderSym r, Monad r) =>
String
-> [(String, MSBody r)]
-> Maybe (SValue r)
-> Maybe (SVariable r)
-> MS (r Doc)
M.runStrategy

instance ScopeSym PythonCode where
  type Scope PythonCode = Doc
  private :: PythonCode (Scope PythonCode)
private = forall (r :: * -> *) a. Monad r => a -> r a
toCode Doc
empty
  public :: PythonCode (Scope PythonCode)
public = forall (r :: * -> *) a. Monad r => a -> r a
toCode Doc
empty

instance RenderScope PythonCode where
  scopeFromData :: ScopeTag -> Doc -> PythonCode (Scope PythonCode)
scopeFromData ScopeTag
_ = forall (r :: * -> *) a. Monad r => a -> r a
toCode

instance ScopeElim PythonCode where
  scope :: PythonCode (Scope PythonCode) -> Doc
scope = forall a. PythonCode a -> a
unPC

instance MethodTypeSym PythonCode where
  type MethodType PythonCode = TypeData
  mType :: VSType PythonCode -> MSMthdType PythonCode
mType = 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
  construct :: String -> MSMthdType PythonCode
construct = forall (r :: * -> *). RenderSym r => String -> MS (r (Type r))
G.construct

instance ParameterSym PythonCode where
  type Parameter PythonCode = ParamData
  param :: SVariable PythonCode -> MSParameter PythonCode
param = forall (r :: * -> *).
RenderSym r =>
(r (Variable r) -> Doc) -> SVariable r -> MSParameter r
G.param forall (r :: * -> *). InternalVarElim r => r (Variable r) -> Doc
RC.variable
  pointerParam :: SVariable PythonCode -> MSParameter PythonCode
pointerParam = forall (r :: * -> *).
ParameterSym r =>
SVariable r -> MSParameter r
param

instance RenderParam PythonCode where
  paramFromData :: SVariable PythonCode -> Doc -> MSParameter PythonCode
paramFromData SVariable PythonCode
v' Doc
d = do 
    PythonCode VarData
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 PythonCode
v'
    forall a s. a -> State s a
toState forall a b. (a -> b) -> a -> b
$ forall (r :: * -> *) a b c.
Applicative r =>
(a -> b -> c) -> r a -> r b -> r c
on2CodeValues VarData -> Doc -> ParamData
pd PythonCode VarData
v (forall (r :: * -> *) a. Monad r => a -> r a
toCode Doc
d)
  
instance ParamElim PythonCode where
  parameterName :: PythonCode (Parameter PythonCode) -> String
parameterName = forall (r :: * -> *). VariableElim r => r (Variable r) -> String
variableName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (r :: * -> *) a b. Functor r => (a -> b) -> r a -> r b
onCodeValue ParamData -> VarData
paramVar
  parameterType :: PythonCode (Parameter PythonCode) -> PythonCode (Type PythonCode)
parameterType = forall (r :: * -> *).
VariableElim r =>
r (Variable r) -> r (Type r)
variableType forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (r :: * -> *) a b. Functor r => (a -> b) -> r a -> r b
onCodeValue ParamData -> VarData
paramVar
  parameter :: PythonCode (Parameter PythonCode) -> Doc
parameter = ParamData -> Doc
paramDoc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. PythonCode a -> a
unPC

instance MethodSym PythonCode where
  type Method PythonCode = MethodData
  method :: String
-> PythonCode (Scope PythonCode)
-> PythonCode (Permanence PythonCode)
-> VSType PythonCode
-> [MSParameter PythonCode]
-> MSBody PythonCode
-> SMethod PythonCode
method = forall (r :: * -> *).
RenderSym r =>
String
-> r (Scope r)
-> r (Permanence r)
-> VSType r
-> [MSParameter r]
-> MSBody r
-> SMethod r
G.method
  getMethod :: SVariable PythonCode -> SMethod PythonCode
getMethod = forall (r :: * -> *). RenderSym r => SVariable r -> SMethod r
G.getMethod
  setMethod :: SVariable PythonCode -> SMethod PythonCode
setMethod = forall (r :: * -> *). RenderSym r => SVariable r -> SMethod r
G.setMethod
  constructor :: [MSParameter PythonCode]
-> NamedArgs PythonCode -> MSBody PythonCode -> SMethod PythonCode
constructor = forall (r :: * -> *).
RenderSym r =>
String
-> [MSParameter r] -> Initializers r -> MSBody r -> SMethod r
CP.constructor String
initName

  docMain :: MSBody PythonCode -> SMethod PythonCode
docMain = forall (r :: * -> *). MethodSym r => MSBody r -> SMethod r
mainFunction

  function :: String
-> PythonCode (Scope PythonCode)
-> VSType PythonCode
-> [MSParameter PythonCode]
-> MSBody PythonCode
-> SMethod PythonCode
function = forall (r :: * -> *).
RenderSym r =>
String
-> r (Scope r)
-> VSType r
-> [MSParameter r]
-> MSBody r
-> SMethod r
G.function
  mainFunction :: MSBody PythonCode -> SMethod PythonCode
mainFunction = forall (r :: * -> *). RenderSym r => MSBody r -> SMethod r
CP.mainBody

  docFunc :: String
-> [String]
-> Maybe String
-> SMethod PythonCode
-> SMethod PythonCode
docFunc = forall (r :: * -> *).
RenderSym r =>
String -> [String] -> Maybe String -> SMethod r -> SMethod r
CP.doxFunc

  inOutMethod :: String
-> PythonCode (Scope PythonCode)
-> PythonCode (Permanence PythonCode)
-> InOutFunc PythonCode
inOutMethod String
n PythonCode (Scope PythonCode)
s PythonCode (Permanence PythonCode)
p = forall (r :: * -> *).
RenderSym r =>
(VSType r -> [MSParameter r] -> MSBody r -> SMethod r)
-> [SVariable r]
-> [SVariable r]
-> [SVariable r]
-> MSBody r
-> SMethod r
CP.inOutFunc (forall (r :: * -> *).
MethodSym r =>
String
-> r (Scope r)
-> r (Permanence r)
-> VSType r
-> [MSParameter r]
-> MSBody r
-> SMethod r
method String
n PythonCode (Scope PythonCode)
s PythonCode (Permanence PythonCode)
p)

  docInOutMethod :: String
-> PythonCode (Scope PythonCode)
-> PythonCode (Permanence PythonCode)
-> DocInOutFunc PythonCode
docInOutMethod String
n PythonCode (Scope PythonCode)
s PythonCode (Permanence PythonCode)
p = forall (r :: * -> *).
RenderSym r =>
FuncDocRenderer
-> ([SVariable r]
    -> [SVariable r] -> [SVariable r] -> MSBody r -> SMethod r)
-> String
-> [(String, SVariable r)]
-> [(String, SVariable r)]
-> [(String, SVariable r)]
-> MSBody r
-> SMethod r
CP.docInOutFunc' FuncDocRenderer
functionDox (forall (r :: * -> *).
MethodSym r =>
String -> r (Scope r) -> r (Permanence r) -> InOutFunc r
inOutMethod String
n PythonCode (Scope PythonCode)
s PythonCode (Permanence PythonCode)
p)

  inOutFunc :: String -> PythonCode (Scope PythonCode) -> InOutFunc PythonCode
inOutFunc String
n PythonCode (Scope PythonCode)
s = forall (r :: * -> *).
RenderSym r =>
(VSType r -> [MSParameter r] -> MSBody r -> SMethod r)
-> [SVariable r]
-> [SVariable r]
-> [SVariable r]
-> MSBody r
-> SMethod r
CP.inOutFunc (forall (r :: * -> *).
MethodSym r =>
String
-> r (Scope r)
-> VSType r
-> [MSParameter r]
-> MSBody r
-> SMethod r
function String
n PythonCode (Scope PythonCode)
s)

  docInOutFunc :: String -> PythonCode (Scope PythonCode) -> DocInOutFunc PythonCode
docInOutFunc String
n PythonCode (Scope PythonCode)
s = forall (r :: * -> *).
RenderSym r =>
FuncDocRenderer
-> ([SVariable r]
    -> [SVariable r] -> [SVariable r] -> MSBody r -> SMethod r)
-> String
-> [(String, SVariable r)]
-> [(String, SVariable r)]
-> [(String, SVariable r)]
-> MSBody r
-> SMethod r
CP.docInOutFunc' FuncDocRenderer
functionDox (forall (r :: * -> *).
MethodSym r =>
String -> r (Scope r) -> InOutFunc r
inOutFunc String
n PythonCode (Scope PythonCode)
s)

instance RenderMethod PythonCode where
  intMethod :: Bool
-> String
-> PythonCode (Scope PythonCode)
-> PythonCode (Permanence PythonCode)
-> MSMthdType PythonCode
-> [MSParameter PythonCode]
-> MSBody PythonCode
-> SMethod PythonCode
intMethod Bool
m String
n PythonCode (Scope PythonCode)
_ PythonCode (Permanence PythonCode)
_ MSMthdType PythonCode
_ [MSParameter PythonCode]
ps MSBody PythonCode
b = do
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (if Bool
m then MethodState -> MethodState
setCurrMain else forall a. a -> a
id)
    PythonCode (Variable PythonCode)
sl <- 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 (r :: * -> *). VariableSym r => SVariable r
self
    [PythonCode ParamData]
pms <- forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [MSParameter PythonCode]
ps
    forall (r :: * -> *) a. Monad r => a -> r a
toCode forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> MethodData
mthd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (r :: * -> *).
RenderSym r =>
String -> r (Variable r) -> [r (Parameter r)] -> r (Body r) -> Doc
pyMethod String
n PythonCode (Variable PythonCode)
sl [PythonCode ParamData]
pms forall (r :: * -> *) a b. Functor r => (a -> b) -> r a -> r b
<$> MSBody PythonCode
b
  intFunc :: Bool
-> String
-> PythonCode (Scope PythonCode)
-> PythonCode (Permanence PythonCode)
-> MSMthdType PythonCode
-> [MSParameter PythonCode]
-> MSBody PythonCode
-> SMethod PythonCode
intFunc Bool
m String
n PythonCode (Scope PythonCode)
_ PythonCode (Permanence PythonCode)
_ MSMthdType PythonCode
_ [MSParameter PythonCode]
ps MSBody PythonCode
b = do
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (if Bool
m then MethodState -> MethodState
setCurrMain else forall a. a -> a
id)
    PythonCode Doc
bd <- MSBody PythonCode
b
    [PythonCode ParamData]
pms <- forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [MSParameter PythonCode]
ps
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (r :: * -> *) a. Monad r => a -> r a
toCode forall a b. (a -> b) -> a -> b
$ Doc -> MethodData
mthd forall a b. (a -> b) -> a -> b
$ forall (r :: * -> *).
RenderSym r =>
String -> [r (Parameter r)] -> r (Body r) -> Doc
pyFunction String
n [PythonCode ParamData]
pms PythonCode Doc
bd
  commentedFunc :: MS (PythonCode (BlockComment PythonCode))
-> SMethod PythonCode -> SMethod PythonCode
commentedFunc MS (PythonCode (BlockComment PythonCode))
cmt SMethod PythonCode
m = forall a b c s.
(a -> b -> c) -> State s a -> State s b -> State s c
on2StateValues (forall (r :: * -> *) a b c.
Applicative r =>
(a -> b -> c) -> r a -> r b -> r c
on2CodeValues MethodData -> (Doc -> Doc) -> MethodData
updateMthd) SMethod PythonCode
m 
    (forall a b s. (a -> b) -> State s a -> State s b
onStateValue (forall (r :: * -> *) a b. Functor r => (a -> b) -> r a -> r b
onCodeValue Doc -> Doc -> Doc
R.commentedItem) MS (PythonCode (BlockComment PythonCode))
cmt)
    
  destructor :: [CSStateVar PythonCode] -> SMethod PythonCode
destructor [CSStateVar PythonCode]
_ = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String -> String
CP.destructorError String
pyName
  
  mthdFromData :: ScopeTag -> Doc -> SMethod PythonCode
mthdFromData ScopeTag
_ Doc
d = forall a s. a -> State s a
toState forall a b. (a -> b) -> a -> b
$ forall (r :: * -> *) a. Monad r => a -> r a
toCode forall a b. (a -> b) -> a -> b
$ Doc -> MethodData
mthd Doc
d
  
instance MethodElim PythonCode where
  method :: PythonCode (Method PythonCode) -> Doc
method = MethodData -> Doc
mthdDoc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. PythonCode a -> a
unPC

instance StateVarSym PythonCode where
  type StateVar PythonCode = Doc
  stateVar :: PythonCode (Scope PythonCode)
-> PythonCode (Permanence PythonCode)
-> SVariable PythonCode
-> CSStateVar PythonCode
stateVar PythonCode (Scope PythonCode)
_ PythonCode (Permanence PythonCode)
_ SVariable PythonCode
_ = forall a s. a -> State s a
toState (forall (r :: * -> *) a. Monad r => a -> r a
toCode Doc
empty)
  stateVarDef :: PythonCode (Scope PythonCode)
-> PythonCode (Permanence PythonCode)
-> SVariable PythonCode
-> SValue PythonCode
-> CSStateVar PythonCode
stateVarDef = forall (r :: * -> *).
(RenderSym r, Monad r) =>
r (Scope r)
-> r (Permanence r) -> SVariable r -> SValue r -> CS (r Doc)
CP.stateVarDef
  constVar :: PythonCode (Scope PythonCode)
-> SVariable PythonCode
-> SValue PythonCode
-> CSStateVar PythonCode
constVar = forall (r :: * -> *).
(RenderSym r, Monad r) =>
Doc -> r (Scope r) -> SVariable r -> SValue r -> CS (r Doc)
CP.constVar (forall (r :: * -> *). PermElim r => r (Permanence r) -> Doc
RC.perm 
    (forall (r :: * -> *). PermanenceSym r => r (Permanence r)
static :: PythonCode (Permanence PythonCode)))
  
instance StateVarElim PythonCode where
  stateVar :: PythonCode (StateVar PythonCode) -> Doc
stateVar = forall a. PythonCode a -> a
unPC

instance ClassSym PythonCode where
  type Class PythonCode = Doc
  buildClass :: Maybe String
-> [CSStateVar PythonCode]
-> [SMethod PythonCode]
-> SClass PythonCode
buildClass = forall (r :: * -> *).
RenderSym r =>
Maybe String -> [CSStateVar r] -> [SMethod r] -> SClass r
G.buildClass
  extraClass :: String
-> Maybe String
-> [CSStateVar PythonCode]
-> [SMethod PythonCode]
-> SClass PythonCode
extraClass = forall (r :: * -> *).
RenderSym r =>
String -> Maybe String -> [CSStateVar r] -> [SMethod r] -> SClass r
CP.extraClass  
  implementingClass :: String
-> [String]
-> [CSStateVar PythonCode]
-> [SMethod PythonCode]
-> SClass PythonCode
implementingClass = forall (r :: * -> *).
RenderSym r =>
String -> [String] -> [CSStateVar r] -> [SMethod r] -> SClass r
G.implementingClass

  docClass :: String -> SClass PythonCode -> SClass PythonCode
docClass = forall (r :: * -> *). RenderSym r => String -> SClass r -> SClass r
CP.doxClass

instance RenderClass PythonCode where
  intClass :: String
-> PythonCode (Scope PythonCode)
-> PythonCode Doc
-> [CSStateVar PythonCode]
-> [SMethod PythonCode]
-> SClass PythonCode
intClass = forall (r :: * -> *).
(RenderSym r, Monad r) =>
(String -> Doc -> Doc -> Doc -> Doc -> Doc)
-> String
-> r (Scope r)
-> r Doc
-> [CSStateVar r]
-> [SMethod r]
-> CS (r Doc)
CP.intClass String -> Doc -> Doc -> Doc -> Doc -> Doc
pyClass

  inherit :: Maybe String -> PythonCode Doc
inherit Maybe String
n = forall (r :: * -> *) a. Monad r => a -> r a
toCode forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
empty (Doc -> Doc
parens forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Doc
text) Maybe String
n
  implements :: [String] -> PythonCode Doc
implements [String]
is = forall (r :: * -> *) a. Monad r => a -> r a
toCode forall a b. (a -> b) -> a -> b
$ Doc -> Doc
parens (String -> Doc
text forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [[a]] -> [a]
intercalate String
listSep [String]
is)

  commentedClass :: CS (PythonCode (BlockComment PythonCode))
-> SClass PythonCode -> SClass PythonCode
commentedClass = forall (r :: * -> *).
(RenderSym r, Monad r) =>
CS (r (BlockComment r)) -> SClass r -> CS (r Doc)
G.commentedClass
  
instance ClassElim PythonCode where
  class' :: PythonCode (Class PythonCode) -> Doc
class' = forall a. PythonCode a -> a
unPC

instance ModuleSym PythonCode where
  type Module PythonCode = ModData
  buildModule :: String
-> [String]
-> [SMethod PythonCode]
-> [SClass PythonCode]
-> FSModule PythonCode
buildModule String
n [String]
is = forall (r :: * -> *).
RenderSym r =>
String
-> FS Doc
-> FS Doc
-> FS Doc
-> [SMethod r]
-> [SClass r]
-> FSModule r
CP.buildModule String
n (do
    [String]
lis <- FS [String]
getLangImports
    [String]
libis <- FS [String]
getLibImports
    [String]
mis <- FS [String]
getModuleImports
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vibcat [
      [Doc] -> Doc
vcat (forall a b. (a -> b) -> [a] -> [b]
map (forall (r :: * -> *). ImportElim r => r (Import r) -> Doc
RC.import' forall b c a. (b -> c) -> (a -> b) -> a -> c
. 
        (forall (r :: * -> *). ImportSym r => String -> r (Import r)
langImport :: Label -> PythonCode (Import PythonCode))) [String]
lis),
      [Doc] -> Doc
vcat (forall a b. (a -> b) -> [a] -> [b]
map (forall (r :: * -> *). ImportElim r => r (Import r) -> Doc
RC.import' forall b c a. (b -> c) -> (a -> b) -> a -> c
. 
        (forall (r :: * -> *). ImportSym r => String -> r (Import r)
langImport :: Label -> PythonCode (Import PythonCode))) (forall a. Ord a => [a] -> [a]
sort forall a b. (a -> b) -> a -> b
$ [String]
is forall a. [a] -> [a] -> [a]
++ 
        [String]
libis)),
      [Doc] -> Doc
vcat (forall a b. (a -> b) -> [a] -> [b]
map (forall (r :: * -> *). ImportElim r => r (Import r) -> Doc
RC.import' forall b c a. (b -> c) -> (a -> b) -> a -> c
. 
        (forall (r :: * -> *). ImportSym r => String -> r (Import r)
modImport :: Label -> PythonCode (Import PythonCode))) [String]
mis)]) 
    (forall (f :: * -> *) a. Applicative f => a -> f a
pure Doc
empty) FS Doc
getMainDoc

instance RenderMod PythonCode where
  modFromData :: String -> FS Doc -> FSModule PythonCode
modFromData String
n = forall (r :: * -> *).
String -> (Doc -> r (Module r)) -> FS Doc -> FSModule r
G.modFromData String
n (forall (r :: * -> *) a. Monad r => a -> r a
toCode forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Doc -> ModData
md String
n)
  updateModuleDoc :: (Doc -> Doc)
-> PythonCode (Module PythonCode) -> PythonCode (Module PythonCode)
updateModuleDoc Doc -> Doc
f = forall (r :: * -> *) a b. Functor r => (a -> b) -> r a -> r b
onCodeValue ((Doc -> Doc) -> ModData -> ModData
updateMod Doc -> Doc
f)
  
instance ModuleElim PythonCode where
  module' :: PythonCode (Module PythonCode) -> Doc
module' = ModData -> Doc
modDoc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. PythonCode a -> a
unPC

instance BlockCommentSym PythonCode where
  type BlockComment PythonCode = Doc
  blockComment :: [String] -> PythonCode (BlockComment PythonCode)
blockComment [String]
lns = forall (r :: * -> *) a. Monad r => a -> r a
toCode forall a b. (a -> b) -> a -> b
$ [String] -> Doc -> Doc
pyBlockComment [String]
lns Doc
pyCommentStart
  docComment :: forall a.
State a [String] -> State a (PythonCode (BlockComment PythonCode))
docComment = forall a b s. (a -> b) -> State s a -> State s b
onStateValue (\[String]
lns -> forall (r :: * -> *) a. Monad r => a -> r a
toCode forall a b. (a -> b) -> a -> b
$ [String] -> Doc -> Doc -> Doc
pyDocComment [String]
lns Doc
pyDocCommentStart
    Doc
pyCommentStart)

instance BlockCommentElim PythonCode where
  blockComment' :: PythonCode (BlockComment PythonCode) -> Doc
blockComment' = forall a. PythonCode a -> a
unPC

-- convenience
initName :: Label
initName :: String
initName = String
"__init__"

pyName, pyVersion :: String
pyName :: String
pyName = String
"Python"
pyVersion :: String
pyVersion = String
"3.5.1"

pyInt, pyDouble, pyString, pyVoid :: String
pyInt :: String
pyInt = String
"int"
pyDouble :: String
pyDouble = String
"float"
pyString :: String
pyString = String
"str"
pyVoid :: String
pyVoid = String
"NoneType"

pyFloatError :: String
pyFloatError :: String
pyFloatError = String
"Floats unavailable in Python, use Doubles instead"

pyPower, pyAnd, pyOr, pyIntDiv :: String
pyPower :: String
pyPower = String
"**"
pyAnd :: String
pyAnd = String
"and"
pyOr :: String
pyOr = String
"or"
pyIntDiv :: String
pyIntDiv = String
"//"

pySelf, pyNull :: String
pySelf :: String
pySelf = String
"self"
pyNull :: String
pyNull = String
"None"

pyNull' :: Doc
pyNull' :: Doc
pyNull' = String -> Doc
text String
pyNull

pyTrue, pyFalse :: Doc
pyTrue :: Doc
pyTrue = String -> Doc
text String
"True"
pyFalse :: Doc
pyFalse = String -> Doc
text String
"False"

pyPi :: Doc
pyPi :: Doc
pyPi = String -> Doc
text forall a b. (a -> b) -> a -> b
$ String
pyMath String -> String -> String
`access` String
piLabel

pySys :: String
pySys :: String
pySys = String
"sys"

pyInputFunc, pyPrintFunc, pyListSizeFunc :: Doc
pyInputFunc :: Doc
pyInputFunc = String -> Doc
text String
"input()" -- raw_input() for < Python 3.0
pyPrintFunc :: Doc
pyPrintFunc = String -> Doc
text String
printLabel
pyListSizeFunc :: Doc
pyListSizeFunc = String -> Doc
text String
"len"

pyIndex, pyInsert, pyAppendFunc, pyReadline, pyReadlines, pyOpen, pyClose, 
  pyRead, pyWrite, pyAppend, pySplit, pyRange, pyRstrip, pyMath :: String
pyIndex :: String
pyIndex = String
"index"
pyInsert :: String
pyInsert = String
"insert"
pyAppendFunc :: String
pyAppendFunc = String
"append"
pyReadline :: String
pyReadline = String
"readline"
pyReadlines :: String
pyReadlines = String
"readlines"
pyOpen :: String
pyOpen = String
"open"
pyClose :: String
pyClose = String
"close"
pyRead :: String
pyRead = String
"r"
pyWrite :: String
pyWrite = String
"w"
pyAppend :: String
pyAppend = String
"a"
pySplit :: String
pySplit = String
"split"
pyRange :: String
pyRange = String
"range"
pyRstrip :: String
pyRstrip = String
"rstrip"
pyMath :: String
pyMath = String
"math"

pyDef, pyLambdaDec, pyElseIf, pyRaise, pyExcept :: Doc
pyDef :: Doc
pyDef = String -> Doc
text String
"def"
pyLambdaDec :: Doc
pyLambdaDec = String -> Doc
text String
"lambda"
pyElseIf :: Doc
pyElseIf = String -> Doc
text String
"elif"
pyRaise :: Doc
pyRaise = String -> Doc
text String
"raise"
pyExcept :: Doc
pyExcept = String -> Doc
text String
"except"

pyBodyStart, pyBodyEnd, pyCommentStart, pyDocCommentStart, pyNamedArgSep :: Doc
pyBodyStart :: Doc
pyBodyStart = Doc
colon
pyBodyEnd :: Doc
pyBodyEnd = Doc
empty
pyCommentStart :: Doc
pyCommentStart = String -> Doc
text String
"#"
pyDocCommentStart :: Doc
pyDocCommentStart = Doc
pyCommentStart Doc -> Doc -> Doc
<> Doc
pyCommentStart
pyNamedArgSep :: Doc
pyNamedArgSep = Doc
equals

pySpace :: OptionalSpace
pySpace :: OptionalSpace
pySpace = OSpace {oSpace :: Doc
oSpace = Doc
empty}

pyNotOp :: (Monad r) => VSOp r
pyNotOp :: forall (r :: * -> *). Monad r => VSOp r
pyNotOp = forall (r :: * -> *). Monad r => String -> VSOp r
unOpPrec String
"not"

pySqrtOp :: (Monad r) => VSOp r
pySqrtOp :: forall (r :: * -> *). Monad r => VSOp r
pySqrtOp = forall (r :: * -> *). Monad r => String -> VSOp r
mathFunc String
R.sqrt

pyAbsOp :: (Monad r) => VSOp r
pyAbsOp :: forall (r :: * -> *). Monad r => VSOp r
pyAbsOp = forall (r :: * -> *). Monad r => String -> VSOp r
mathFunc String
R.fabs

pyLogOp :: (Monad r) => VSOp r
pyLogOp :: forall (r :: * -> *). Monad r => VSOp r
pyLogOp = forall (r :: * -> *). Monad r => String -> VSOp r
mathFunc String
R.log10

pyLnOp :: (Monad r) => VSOp r
pyLnOp :: forall (r :: * -> *). Monad r => VSOp r
pyLnOp = forall (r :: * -> *). Monad r => String -> VSOp r
mathFunc String
R.log

pyExpOp :: (Monad r) => VSOp r
pyExpOp :: forall (r :: * -> *). Monad r => VSOp r
pyExpOp = forall (r :: * -> *). Monad r => String -> VSOp r
mathFunc String
R.exp

pySinOp :: (Monad r) => VSOp r
pySinOp :: forall (r :: * -> *). Monad r => VSOp r
pySinOp = forall (r :: * -> *). Monad r => String -> VSOp r
mathFunc String
R.sin

pyCosOp :: (Monad r) => VSOp r
pyCosOp :: forall (r :: * -> *). Monad r => VSOp r
pyCosOp = forall (r :: * -> *). Monad r => String -> VSOp r
mathFunc String
R.cos

pyTanOp :: (Monad r) => VSOp r
pyTanOp :: forall (r :: * -> *). Monad r => VSOp r
pyTanOp = forall (r :: * -> *). Monad r => String -> VSOp r
mathFunc String
R.tan

pyAsinOp :: (Monad r) => VSOp r
pyAsinOp :: forall (r :: * -> *). Monad r => VSOp r
pyAsinOp = forall (r :: * -> *). Monad r => String -> VSOp r
mathFunc String
R.asin

pyAcosOp :: (Monad r) => VSOp r
pyAcosOp :: forall (r :: * -> *). Monad r => VSOp r
pyAcosOp = forall (r :: * -> *). Monad r => String -> VSOp r
mathFunc String
R.acos

pyAtanOp :: (Monad r) => VSOp r
pyAtanOp :: forall (r :: * -> *). Monad r => VSOp r
pyAtanOp = forall (r :: * -> *). Monad r => String -> VSOp r
mathFunc String
R.atan

pyFloorOp :: (Monad r) => VSOp r
pyFloorOp :: forall (r :: * -> *). Monad r => VSOp r
pyFloorOp = forall (r :: * -> *). Monad r => String -> VSOp r
mathFunc String
R.floor

pyCeilOp :: (Monad r) => VSOp r
pyCeilOp :: forall (r :: * -> *). Monad r => VSOp r
pyCeilOp = forall (r :: * -> *). Monad r => String -> VSOp r
mathFunc String
R.ceil

addmathImport :: VS a -> VS a
addmathImport :: forall a. VS a -> VS a
addmathImport = forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
(>>) forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (String -> ValueState -> ValueState
addLangImportVS String
pyMath)

mathFunc :: (Monad r) => String -> VSOp r
mathFunc :: forall (r :: * -> *). Monad r => String -> VSOp r
mathFunc = forall a. VS a -> VS a
addmathImport forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (r :: * -> *). Monad r => String -> VSOp r
unOpPrec forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
access String
pyMath 

splitFunc :: (RenderSym r) => Char -> VSFunction r
splitFunc :: forall (r :: * -> *). RenderSym r => Char -> VSFunction r
splitFunc Char
d = forall (r :: * -> *).
FunctionSym r =>
String -> VSType r -> [SValue r] -> VSFunction r
func String
pySplit (forall (r :: * -> *). TypeSym r => VSType r -> VSType r
listType forall (r :: * -> *). TypeSym r => VSType r
string) [forall (r :: * -> *). Literal r => String -> SValue r
litString [Char
d]]

openRead, openWrite, openAppend :: (RenderSym r) => SValue r -> SValue r
openRead :: forall (r :: * -> *). RenderSym r => SValue r -> SValue r
openRead SValue r
n = forall (r :: * -> *). ValueExpression r => String -> PosCtorCall r
funcApp String
pyOpen forall (r :: * -> *). TypeSym r => VSType r
infile [SValue r
n, forall (r :: * -> *). Literal r => String -> SValue r
litString String
pyRead]
openWrite :: forall (r :: * -> *). RenderSym r => SValue r -> SValue r
openWrite SValue r
n = forall (r :: * -> *). ValueExpression r => String -> PosCtorCall r
funcApp String
pyOpen forall (r :: * -> *). TypeSym r => VSType r
outfile [SValue r
n, forall (r :: * -> *). Literal r => String -> SValue r
litString String
pyWrite]
openAppend :: forall (r :: * -> *). RenderSym r => SValue r -> SValue r
openAppend SValue r
n = forall (r :: * -> *). ValueExpression r => String -> PosCtorCall r
funcApp String
pyOpen forall (r :: * -> *). TypeSym r => VSType r
outfile [SValue r
n, forall (r :: * -> *). Literal r => String -> SValue r
litString String
pyAppend]

readline, readlines :: (RenderSym r) => SValue r -> SValue r
readline :: forall (r :: * -> *). RenderSym r => SValue r -> SValue r
readline SValue r
f = forall (r :: * -> *).
InternalValueExp r =>
VSType r -> SValue r -> String -> [SValue r] -> SValue r
objMethodCall forall (r :: * -> *). TypeSym r => VSType r
string SValue r
f String
pyReadline []
readlines :: forall (r :: * -> *). RenderSym r => SValue r -> SValue r
readlines SValue r
f = forall (r :: * -> *).
InternalValueExp r =>
VSType r -> SValue r -> String -> [SValue r] -> SValue r
objMethodCall (forall (r :: * -> *). TypeSym r => VSType r -> VSType r
listType forall (r :: * -> *). TypeSym r => VSType r
string) SValue r
f String
pyReadlines []

readInt, readDouble, readString :: (RenderSym r) => SValue r -> SValue r
readInt :: forall (r :: * -> *). RenderSym r => SValue r -> SValue r
readInt SValue r
inSrc = forall (r :: * -> *). ValueExpression r => String -> PosCtorCall r
funcApp String
pyInt forall (r :: * -> *). TypeSym r => VSType r
int [SValue r
inSrc]
readDouble :: forall (r :: * -> *). RenderSym r => SValue r -> SValue r
readDouble SValue r
inSrc = forall (r :: * -> *). ValueExpression r => String -> PosCtorCall r
funcApp String
pyDouble forall (r :: * -> *). TypeSym r => VSType r
double [SValue r
inSrc]
readString :: forall (r :: * -> *). RenderSym r => SValue r -> SValue r
readString SValue r
inSrc = forall (r :: * -> *).
InternalValueExp r =>
VSType r -> SValue r -> String -> [SValue r] -> SValue r
objMethodCall forall (r :: * -> *). TypeSym r => VSType r
string SValue r
inSrc String
pyRstrip []

range :: (RenderSym r) => SValue r -> SValue r -> SValue r -> SValue r
range :: forall (r :: * -> *).
RenderSym r =>
SValue r -> SValue r -> SValue r -> SValue r
range SValue r
initv SValue r
finalv SValue r
stepv = forall (r :: * -> *). ValueExpression r => String -> PosCtorCall r
funcApp String
pyRange (forall (r :: * -> *). TypeSym r => VSType r -> VSType r
listType forall (r :: * -> *). TypeSym r => VSType r
int) [SValue r
initv, SValue r
finalv, SValue r
stepv]

pyClassVar :: Doc -> Doc -> Doc
pyClassVar :: Doc -> Doc -> Doc
pyClassVar Doc
c Doc
v = Doc
c Doc -> Doc -> Doc
<> Doc
dot Doc -> Doc -> Doc
<> Doc
c Doc -> Doc -> Doc
<> Doc
dot Doc -> Doc -> Doc
<> Doc
v

pyInlineIf :: (RenderSym r) => SValue r -> SValue r -> SValue r -> SValue r
pyInlineIf :: forall (r :: * -> *).
RenderSym r =>
SValue r -> SValue r -> SValue r -> SValue r
pyInlineIf 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
valuePrec 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)
v1 Doc -> Doc -> Doc
<+> Doc
ifLabel Doc -> Doc -> Doc
<+> forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value r (Value r)
c Doc -> Doc -> Doc
<+> Doc
elseLabel Doc -> Doc -> Doc
<+> forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value r (Value r)
v2)

pyLambda :: (RenderSym r) => [r (Variable r)] -> r (Value r) -> Doc
pyLambda :: forall (r :: * -> *).
RenderSym r =>
[r (Variable r)] -> r (Value r) -> Doc
pyLambda [r (Variable r)]
ps r (Value r)
ex = Doc
pyLambdaDec Doc -> Doc -> Doc
<+> forall (r :: * -> *). RenderSym r => [r (Variable r)] -> Doc
variableList [r (Variable r)]
ps Doc -> Doc -> Doc
<> Doc
colon Doc -> Doc -> Doc
<+> forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value r (Value r)
ex

pyListSize :: Doc -> Doc -> Doc
pyListSize :: Doc -> Doc -> Doc
pyListSize Doc
v Doc
f = Doc
f Doc -> Doc -> Doc
<> Doc -> Doc
parens Doc
v

pyStringType :: (RenderSym r) => VSType r
pyStringType :: forall (r :: * -> *). RenderSym r => VSType r
pyStringType = forall (r :: * -> *).
RenderType r =>
CodeType -> String -> Doc -> VSType r
typeFromData CodeType
String String
pyString (String -> Doc
text String
pyString)

pyExtNewObjMixedArgs :: (RenderSym r) => Library -> MixedCtorCall r
pyExtNewObjMixedArgs :: forall (r :: * -> *). RenderSym r => MixedCall r
pyExtNewObjMixedArgs String
l VSType r
tp [SValue r]
vs NamedArgs r
ns = VSType r
tp forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\r (Type r)
t -> forall (r :: * -> *).
RenderValue r =>
Maybe String -> Maybe Doc -> MixedCall r
call (forall a. a -> Maybe a
Just String
l) forall a. Maybe a
Nothing 
  (forall (r :: * -> *). TypeElim r => r (Type r) -> String
getTypeString r (Type r)
t) (forall (f :: * -> *) a. Applicative f => a -> f a
pure r (Type r)
t) [SValue r]
vs NamedArgs r
ns)

pyPrint :: Bool -> Maybe (SValue PythonCode) -> SValue PythonCode -> 
  SValue PythonCode -> MSStatement PythonCode
pyPrint :: Bool
-> Maybe (SValue PythonCode)
-> SValue PythonCode
-> SValue PythonCode
-> MSStatement PythonCode
pyPrint Bool
newLn Maybe (SValue PythonCode)
f' SValue PythonCode
p' SValue PythonCode
v' = do
    PythonCode (Value PythonCode)
f <- 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 a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe (forall (r :: * -> *). RenderSym r => VSType r -> Doc -> SValue r
mkStateVal forall (r :: * -> *). TypeSym r => VSType r
void Doc
empty) Maybe (SValue PythonCode)
f'
    PythonCode ValData
prf <- 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 PythonCode
p'
    PythonCode ValData
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 PythonCode
v'
    PythonCode ValData
s <- 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 (r :: * -> *). Literal r => String -> SValue r
litString String
"" :: SValue PythonCode)
    let nl :: Doc
nl = if Bool
newLn then Doc
empty else Doc
listSep' Doc -> Doc -> Doc
<> String -> Doc
text String
"end" Doc -> Doc -> Doc
<> Doc
equals Doc -> Doc -> Doc
<> 
               forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value PythonCode ValData
s
        fl :: Doc
fl = Doc -> Doc -> Doc
emptyIfEmpty (forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value PythonCode (Value PythonCode)
f) forall a b. (a -> b) -> a -> b
$ Doc
listSep' Doc -> Doc -> Doc
<> String -> Doc
text String
"file" Doc -> Doc -> Doc
<> Doc
equals 
               Doc -> Doc -> Doc
<> forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value PythonCode (Value PythonCode)
f
    forall (r :: * -> *). RenderSym r => Doc -> MSStatement r
mkStmtNoEnd forall a b. (a -> b) -> a -> b
$ forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value PythonCode ValData
prf Doc -> Doc -> Doc
<> Doc -> Doc
parens (forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value PythonCode ValData
v Doc -> Doc -> Doc
<> Doc
nl Doc -> Doc -> Doc
<> Doc
fl)

pyOut :: (RenderSym r) => Bool -> Maybe (SValue r) -> SValue r -> SValue r -> 
  MSStatement r
pyOut :: forall (r :: * -> *).
RenderSym r =>
Bool -> Maybe (SValue r) -> SValue r -> SValue r -> MSStatement r
pyOut Bool
newLn Maybe (SValue r)
f SValue r
printFn SValue 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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CodeType -> StateT MethodState Identity (r (Statement r))
pyOut' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (r :: * -> *). TypeElim r => r (Type r) -> CodeType
getType forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (r :: * -> *). ValueSym r => r (Value r) -> r (Type r)
valueType
  where pyOut' :: CodeType -> StateT MethodState Identity (r (Statement r))
pyOut' (List CodeType
_) = forall (r :: * -> *).
InternalIOStmt r =>
Bool -> Maybe (SValue r) -> SValue r -> SValue r -> MSStatement r
printSt Bool
newLn Maybe (SValue r)
f SValue r
printFn SValue r
v
        pyOut' CodeType
_ = forall (r :: * -> *).
RenderSym r =>
Bool -> Maybe (SValue r) -> SValue r -> SValue r -> MSStatement r
G.print Bool
newLn Maybe (SValue r)
f SValue r
printFn SValue r
v

pyInput :: SValue PythonCode -> SVariable PythonCode -> MSStatement PythonCode
pyInput :: SValue PythonCode -> SVariable PythonCode -> MSStatement PythonCode
pyInput SValue PythonCode
inSrc SVariable PythonCode
v = SVariable PythonCode
v forall (r :: * -> *).
AssignStatement r =>
SVariable r -> SValue r -> MSStatement r
&= (SVariable PythonCode
v forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CodeType -> SValue PythonCode
pyInput' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (r :: * -> *). TypeElim r => r (Type r) -> CodeType
getType forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (r :: * -> *).
VariableElim r =>
r (Variable r) -> r (Type r)
variableType)
  where pyInput' :: CodeType -> SValue PythonCode
pyInput' CodeType
Integer = forall (r :: * -> *). RenderSym r => SValue r -> SValue r
readInt SValue PythonCode
inSrc
        pyInput' CodeType
Float = forall (r :: * -> *). RenderSym r => SValue r -> SValue r
readDouble SValue PythonCode
inSrc
        pyInput' CodeType
Double = forall (r :: * -> *). RenderSym r => SValue r -> SValue r
readDouble SValue PythonCode
inSrc
        pyInput' CodeType
Boolean = SValue PythonCode
inSrc forall (r :: * -> *).
Comparison r =>
SValue r -> SValue r -> SValue r
?!= forall (r :: * -> *). Literal r => String -> SValue r
litString String
"0"
        pyInput' CodeType
String = forall (r :: * -> *). RenderSym r => SValue r -> SValue r
readString SValue PythonCode
inSrc
        pyInput' CodeType
Char = SValue PythonCode
inSrc
        pyInput' CodeType
_ = forall a. HasCallStack => String -> a
error String
"Attempt to read a value of unreadable type"

pyThrow :: (RenderSym r) => r (Value r) -> Doc
pyThrow :: forall (r :: * -> *). RenderSym r => r (Value r) -> Doc
pyThrow r (Value r)
errMsg = Doc
pyRaise Doc -> Doc -> Doc
<+> Doc
exceptionObj' Doc -> Doc -> Doc
<> Doc -> Doc
parens (forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value r (Value r)
errMsg)

pyForEach :: (RenderSym r) => r (Variable r) -> r (Value r) -> r (Body r) -> Doc
pyForEach :: forall (r :: * -> *).
RenderSym r =>
r (Variable r) -> r (Value r) -> r (Body r) -> Doc
pyForEach r (Variable r)
i r (Value r)
lstVar r (Body r)
b = [Doc] -> Doc
vcat [
  Doc
forLabel Doc -> Doc -> Doc
<+> forall (r :: * -> *). InternalVarElim r => r (Variable r) -> Doc
RC.variable r (Variable r)
i Doc -> Doc -> Doc
<+> Doc
inLabel Doc -> Doc -> Doc
<+> forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value r (Value r)
lstVar Doc -> Doc -> Doc
<> Doc
colon,
  Doc -> Doc
indent forall a b. (a -> b) -> a -> b
$ forall (r :: * -> *). BodyElim r => r (Body r) -> Doc
RC.body r (Body r)
b]

pyWhile :: (RenderSym r) => r (Value r) -> r (Body r) -> Doc
pyWhile :: forall (r :: * -> *).
RenderSym r =>
r (Value r) -> r (Body r) -> Doc
pyWhile r (Value r)
v r (Body r)
b = [Doc] -> Doc
vcat [
  Doc
whileLabel Doc -> Doc -> Doc
<+> forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value r (Value r)
v Doc -> Doc -> Doc
<> Doc
colon,
  Doc -> Doc
indent forall a b. (a -> b) -> a -> b
$ forall (r :: * -> *). BodyElim r => r (Body r) -> Doc
RC.body r (Body r)
b]

pyTryCatch :: (RenderSym r) => r (Body r) -> r (Body r) -> Doc
pyTryCatch :: forall (r :: * -> *).
RenderSym r =>
r (Body r) -> r (Body r) -> Doc
pyTryCatch r (Body r)
tryB r (Body r)
catchB = [Doc] -> Doc
vcat [
  Doc
tryLabel Doc -> Doc -> Doc
<> Doc
colon,
  Doc -> Doc
indent forall a b. (a -> b) -> a -> b
$ forall (r :: * -> *). BodyElim r => r (Body r) -> Doc
RC.body r (Body r)
tryB,
  Doc
pyExcept Doc -> Doc -> Doc
<+> Doc
exceptionObj' Doc -> Doc -> Doc
<> Doc
colon,
  Doc -> Doc
indent forall a b. (a -> b) -> a -> b
$ forall (r :: * -> *). BodyElim r => r (Body r) -> Doc
RC.body r (Body r)
catchB]

pyListSlice :: (RenderSym r, Monad r) => SVariable r -> SValue r -> SValue r -> 
  SValue r -> SValue r -> MS (r Doc)
pyListSlice :: forall (r :: * -> *).
(RenderSym r, Monad r) =>
SVariable r
-> SValue r -> SValue r -> SValue r -> SValue r -> MS (r Doc)
pyListSlice SVariable r
vn SValue r
vo SValue r
beg SValue r
end SValue r
step = 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 a b. (a -> b) -> a -> b
$ do
  r (Variable r)
vnew <- SVariable r
vn
  r (Value r)
vold <- SValue r
vo
  r (Value r)
b <- SValue r
beg
  r (Value r)
e <- SValue r
end
  r (Value r)
s <- SValue r
step
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (r :: * -> *) a. Monad r => a -> r a
toCode forall a b. (a -> b) -> a -> b
$ forall (r :: * -> *). InternalVarElim r => r (Variable r) -> Doc
RC.variable r (Variable r)
vnew Doc -> Doc -> Doc
<+> Doc
equals Doc -> Doc -> Doc
<+> forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value r (Value r)
vold Doc -> Doc -> Doc
<> 
    Doc -> Doc
brackets (forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value r (Value r)
b Doc -> Doc -> Doc
<> Doc
colon Doc -> Doc -> Doc
<> forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value r (Value r)
e Doc -> Doc -> Doc
<> Doc
colon Doc -> Doc -> Doc
<> forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value r (Value r)
s)

pyMethod :: (RenderSym r) => Label -> r (Variable r) -> [r (Parameter r)] ->
  r (Body r) -> Doc
pyMethod :: forall (r :: * -> *).
RenderSym r =>
String -> r (Variable r) -> [r (Parameter r)] -> r (Body r) -> Doc
pyMethod String
n r (Variable r)
slf [r (Parameter r)]
ps r (Body r)
b = [Doc] -> Doc
vcat [
  Doc
pyDef Doc -> Doc -> Doc
<+> String -> Doc
text String
n Doc -> Doc -> Doc
<> Doc -> Doc
parens (forall (r :: * -> *). InternalVarElim r => r (Variable r) -> Doc
RC.variable r (Variable r)
slf Doc -> Doc -> Doc
<> Doc
oneParam Doc -> Doc -> Doc
<> Doc
pms) Doc -> Doc -> Doc
<> Doc
colon,
  Doc -> Doc
indent Doc
bodyD]
      where pms :: Doc
pms = forall (r :: * -> *). RenderSym r => [r (Parameter r)] -> Doc
parameterList [r (Parameter r)]
ps
            oneParam :: Doc
oneParam = Doc -> Doc -> Doc
emptyIfEmpty Doc
pms Doc
listSep'
            bodyD :: Doc
bodyD | Doc -> Bool
isEmpty (forall (r :: * -> *). BodyElim r => r (Body r) -> Doc
RC.body r (Body r)
b) = Doc
pyNull'
                  | Bool
otherwise = forall (r :: * -> *). BodyElim r => r (Body r) -> Doc
RC.body r (Body r)
b

pyFunction :: (RenderSym r) => Label -> [r (Parameter r)] -> r (Body r) -> Doc
pyFunction :: forall (r :: * -> *).
RenderSym r =>
String -> [r (Parameter r)] -> r (Body r) -> Doc
pyFunction String
n [r (Parameter r)]
ps r (Body r)
b = [Doc] -> Doc
vcat [
  Doc
pyDef Doc -> Doc -> Doc
<+> String -> Doc
text String
n Doc -> Doc -> Doc
<> Doc -> Doc
parens (forall (r :: * -> *). RenderSym r => [r (Parameter r)] -> Doc
parameterList [r (Parameter r)]
ps) Doc -> Doc -> Doc
<> Doc
colon,
  Doc -> Doc
indent Doc
bodyD]
  where bodyD :: Doc
bodyD | Doc -> Bool
isEmpty (forall (r :: * -> *). BodyElim r => r (Body r) -> Doc
RC.body r (Body r)
b) = Doc
pyNull'
              | Bool
otherwise = forall (r :: * -> *). BodyElim r => r (Body r) -> Doc
RC.body r (Body r)
b

pyClass :: Label -> Doc -> Doc -> Doc -> Doc -> Doc
pyClass :: String -> Doc -> Doc -> Doc -> Doc -> Doc
pyClass String
n Doc
pn Doc
s Doc
vs Doc
fs = [Doc] -> Doc
vcat [
  Doc
s Doc -> Doc -> Doc
<+> Doc
classDec Doc -> Doc -> Doc
<+> String -> Doc
text String
n Doc -> Doc -> Doc
<> Doc
pn Doc -> Doc -> Doc
<> Doc
colon,
  Doc -> Doc
indent Doc
funcSec]
  where funcSec :: Doc
funcSec | Doc -> Bool
isEmpty (Doc
vs Doc -> Doc -> Doc
<> Doc
fs) = Doc
pyNull'
                | Doc -> Bool
isEmpty Doc
vs = Doc
fs
                | Doc -> Bool
isEmpty Doc
fs = Doc
vs
                | Bool
otherwise = [Doc] -> Doc
vcat [Doc
vs, Doc
blank, Doc
fs]

pyBlockComment :: [String] -> Doc -> Doc
pyBlockComment :: [String] -> Doc -> Doc
pyBlockComment [String]
lns Doc
cmt = [Doc] -> Doc
vcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Doc -> Doc -> Doc
(<+>) Doc
cmt forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Doc
text) [String]
lns

pyDocComment :: [String] -> Doc -> Doc -> Doc
pyDocComment :: [String] -> Doc -> Doc -> Doc
pyDocComment [] Doc
_ Doc
_ = Doc
empty
pyDocComment (String
l:[String]
lns) Doc
start Doc
mid = [Doc] -> Doc
vcat forall a b. (a -> b) -> a -> b
$ Doc
start Doc -> Doc -> Doc
<+> String -> Doc
text String
l forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (Doc -> Doc -> Doc
(<+>) Doc
mid forall b c a. (b -> c) -> (a -> b) -> a -> c
. 
  String -> Doc
text) [String]
lns