{-# LANGUAGE TypeFamilies #-}

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

import Utils.Drasil (blank, indent)

import Drasil.GOOL.CodeType (CodeType(..))
import Drasil.GOOL.InterfaceCommon (SharedProg, Label, Library, VSType,
  VSFunction, SVariable, SValue, MSStatement, MixedCtorCall, BodySym(..),
  BlockSym(..), TypeSym(..), TypeElim(..), VariableSym(..), VisibilitySym(..),
  VariableElim(..), ValueSym(..), Argument(..), Literal(..), litZero,
  MathConstant(..), VariableValue(..), CommandLineArgs(..),
  NumericExpression(..), BooleanExpression(..), Comparison(..),
  ValueExpression(..), funcApp, extFuncApp, List(..), Set(..), InternalList(..),
  ThunkSym(..), VectorType(..), VectorDecl(..), VectorThunk(..),
  VectorExpression(..), ThunkAssign(..), StatementSym(..), AssignStatement(..),
  (&=), DeclStatement(..), IOStatement(..), StringStatement(..),
  FunctionSym(..), FuncAppStatement(..), CommentStatement(..),
  ControlStatement(..), switchAsIf, ScopeSym(..), ParameterSym(..),
  MethodSym(..))
import Drasil.GOOL.InterfaceGOOL (OOProg, ProgramSym(..), FileSym(..),
  ModuleSym(..), ClassSym(..), OOTypeSym(..), OOVariableSym(..),
  StateVarSym(..), PermanenceSym(..), OOValueSym, OOVariableValue,
  InternalValueExp(..), extNewObj, objMethodCall, OOFunctionSym(..), GetSet(..),
  OOValueExpression(..), selfFuncApp, OODeclStatement(..),
  OOFuncAppStatement(..), ObserverPattern(..), StrategyPattern(..),
  OOMethodSym(..))
import Drasil.GOOL.RendererClassesCommon (CommonRenderSym, ImportSym(..),
  ImportElim, RenderBody(..), BodyElim, RenderBlock(..),
  BlockElim, RenderType(..), InternalTypeElim, UnaryOpSym(..), BinaryOpSym(..),
  OpElim(uOpPrec, bOpPrec), RenderVariable(..), InternalVarElim(variableBind),
  RenderValue(..), ValueElim(valuePrec, valueInt), InternalListFunc(..),
  RenderFunction(..), FunctionElim(functionType), InternalAssignStmt(..),
  InternalIOStmt(..), InternalControlStmt(..), RenderStatement(..),
  StatementElim(statementTerm), RenderVisibility(..), VisibilityElim,
  MethodTypeSym(..), RenderParam(..), ParamElim(parameterName, parameterType),
  RenderMethod(..), MethodElim, BlockCommentSym(..), BlockCommentElim,
  ScopeElim(..))
import qualified Drasil.GOOL.RendererClassesCommon as RC (import', body, block, 
  type', uOp, bOp, variable, value, function, statement, visibility, parameter,
  method, blockComment')
import Drasil.GOOL.RendererClassesOO (OORenderSym, RenderFile(..),
  PermElim(binding), InternalGetSet(..), OOMethodTypeSym(..),
  OORenderMethod(..), StateVarElim, RenderClass(..), ClassElim, RenderMod(..),
  ModuleElim)
import qualified Drasil.GOOL.RendererClassesOO as RC (perm, stateVar, class',
  module')
import Drasil.GOOL.LanguageRenderer (classDec, dot, ifLabel, elseLabel, 
  forLabel, inLabel, whileLabel, tryLabel, importLabel, exceptionObj', listSep',
  argv, printLabel, listSep, piLabel, access, functionDox, variableList, 
  parameterList)
import qualified Drasil.GOOL.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, var)
import Drasil.GOOL.LanguageRenderer.Constructors (mkStmtNoEnd, mkStateVal, 
  mkVal, mkStateVar, VSOp, unOpPrec, powerPrec, multPrec, andPrec, orPrec, inPrec, 
  unExpr, unExpr', typeUnExpr, binExpr, typeBinExpr, mkStaticVar)
import qualified Drasil.GOOL.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, local)
import qualified Drasil.GOOL.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', listSize, intToIndex, indexToInt,
  varDecDef, openFileR', openFileW', openFileA', argExists, forEach', global, setMethodCall)
import qualified Drasil.GOOL.LanguageRenderer.Macros as M (ifExists, 
  decrement1, increment1, runStrategy, stringListVals, stringListLists, 
  notifyObservers')
import Drasil.GOOL.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,
  ScopeData)
import Drasil.GOOL.Helpers (vibcat, emptyIfEmpty, toCode, toState, onCodeValue,
  onStateValue, on2CodeValues, on2StateValues, onCodeList, onStateList,
  on2StateWrapped)
import Drasil.GOOL.State (MS, VS, lensGStoFS, lensMStoVS, lensVStoMS, revFiles,
  addLangImportVS, getLangImports, addLibImportVS, getLibImports, addModuleImport,
  addModuleImportVS, getModuleImports, setFileType, getClassName, setCurrMain,
  getClassMap, getMainDoc, genLoopIndex, varNameAvailable)

import Prelude hiding (break,print,sin,cos,tan,floor,(<>))
import Data.Maybe (fromMaybe)
import Control.Lens.Zoom (zoom)
import Control.Monad (join)
import Control.Monad.State (modify)
import Data.List (intercalate, sort)
import Data.Char (toUpper, isUpper, isLower)
import qualified Data.Map as Map (lookup)
import Text.PrettyPrint.HughesPJ (Doc, text, (<>), (<+>), parens, empty, equals,
  vcat, colon, brackets, isEmpty, quotes, comma, braces)
import Drasil.GOOL.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) = b -> PythonCode b
forall a. a -> PythonCode a
PC (a -> b
f a
x)

instance Applicative PythonCode where
  pure :: forall a. a -> PythonCode a
pure = a -> PythonCode a
forall a. a -> PythonCode a
PC
  (PC a -> b
f) <*> :: forall a b. PythonCode (a -> b) -> PythonCode a -> PythonCode b
<*> (PC a
x) = b -> PythonCode b
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 SharedProg PythonCode
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 <- (StateT FileState Identity (PythonCode FileData)
 -> StateT GOOLState Identity (PythonCode FileData))
-> [StateT FileState Identity (PythonCode FileData)]
-> StateT GOOLState Identity [PythonCode FileData]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (LensLike'
  (Zoomed (StateT FileState Identity) (PythonCode FileData))
  GOOLState
  FileState
-> StateT FileState Identity (PythonCode FileData)
-> StateT GOOLState Identity (PythonCode FileData)
forall c.
LensLike'
  (Zoomed (StateT FileState Identity) c) GOOLState FileState
-> StateT FileState Identity c -> StateT GOOLState Identity c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (StateT FileState Identity) (PythonCode FileData))
  GOOLState
  FileState
(FileState -> Focusing Identity (PythonCode FileData) FileState)
-> GOOLState -> Focusing Identity (PythonCode FileData) GOOLState
Lens' GOOLState FileState
lensGStoFS) [StateT FileState Identity (PythonCode FileData)]
[SFile PythonCode]
files
    (GOOLState -> GOOLState) -> StateT GOOLState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify GOOLState -> GOOLState
revFiles
    PythonCode ProgData
-> StateT GOOLState Identity (PythonCode ProgData)
forall a. a -> StateT GOOLState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PythonCode ProgData
 -> StateT GOOLState Identity (PythonCode ProgData))
-> PythonCode ProgData
-> StateT GOOLState Identity (PythonCode ProgData)
forall a b. (a -> b) -> a -> b
$ ([FileData] -> ProgData)
-> [PythonCode FileData] -> PythonCode ProgData
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 CommonRenderSym PythonCode
instance OORenderSym PythonCode

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

  docMod :: String
-> [String] -> String -> SFile PythonCode -> SFile PythonCode
docMod = String
-> String
-> [String]
-> String
-> SFile PythonCode
-> SFile PythonCode
forall (r :: * -> *).
OORenderSym 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)
_ = Doc -> PythonCode Doc
forall (r :: * -> *) a. Monad r => a -> r a
toCode Doc
empty
  bottom :: PythonCode (Block PythonCode)
bottom = Doc -> PythonCode Doc
forall (r :: * -> *) a. Monad r => a -> r a
toCode Doc
empty
  
  commentedMod :: SFile PythonCode
-> FS (PythonCode (BlockComment PythonCode)) -> SFile PythonCode
commentedMod = (PythonCode FileData -> PythonCode Doc -> PythonCode FileData)
-> StateT FileState Identity (PythonCode FileData)
-> State FileState (PythonCode Doc)
-> StateT FileState Identity (PythonCode FileData)
forall a b c s.
(a -> b -> c) -> State s a -> State s b -> State s c
on2StateValues ((FileData -> Doc -> FileData)
-> PythonCode FileData -> PythonCode Doc -> PythonCode FileData
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 = (String
 -> PythonCode (Module PythonCode) -> PythonCode (File PythonCode))
-> String -> FSModule PythonCode -> SFile PythonCode
forall (r :: * -> *).
OORenderSym r =>
(String -> r (Module r) -> r (File r))
-> String -> FSModule r -> SFile r
G.fileFromData ((ModData -> FileData) -> PythonCode ModData -> PythonCode FileData
forall (r :: * -> *) a b. Functor r => (a -> b) -> r a -> r b
onCodeValue ((ModData -> FileData)
 -> PythonCode ModData -> PythonCode FileData)
-> (String -> ModData -> FileData)
-> String
-> PythonCode ModData
-> PythonCode FileData
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 = Doc -> PythonCode Doc
forall (r :: * -> *) a. Monad r => a -> r a
toCode (Doc -> PythonCode Doc) -> Doc -> PythonCode Doc
forall a b. (a -> b) -> a -> b
$ Doc
importLabel Doc -> Doc -> Doc
<+> String -> Doc
text String
n
  modImport :: String -> PythonCode (Import PythonCode)
modImport = String -> PythonCode (Import PythonCode)
forall (r :: * -> *). ImportSym r => String -> r (Import r)
langImport

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

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

instance PermElim PythonCode where
  perm :: PythonCode (Permanence PythonCode) -> Doc
perm = PythonCode Doc -> Doc
PythonCode (Permanence PythonCode) -> Doc
forall a. PythonCode a -> a
unPC
  binding :: PythonCode (Permanence PythonCode) -> Binding
binding = String -> PythonCode (Permanence PythonCode) -> Binding
forall a. HasCallStack => String -> a
error (String -> PythonCode (Permanence PythonCode) -> Binding)
-> String -> PythonCode (Permanence PythonCode) -> Binding
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 = ([PythonCode Doc] -> PythonCode Doc)
-> [State MethodState (PythonCode Doc)]
-> State MethodState (PythonCode Doc)
forall a b s. ([a] -> b) -> [State s a] -> State s b
onStateList (([Doc] -> Doc) -> [PythonCode Doc] -> PythonCode Doc
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 = (PythonCode Doc -> PythonCode Doc)
-> State MethodState (PythonCode Doc)
-> State MethodState (PythonCode Doc)
forall a b s. (a -> b) -> State s a -> State s b
onStateValue ((Doc -> Doc) -> PythonCode Doc -> PythonCode Doc
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 = [MSBody PythonCode] -> State MethodState (PythonCode Doc)
[MSBody PythonCode] -> MSBody PythonCode
forall (r :: * -> *).
(CommonRenderSym r, Monad r) =>
[MSBody r] -> MS (r Doc)
G.multiBody 

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

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

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

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

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

instance OOTypeSym PythonCode where
  obj :: String -> VSType PythonCode
obj = String -> VSType PythonCode
forall (r :: * -> *). CommonRenderSym r => String -> VSType r
G.obj

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

instance RenderType PythonCode where
  multiType :: [VSType PythonCode] -> VSType PythonCode
multiType [VSType PythonCode]
_ = CodeType -> String -> Doc -> 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 = PythonCode (Type PythonCode) -> VSType PythonCode
forall a s. a -> State s a
toState (PythonCode (Type PythonCode) -> VSType PythonCode)
-> PythonCode (Type PythonCode) -> VSType PythonCode
forall a b. (a -> b) -> a -> b
$ TypeData -> PythonCode TypeData
forall (r :: * -> *) a. Monad r => a -> r a
toCode (TypeData -> PythonCode TypeData)
-> TypeData -> PythonCode TypeData
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 (TypeData -> Doc)
-> (PythonCode TypeData -> TypeData) -> PythonCode TypeData -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PythonCode TypeData -> TypeData
forall a. PythonCode a -> a
unPC

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

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

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

instance ScopeSym PythonCode where
  type Scope PythonCode = ScopeData
  global :: PythonCode (Scope PythonCode)
global = PythonCode ScopeData
PythonCode (Scope PythonCode)
forall (r :: * -> *). Monad r => r ScopeData
CP.global
  mainFn :: PythonCode (Scope PythonCode)
mainFn = PythonCode (Scope PythonCode)
forall (r :: * -> *). ScopeSym r => r (Scope r)
global
  local :: PythonCode (Scope PythonCode)
local = PythonCode ScopeData
PythonCode (Scope PythonCode)
forall (r :: * -> *). Monad r => r ScopeData
G.local

instance ScopeElim PythonCode where
  scopeData :: PythonCode (Scope PythonCode) -> ScopeData
scopeData = PythonCode ScopeData -> ScopeData
PythonCode (Scope PythonCode) -> ScopeData
forall a. PythonCode a -> a
unPC

instance VariableSym PythonCode where
  type Variable PythonCode = VarData
  var :: String -> VSType PythonCode -> SVariable PythonCode
var          = String -> VSType PythonCode -> SVariable PythonCode
forall (r :: * -> *).
CommonRenderSym r =>
String -> VSType r -> SVariable r
G.var
  constant :: String -> VSType PythonCode -> SVariable PythonCode
constant String
n   = String -> VSType PythonCode -> SVariable PythonCode
forall (r :: * -> *).
VariableSym r =>
String -> VSType r -> SVariable r
var (String -> VSType PythonCode -> SVariable PythonCode)
-> String -> VSType PythonCode -> SVariable PythonCode
forall a b. (a -> b) -> a -> b
$ String -> String
toConstName String
n
  extVar :: String -> String -> VSType PythonCode -> SVariable PythonCode
extVar String
l String
n VSType PythonCode
t = (ValueState -> ValueState) -> StateT ValueState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (String -> ValueState -> ValueState
addModuleImportVS String
l) StateT ValueState Identity ()
-> StateT ValueState Identity (PythonCode VarData)
-> StateT ValueState Identity (PythonCode VarData)
forall a b.
StateT ValueState Identity a
-> StateT ValueState Identity b -> StateT ValueState Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> String -> VSType PythonCode -> SVariable PythonCode
forall (r :: * -> *).
CommonRenderSym r =>
String -> String -> VSType r -> SVariable r
CP.extVar String
l String
n VSType PythonCode
t
  arrayElem :: Integer -> SVariable PythonCode -> SVariable PythonCode
arrayElem Integer
i  = SValue PythonCode -> SVariable PythonCode -> SVariable PythonCode
forall (r :: * -> *).
OORenderSym r =>
SValue r -> SVariable r -> SVariable r
G.arrayElem (Integer -> SValue PythonCode
forall (r :: * -> *). Literal r => Integer -> SValue r
litInt Integer
i)

instance OOVariableSym PythonCode where
  staticVar' :: Bool -> String -> VSType PythonCode -> SVariable PythonCode
staticVar' Bool
c String
n VSType PythonCode
t = if Bool
c then String -> VSType PythonCode -> Doc -> SVariable PythonCode
forall (r :: * -> *).
CommonRenderSym r =>
String -> VSType r -> Doc -> SVariable r
mkStaticVar String
n VSType PythonCode
t (String -> Doc
R.var (String -> String
toConstName String
n))
                          else String -> VSType PythonCode -> SVariable PythonCode
forall (r :: * -> *).
CommonRenderSym r =>
String -> VSType r -> SVariable r
G.staticVar String
n VSType PythonCode
t
  self :: SVariable PythonCode
self = LensLike'
  (Zoomed (StateT MethodState Identity) String)
  ValueState
  MethodState
-> StateT MethodState Identity String
-> StateT ValueState Identity String
forall c.
LensLike'
  (Zoomed (StateT MethodState Identity) c) ValueState MethodState
-> StateT MethodState Identity c -> StateT ValueState Identity c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (StateT MethodState Identity) String)
  ValueState
  MethodState
(MethodState -> Focusing Identity String MethodState)
-> ValueState -> Focusing Identity String ValueState
Lens' ValueState MethodState
lensVStoMS StateT MethodState Identity String
getClassName StateT ValueState Identity String
-> (String -> StateT ValueState Identity (PythonCode VarData))
-> StateT ValueState Identity (PythonCode VarData)
forall a b.
StateT ValueState Identity a
-> (a -> StateT ValueState Identity b)
-> StateT ValueState Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\String
l -> String -> VSType PythonCode -> Doc -> SVariable PythonCode
forall (r :: * -> *).
CommonRenderSym r =>
String -> VSType r -> Doc -> SVariable r
mkStateVar String
pySelf (String -> VSType PythonCode
forall (r :: * -> *). OOTypeSym r => String -> VSType r
obj String
l) (String -> Doc
text String
pySelf))
  classVar :: VSType PythonCode -> SVariable PythonCode -> SVariable PythonCode
classVar = (Doc -> Doc -> Doc)
-> VSType PythonCode
-> SVariable PythonCode
-> SVariable PythonCode
forall (r :: * -> *).
CommonRenderSym 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 = StateT ValueState Identity (SVariable PythonCode)
-> SVariable PythonCode
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (StateT ValueState Identity (SVariable PythonCode)
 -> SVariable PythonCode)
-> StateT ValueState Identity (SVariable PythonCode)
-> SVariable PythonCode
forall a b. (a -> b) -> a -> b
$ (PythonCode (Type PythonCode)
 -> Map String String
 -> StateT ValueState Identity (PythonCode VarData))
-> VSType PythonCode
-> State ValueState (Map String String)
-> State
     ValueState (StateT ValueState Identity (PythonCode VarData))
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 -> (StateT ValueState Identity (PythonCode VarData)
 -> StateT ValueState Identity (PythonCode VarData))
-> (String
    -> StateT ValueState Identity (PythonCode VarData)
    -> StateT ValueState Identity (PythonCode VarData))
-> Maybe String
-> StateT ValueState Identity (PythonCode VarData)
-> StateT ValueState Identity (PythonCode VarData)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe StateT ValueState Identity (PythonCode VarData)
-> StateT ValueState Identity (PythonCode VarData)
forall a. a -> a
id (StateT ValueState Identity ()
-> StateT ValueState Identity (PythonCode VarData)
-> StateT ValueState Identity (PythonCode VarData)
forall a b.
StateT ValueState Identity a
-> StateT ValueState Identity b -> StateT ValueState Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
(>>) (StateT ValueState Identity ()
 -> StateT ValueState Identity (PythonCode VarData)
 -> StateT ValueState Identity (PythonCode VarData))
-> (String -> StateT ValueState Identity ())
-> String
-> StateT ValueState Identity (PythonCode VarData)
-> StateT ValueState Identity (PythonCode VarData)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ValueState -> ValueState) -> StateT ValueState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((ValueState -> ValueState) -> StateT ValueState Identity ())
-> (String -> ValueState -> ValueState)
-> String
-> StateT ValueState Identity ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 
    String -> ValueState -> ValueState
addModuleImportVS) (String -> Map String String -> Maybe String
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (PythonCode (Type PythonCode) -> String
forall (r :: * -> *). TypeElim r => r (Type r) -> String
getTypeString PythonCode (Type PythonCode)
t) Map String String
cm) (StateT ValueState Identity (PythonCode VarData)
 -> StateT ValueState Identity (PythonCode VarData))
-> StateT ValueState Identity (PythonCode VarData)
-> StateT ValueState Identity (PythonCode VarData)
forall a b. (a -> b) -> a -> b
$ 
    (Doc -> Doc -> Doc)
-> VSType PythonCode
-> SVariable PythonCode
-> SVariable PythonCode
forall (r :: * -> *).
CommonRenderSym r =>
(Doc -> Doc -> Doc) -> VSType r -> SVariable r -> SVariable r
CP.classVar Doc -> Doc -> Doc
pyClassVar (PythonCode (Type PythonCode) -> VSType PythonCode
forall a s. a -> State s a
toState PythonCode (Type PythonCode)
t) SVariable PythonCode
v) VSType PythonCode
c State ValueState (Map String String)
getClassMap
  objVar :: SVariable PythonCode
-> SVariable PythonCode -> SVariable PythonCode
objVar = SVariable PythonCode
-> SVariable PythonCode -> SVariable PythonCode
forall (r :: * -> *).
CommonRenderSym r =>
SVariable r -> SVariable r -> SVariable r
G.objVar
  objVarSelf :: SVariable PythonCode -> SVariable PythonCode
objVarSelf = SVariable PythonCode -> SVariable PythonCode
forall (r :: * -> *). OORenderSym r => SVariable r -> SVariable r
CP.objVarSelf

instance VariableElim PythonCode where
  variableName :: PythonCode (Variable PythonCode) -> String
variableName = VarData -> String
varName (VarData -> String)
-> (PythonCode VarData -> VarData) -> PythonCode VarData -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PythonCode VarData -> VarData
forall a. PythonCode a -> a
unPC
  variableType :: PythonCode (Variable PythonCode) -> PythonCode (Type PythonCode)
variableType = (VarData -> TypeData) -> PythonCode VarData -> PythonCode TypeData
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 (VarData -> Binding)
-> (PythonCode VarData -> VarData) -> PythonCode VarData -> Binding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PythonCode VarData -> VarData
forall a. PythonCode a -> a
unPC
  variable :: PythonCode (Variable PythonCode) -> Doc
variable = VarData -> Doc
varDoc (VarData -> Doc)
-> (PythonCode VarData -> VarData) -> PythonCode VarData -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PythonCode VarData -> VarData
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 <- StateT ValueState Identity (PythonCode TypeData)
VSType PythonCode
t'
    PythonCode VarData
-> StateT ValueState Identity (PythonCode VarData)
forall a s. a -> State s a
toState (PythonCode VarData
 -> StateT ValueState Identity (PythonCode VarData))
-> PythonCode VarData
-> StateT ValueState Identity (PythonCode VarData)
forall a b. (a -> b) -> a -> b
$ (TypeData -> Doc -> VarData)
-> PythonCode TypeData -> PythonCode Doc -> PythonCode VarData
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 (Doc -> PythonCode Doc
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 = (ValData -> TypeData) -> PythonCode ValData -> PythonCode TypeData
forall (r :: * -> *) a b. Functor r => (a -> b) -> r a -> r b
onCodeValue ValData -> TypeData
valType

instance OOValueSym PythonCode

instance Argument PythonCode where
  pointerArg :: SValue PythonCode -> SValue PythonCode
pointerArg = VS (PythonCode ValData) -> VS (PythonCode ValData)
SValue PythonCode -> SValue PythonCode
forall a. a -> a
id

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

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

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

instance OOVariableValue PythonCode

instance CommandLineArgs PythonCode where
  arg :: Integer -> SValue PythonCode
arg Integer
n = SValue PythonCode -> SValue PythonCode -> SValue PythonCode
forall (r :: * -> *).
CommonRenderSym r =>
SValue r -> SValue r -> SValue r
G.arg (Integer -> SValue PythonCode
forall (r :: * -> *). Literal r => Integer -> SValue r
litInt (Integer -> SValue PythonCode) -> Integer -> SValue PythonCode
forall a b. (a -> b) -> a -> b
$ Integer
nInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
1) SValue PythonCode
forall (r :: * -> *). CommandLineArgs r => SValue r
argsList
  argsList :: SValue PythonCode
argsList = do
    (ValueState -> ValueState) -> StateT ValueState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (String -> ValueState -> ValueState
addLangImportVS String
pySys)
    String -> SValue PythonCode
forall (r :: * -> *). CommonRenderSym r => String -> SValue r
G.argsList (String -> SValue PythonCode) -> String -> SValue PythonCode
forall a b. (a -> b) -> a -> b
$ String
pySys String -> String -> String
`access` String
argv
  argExists :: Integer -> SValue PythonCode
argExists = Integer -> SValue PythonCode
forall (r :: * -> *). CommonRenderSym r => Integer -> SValue r
CP.argExists

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

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

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

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

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

  funcAppMixedArgs :: MixedCall PythonCode
funcAppMixedArgs = MixedCall PythonCode
forall (r :: * -> *). CommonRenderSym r => MixedCall r
G.funcAppMixedArgs
  extFuncAppMixedArgs :: String -> MixedCall PythonCode
extFuncAppMixedArgs String
l String
n VSType PythonCode
t [SValue PythonCode]
ps NamedArgs PythonCode
ns = do
    (ValueState -> ValueState) -> StateT ValueState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (String -> ValueState -> ValueState
addModuleImportVS String
l)
    String -> MixedCall PythonCode
forall (r :: * -> *). CommonRenderSym 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
    (ValueState -> ValueState) -> StateT ValueState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (String -> ValueState -> ValueState
addLibImportVS String
l)
    String -> MixedCall PythonCode
forall (r :: * -> *). CommonRenderSym r => String -> MixedCall r
CP.extFuncAppMixedArgs String
l String
n VSType PythonCode
t [SValue PythonCode]
ps NamedArgs PythonCode
ns

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

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

instance OOValueExpression PythonCode where
  selfFuncAppMixedArgs :: MixedCall PythonCode
selfFuncAppMixedArgs = Doc -> SVariable PythonCode -> MixedCall PythonCode
forall (r :: * -> *).
CommonRenderSym r =>
Doc -> SVariable r -> MixedCall r
G.selfFuncAppMixedArgs Doc
dot SVariable PythonCode
forall (r :: * -> *). OOVariableSym r => SVariable r
self
  newObjMixedArgs :: MixedCtorCall PythonCode
newObjMixedArgs = MixedCall PythonCode
forall (r :: * -> *). CommonRenderSym r => MixedCall r
G.newObjMixedArgs String
""
  extNewObjMixedArgs :: MixedCall PythonCode
extNewObjMixedArgs String
l VSType PythonCode
tp [SValue PythonCode]
ps NamedArgs PythonCode
ns = do
    (ValueState -> ValueState) -> StateT ValueState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (String -> ValueState -> ValueState
addModuleImportVS String
l)
    MixedCall PythonCode
forall (r :: * -> *). CommonRenderSym 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
    (ValueState -> ValueState) -> StateT ValueState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (String -> ValueState -> ValueState
addLibImportVS String
l)
    MixedCall PythonCode
forall (r :: * -> *). CommonRenderSym r => MixedCall r
pyExtNewObjMixedArgs String
l VSType PythonCode
tp [SValue PythonCode]
ps NamedArgs PythonCode
ns

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

  valFromData :: Maybe Int
-> Maybe Integer -> VSType PythonCode -> Doc -> SValue PythonCode
valFromData Maybe Int
p Maybe Integer
i VSType PythonCode
t' Doc
d = do 
    PythonCode TypeData
t <- StateT ValueState Identity (PythonCode TypeData)
VSType PythonCode
t'
    PythonCode ValData -> VS (PythonCode ValData)
forall a s. a -> State s a
toState (PythonCode ValData -> VS (PythonCode ValData))
-> PythonCode ValData -> VS (PythonCode ValData)
forall a b. (a -> b) -> a -> b
$ (TypeData -> Doc -> ValData)
-> PythonCode TypeData -> PythonCode Doc -> PythonCode ValData
forall (r :: * -> *) a b c.
Applicative r =>
(a -> b -> c) -> r a -> r b -> r c
on2CodeValues (Maybe Int -> Maybe Integer -> TypeData -> Doc -> ValData
vd Maybe Int
p Maybe Integer
i) PythonCode TypeData
t (Doc -> PythonCode Doc
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 (ValData -> Maybe Int)
-> (PythonCode ValData -> ValData)
-> PythonCode ValData
-> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PythonCode ValData -> ValData
forall a. PythonCode a -> a
unPC
  valueInt :: PythonCode (Value PythonCode) -> Maybe Integer
valueInt = ValData -> Maybe Integer
valInt (ValData -> Maybe Integer)
-> (PythonCode ValData -> ValData)
-> PythonCode ValData
-> Maybe Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PythonCode ValData -> ValData
forall a. PythonCode a -> a
unPC
  value :: PythonCode (Value PythonCode) -> Doc
value = ValData -> Doc
val (ValData -> Doc)
-> (PythonCode ValData -> ValData) -> PythonCode ValData -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PythonCode ValData -> ValData
forall a. PythonCode a -> a
unPC

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

instance FunctionSym PythonCode where
  type Function PythonCode = FuncData

instance OOFunctionSym PythonCode where
  func :: String
-> VSType PythonCode
-> [SValue PythonCode]
-> VSFunction PythonCode
func = String
-> VSType PythonCode
-> [SValue PythonCode]
-> VSFunction PythonCode
forall (r :: * -> *).
CommonRenderSym r =>
String -> VSType r -> [SValue r] -> VSFunction r
G.func
  objAccess :: SValue PythonCode -> VSFunction PythonCode -> SValue PythonCode
objAccess = SValue PythonCode -> VSFunction PythonCode -> SValue PythonCode
forall (r :: * -> *).
CommonRenderSym r =>
SValue r -> VSFunction r -> SValue r
G.objAccess

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

instance List PythonCode where
  intToIndex :: SValue PythonCode -> SValue PythonCode
intToIndex = SValue PythonCode -> SValue PythonCode
forall (r :: * -> *). SValue r -> SValue r
CP.intToIndex
  indexToInt :: SValue PythonCode -> SValue PythonCode
indexToInt = SValue PythonCode -> SValue PythonCode
forall (r :: * -> *). SValue r -> SValue r
CP.indexToInt
  listSize :: SValue PythonCode -> SValue PythonCode
listSize = SValue PythonCode -> SValue PythonCode
forall (r :: * -> *). CommonRenderSym r => SValue r -> SValue r
CP.listSize
  listAdd :: SValue PythonCode
-> SValue PythonCode -> SValue PythonCode -> SValue PythonCode
listAdd = SValue PythonCode
-> SValue PythonCode -> SValue PythonCode -> SValue PythonCode
forall (r :: * -> *).
OORenderSym r =>
SValue r -> SValue r -> SValue r -> SValue r
G.listAdd
  listAppend :: SValue PythonCode -> SValue PythonCode -> SValue PythonCode
listAppend = SValue PythonCode -> SValue PythonCode -> SValue PythonCode
forall (r :: * -> *).
OORenderSym r =>
SValue r -> SValue r -> SValue r
G.listAppend
  listAccess :: SValue PythonCode -> SValue PythonCode -> SValue PythonCode
listAccess = SValue PythonCode -> SValue PythonCode -> SValue PythonCode
forall (r :: * -> *).
CommonRenderSym r =>
SValue r -> SValue r -> SValue r
G.listAccess
  listSet :: SValue PythonCode
-> SValue PythonCode -> SValue PythonCode -> SValue PythonCode
listSet = SValue PythonCode
-> SValue PythonCode -> SValue PythonCode -> SValue PythonCode
forall (r :: * -> *).
CommonRenderSym r =>
SValue r -> SValue r -> SValue r -> SValue r
G.listSet
  indexOf :: SValue PythonCode -> SValue PythonCode -> SValue PythonCode
indexOf = String
-> SValue PythonCode -> SValue PythonCode -> SValue PythonCode
forall (r :: * -> *).
OORenderSym r =>
String -> SValue r -> SValue r -> SValue r
CP.indexOf String
pyIndex

instance Set PythonCode where
  contains :: SValue PythonCode -> SValue PythonCode -> SValue PythonCode
contains SValue PythonCode
a SValue PythonCode
b = VSBinOp PythonCode
-> VSType PythonCode
-> SValue PythonCode
-> SValue PythonCode
-> SValue PythonCode
forall (r :: * -> *).
CommonRenderSym r =>
VSBinOp r -> VSType r -> SValue r -> SValue r -> SValue r
typeBinExpr (String -> VSOp PythonCode
forall (r :: * -> *). Monad r => String -> VSOp r
inPrec String
pyIn) VSType PythonCode
forall (r :: * -> *). TypeSym r => VSType r
bool SValue PythonCode
b SValue PythonCode
a
  setAdd :: SValue PythonCode -> SValue PythonCode -> SValue PythonCode
setAdd = String
-> SValue PythonCode -> SValue PythonCode -> SValue PythonCode
forall (r :: * -> *).
OORenderSym r =>
String -> SValue r -> SValue r -> SValue r
CP.setMethodCall String
pyAdd
  setRemove :: SValue PythonCode -> SValue PythonCode -> SValue PythonCode
setRemove = String
-> SValue PythonCode -> SValue PythonCode -> SValue PythonCode
forall (r :: * -> *).
OORenderSym r =>
String -> SValue r -> SValue r -> SValue r
CP.setMethodCall String
pyRemove
  setUnion :: SValue PythonCode -> SValue PythonCode -> SValue PythonCode
setUnion = String
-> SValue PythonCode -> SValue PythonCode -> SValue PythonCode
forall (r :: * -> *).
OORenderSym r =>
String -> SValue r -> SValue r -> SValue r
CP.setMethodCall String
pyUnion

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 = SVariable PythonCode
-> SValue PythonCode
-> SValue PythonCode
-> SValue PythonCode
-> SValue PythonCode
-> State MethodState (PythonCode Doc)
forall (r :: * -> *).
(CommonRenderSym 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 = SValue PythonCode -> Maybe (SValue PythonCode) -> SValue PythonCode
forall a. a -> Maybe a -> a
fromMaybe (VSType PythonCode -> Doc -> SValue PythonCode
forall (r :: * -> *).
CommonRenderSym r =>
VSType r -> Doc -> SValue r
mkStateVal VSType PythonCode
forall (r :: * -> *). TypeSym r => VSType r
void Doc
empty)

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

instance InternalListFunc PythonCode where
  listSizeFunc :: SValue PythonCode -> VSFunction PythonCode
listSizeFunc SValue PythonCode
l = do
    PythonCode ValData
f <- PosCall PythonCode
forall (r :: * -> *). ValueExpression r => PosCall r
funcApp String
pyListSize VSType PythonCode
forall (r :: * -> *). TypeSym r => VSType r
int [SValue PythonCode
l]
    Doc -> VSType PythonCode -> VSFunction PythonCode
forall (r :: * -> *).
RenderFunction r =>
Doc -> VSType r -> VSFunction r
funcFromData (PythonCode (Value PythonCode) -> Doc
forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value PythonCode ValData
PythonCode (Value PythonCode)
f) VSType PythonCode
forall (r :: * -> *). TypeSym r => VSType r
int
  listAddFunc :: SValue PythonCode
-> SValue PythonCode -> SValue PythonCode -> VSFunction PythonCode
listAddFunc SValue PythonCode
_ = String
-> SValue PythonCode -> SValue PythonCode -> VSFunction PythonCode
forall (r :: * -> *).
OORenderSym r =>
String -> SValue r -> SValue r -> VSFunction r
CP.listAddFunc String
pyInsert
  listAppendFunc :: SValue PythonCode -> SValue PythonCode -> VSFunction PythonCode
listAppendFunc SValue PythonCode
_ = String -> SValue PythonCode -> VSFunction PythonCode
forall (r :: * -> *).
OORenderSym r =>
String -> SValue r -> VSFunction r
G.listAppendFunc String
pyAppendFunc
  listAccessFunc :: VSType PythonCode -> SValue PythonCode -> VSFunction PythonCode
listAccessFunc = VSType PythonCode -> SValue PythonCode -> VSFunction PythonCode
forall (r :: * -> *).
CommonRenderSym r =>
VSType r -> SValue r -> VSFunction r
CP.listAccessFunc
  listSetFunc :: SValue PythonCode
-> SValue PythonCode -> SValue PythonCode -> VSFunction PythonCode
listSetFunc = (Doc -> Doc -> Doc)
-> SValue PythonCode
-> SValue PythonCode
-> SValue PythonCode
-> VSFunction PythonCode
forall (r :: * -> *).
CommonRenderSym 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 <- StateT MethodState Identity String
genLoopIndex
    let
      i :: SVariable PythonCode
i = String -> VSType PythonCode -> SVariable PythonCode
forall (r :: * -> *).
VariableSym r =>
String -> VSType r -> SVariable r
var String
iName VSType PythonCode
forall (r :: * -> *). TypeSym r => VSType r
int
      dim :: VS (PythonCode ValData)
dim = (ValData -> PythonCode ValData)
-> StateT ValueState Identity ValData -> VS (PythonCode ValData)
forall a b.
(a -> b)
-> StateT ValueState Identity a -> StateT ValueState Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ValData -> PythonCode ValData
forall a. a -> PythonCode a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StateT ValueState Identity ValData -> VS (PythonCode ValData))
-> StateT ValueState Identity ValData -> VS (PythonCode ValData)
forall a b. (a -> b) -> a -> b
$ StateT
  ValueState
  Identity
  (PythonCode (CommonThunk (StateT ValueState Identity)))
VSThunk PythonCode
t StateT
  ValueState
  Identity
  (PythonCode (CommonThunk (StateT ValueState Identity)))
-> (PythonCode (CommonThunk (StateT ValueState Identity))
    -> StateT ValueState Identity ValData)
-> StateT ValueState Identity ValData
forall a b.
StateT ValueState Identity a
-> (a -> StateT ValueState Identity b)
-> StateT ValueState Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (StateT ValueState Identity ValData
 -> StateT ValueState Identity ValData)
-> CommonThunk (StateT ValueState Identity)
-> StateT ValueState Identity ValData
forall (s :: * -> *).
(s ValData -> s ValData) -> CommonThunk s -> s ValData
commonThunkDim ((PythonCode ValData -> ValData)
-> VS (PythonCode ValData) -> StateT ValueState Identity ValData
forall a b.
(a -> b)
-> StateT ValueState Identity a -> StateT ValueState Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PythonCode ValData -> ValData
forall a. PythonCode a -> a
unPC (VS (PythonCode ValData) -> StateT ValueState Identity ValData)
-> (StateT ValueState Identity ValData -> VS (PythonCode ValData))
-> StateT ValueState Identity ValData
-> StateT ValueState Identity ValData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VS (PythonCode ValData) -> VS (PythonCode ValData)
SValue PythonCode -> SValue PythonCode
forall (r :: * -> *). List r => SValue r -> SValue r
listSize (VS (PythonCode ValData) -> VS (PythonCode ValData))
-> (StateT ValueState Identity ValData -> VS (PythonCode ValData))
-> StateT ValueState Identity ValData
-> VS (PythonCode ValData)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ValData -> PythonCode ValData)
-> StateT ValueState Identity ValData -> VS (PythonCode ValData)
forall a b.
(a -> b)
-> StateT ValueState Identity a -> StateT ValueState Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ValData -> PythonCode ValData
forall a. a -> PythonCode a
forall (f :: * -> *) a. Applicative f => a -> f a
pure) (CommonThunk (StateT ValueState Identity)
 -> StateT ValueState Identity ValData)
-> (PythonCode (CommonThunk (StateT ValueState Identity))
    -> CommonThunk (StateT ValueState Identity))
-> PythonCode (CommonThunk (StateT ValueState Identity))
-> StateT ValueState Identity ValData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PythonCode (CommonThunk (StateT ValueState Identity))
-> CommonThunk (StateT ValueState Identity)
forall a. PythonCode a -> a
unPC
      loopInit :: MSStatement PythonCode
loopInit = LensLike'
  (Zoomed
     (StateT ValueState Identity)
     (CommonThunk (StateT ValueState Identity)))
  MethodState
  ValueState
-> StateT
     ValueState Identity (CommonThunk (StateT ValueState Identity))
-> StateT
     MethodState Identity (CommonThunk (StateT ValueState Identity))
forall c.
LensLike'
  (Zoomed (StateT ValueState Identity) c) MethodState ValueState
-> StateT ValueState Identity c -> StateT MethodState Identity c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed
     (StateT ValueState Identity)
     (CommonThunk (StateT ValueState Identity)))
  MethodState
  ValueState
(ValueState
 -> Focusing
      Identity (CommonThunk (StateT ValueState Identity)) ValueState)
-> MethodState
-> Focusing
     Identity (CommonThunk (StateT ValueState Identity)) MethodState
Lens' MethodState ValueState
lensMStoVS ((PythonCode (CommonThunk (StateT ValueState Identity))
 -> CommonThunk (StateT ValueState Identity))
-> StateT
     ValueState
     Identity
     (PythonCode (CommonThunk (StateT ValueState Identity)))
-> StateT
     ValueState Identity (CommonThunk (StateT ValueState Identity))
forall a b.
(a -> b)
-> StateT ValueState Identity a -> StateT ValueState Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PythonCode (CommonThunk (StateT ValueState Identity))
-> CommonThunk (StateT ValueState Identity)
forall a. PythonCode a -> a
unPC StateT
  ValueState
  Identity
  (PythonCode (CommonThunk (StateT ValueState Identity)))
VSThunk PythonCode
t) StateT
  MethodState Identity (CommonThunk (StateT ValueState Identity))
-> (CommonThunk (StateT ValueState Identity)
    -> MSStatement PythonCode)
-> MSStatement PythonCode
forall a b.
StateT MethodState Identity a
-> (a -> StateT MethodState Identity b)
-> StateT MethodState Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (CommonThunk (StateT ValueState Identity)
 -> MSStatement PythonCode)
-> (CommonThunk (StateT ValueState Identity)
    -> MSStatement PythonCode)
-> CommonThunk (StateT ValueState Identity)
-> MSStatement PythonCode
forall (s :: * -> *) a.
(CommonThunk s -> a) -> (CommonThunk s -> a) -> CommonThunk s -> a
commonThunkElim
        (MSStatement PythonCode
-> CommonThunk (StateT ValueState Identity)
-> MSStatement PythonCode
forall a b. a -> b -> a
const MSStatement PythonCode
forall (r :: * -> *). StatementSym r => MSStatement r
emptyStmt) (MSStatement PythonCode
-> CommonThunk (StateT ValueState Identity)
-> MSStatement PythonCode
forall a b. a -> b -> a
const (MSStatement PythonCode
 -> CommonThunk (StateT ValueState Identity)
 -> MSStatement PythonCode)
-> MSStatement PythonCode
-> CommonThunk (StateT ValueState Identity)
-> MSStatement PythonCode
forall a b. (a -> b) -> a -> b
$ SVariable PythonCode -> SValue PythonCode -> MSStatement PythonCode
forall (r :: * -> *).
AssignStatement r =>
SVariable r -> SValue r -> MSStatement r
assign SVariable PythonCode
v (SValue PythonCode -> MSStatement PythonCode)
-> SValue PythonCode -> MSStatement PythonCode
forall a b. (a -> b) -> a -> b
$ VSType PythonCode -> SValue PythonCode
forall (r :: * -> *).
(TypeElim r, Literal r) =>
VSType r -> SValue r
litZero (VSType PythonCode -> SValue PythonCode)
-> VSType PythonCode -> SValue PythonCode
forall a b. (a -> b) -> a -> b
$ (PythonCode (Variable PythonCode) -> PythonCode TypeData)
-> SVariable PythonCode
-> StateT ValueState Identity (PythonCode TypeData)
forall a b.
(a -> b)
-> StateT ValueState Identity a -> StateT ValueState Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PythonCode (Variable PythonCode) -> PythonCode TypeData
PythonCode (Variable PythonCode) -> PythonCode (Type PythonCode)
forall (r :: * -> *).
VariableElim r =>
r (Variable r) -> r (Type r)
variableType SVariable PythonCode
v)
      loopBody :: MSStatement PythonCode
loopBody = LensLike'
  (Zoomed
     (StateT ValueState Identity)
     (CommonThunk (StateT ValueState Identity)))
  MethodState
  ValueState
-> StateT
     ValueState Identity (CommonThunk (StateT ValueState Identity))
-> StateT
     MethodState Identity (CommonThunk (StateT ValueState Identity))
forall c.
LensLike'
  (Zoomed (StateT ValueState Identity) c) MethodState ValueState
-> StateT ValueState Identity c -> StateT MethodState Identity c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed
     (StateT ValueState Identity)
     (CommonThunk (StateT ValueState Identity)))
  MethodState
  ValueState
(ValueState
 -> Focusing
      Identity (CommonThunk (StateT ValueState Identity)) ValueState)
-> MethodState
-> Focusing
     Identity (CommonThunk (StateT ValueState Identity)) MethodState
Lens' MethodState ValueState
lensMStoVS ((PythonCode (CommonThunk (StateT ValueState Identity))
 -> CommonThunk (StateT ValueState Identity))
-> StateT
     ValueState
     Identity
     (PythonCode (CommonThunk (StateT ValueState Identity)))
-> StateT
     ValueState Identity (CommonThunk (StateT ValueState Identity))
forall a b.
(a -> b)
-> StateT ValueState Identity a -> StateT ValueState Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PythonCode (CommonThunk (StateT ValueState Identity))
-> CommonThunk (StateT ValueState Identity)
forall a. PythonCode a -> a
unPC StateT
  ValueState
  Identity
  (PythonCode (CommonThunk (StateT ValueState Identity)))
VSThunk PythonCode
t) StateT
  MethodState Identity (CommonThunk (StateT ValueState Identity))
-> (CommonThunk (StateT ValueState Identity)
    -> MSStatement PythonCode)
-> MSStatement PythonCode
forall a b.
StateT MethodState Identity a
-> (a -> StateT MethodState Identity b)
-> StateT MethodState Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (CommonThunk (StateT ValueState Identity)
 -> MSStatement PythonCode)
-> (CommonThunk (StateT ValueState Identity)
    -> MSStatement PythonCode)
-> CommonThunk (StateT ValueState Identity)
-> MSStatement PythonCode
forall (s :: * -> *) a.
(CommonThunk s -> a) -> (CommonThunk s -> a) -> CommonThunk s -> a
commonThunkElim
        (SValue PythonCode -> MSStatement PythonCode
forall (r :: * -> *). StatementSym r => SValue r -> MSStatement r
valStmt (SValue PythonCode -> MSStatement PythonCode)
-> (CommonThunk (StateT ValueState Identity) -> SValue PythonCode)
-> CommonThunk (StateT ValueState Identity)
-> MSStatement PythonCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SValue PythonCode
-> SValue PythonCode -> SValue PythonCode -> SValue PythonCode
forall (r :: * -> *).
List r =>
SValue r -> SValue r -> SValue r -> SValue r
listSet (SVariable PythonCode -> SValue PythonCode
forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
valueOf SVariable PythonCode
v) (SVariable PythonCode -> SValue PythonCode
forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
valueOf SVariable PythonCode
i) (VS (PythonCode ValData) -> SValue PythonCode)
-> (CommonThunk (StateT ValueState Identity)
    -> VS (PythonCode ValData))
-> CommonThunk (StateT ValueState Identity)
-> SValue PythonCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SValue PythonCode -> VSThunk PythonCode -> SValue PythonCode
forall (r :: * -> *).
VectorExpression r =>
SValue r -> VSThunk r -> SValue r
vecIndex (SVariable PythonCode -> SValue PythonCode
forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
valueOf SVariable PythonCode
i) (StateT
   ValueState
   Identity
   (PythonCode (CommonThunk (StateT ValueState Identity)))
 -> VS (PythonCode ValData))
-> (CommonThunk (StateT ValueState Identity)
    -> StateT
         ValueState
         Identity
         (PythonCode (CommonThunk (StateT ValueState Identity))))
-> CommonThunk (StateT ValueState Identity)
-> VS (PythonCode ValData)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PythonCode (CommonThunk (StateT ValueState Identity))
-> StateT
     ValueState
     Identity
     (PythonCode (CommonThunk (StateT ValueState Identity)))
forall a. a -> StateT ValueState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PythonCode (CommonThunk (StateT ValueState Identity))
 -> StateT
      ValueState
      Identity
      (PythonCode (CommonThunk (StateT ValueState Identity))))
-> (CommonThunk (StateT ValueState Identity)
    -> PythonCode (CommonThunk (StateT ValueState Identity)))
-> CommonThunk (StateT ValueState Identity)
-> StateT
     ValueState
     Identity
     (PythonCode (CommonThunk (StateT ValueState Identity)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommonThunk (StateT ValueState Identity)
-> PythonCode (CommonThunk (StateT ValueState Identity))
forall a. a -> PythonCode a
forall (f :: * -> *) a. Applicative f => a -> f a
pure)
        ((SVariable PythonCode
v SVariable PythonCode -> SValue PythonCode -> MSStatement PythonCode
forall (r :: * -> *).
AssignStatement r =>
SVariable r -> SValue r -> MSStatement r
&+=) (VS (PythonCode ValData) -> MSStatement PythonCode)
-> (CommonThunk (StateT ValueState Identity)
    -> VS (PythonCode ValData))
-> CommonThunk (StateT ValueState Identity)
-> MSStatement PythonCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SValue PythonCode -> VSThunk PythonCode -> SValue PythonCode
forall (r :: * -> *).
VectorExpression r =>
SValue r -> VSThunk r -> SValue r
vecIndex (SVariable PythonCode -> SValue PythonCode
forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
valueOf SVariable PythonCode
i) (StateT
   ValueState
   Identity
   (PythonCode (CommonThunk (StateT ValueState Identity)))
 -> VS (PythonCode ValData))
-> (CommonThunk (StateT ValueState Identity)
    -> StateT
         ValueState
         Identity
         (PythonCode (CommonThunk (StateT ValueState Identity))))
-> CommonThunk (StateT ValueState Identity)
-> VS (PythonCode ValData)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PythonCode (CommonThunk (StateT ValueState Identity))
-> StateT
     ValueState
     Identity
     (PythonCode (CommonThunk (StateT ValueState Identity)))
forall a. a -> StateT ValueState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PythonCode (CommonThunk (StateT ValueState Identity))
 -> StateT
      ValueState
      Identity
      (PythonCode (CommonThunk (StateT ValueState Identity))))
-> (CommonThunk (StateT ValueState Identity)
    -> PythonCode (CommonThunk (StateT ValueState Identity)))
-> CommonThunk (StateT ValueState Identity)
-> StateT
     ValueState
     Identity
     (PythonCode (CommonThunk (StateT ValueState Identity)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommonThunk (StateT ValueState Identity)
-> PythonCode (CommonThunk (StateT ValueState Identity))
forall a. a -> PythonCode a
forall (f :: * -> *) a. Applicative f => a -> f a
pure)
    [MSStatement PythonCode] -> MSStatement PythonCode
forall (r :: * -> *).
StatementSym r =>
[MSStatement r] -> MSStatement r
multi [MSStatement PythonCode
loopInit,
      SVariable PythonCode
-> SValue PythonCode
-> SValue PythonCode
-> SValue PythonCode
-> MSBody PythonCode
-> MSStatement PythonCode
forall (r :: * -> *).
ControlStatement r =>
SVariable r
-> SValue r -> SValue r -> SValue r -> MSBody r -> MSStatement r
forRange SVariable PythonCode
i (Integer -> SValue PythonCode
forall (r :: * -> *). Literal r => Integer -> SValue r
litInt Integer
0) VS (PythonCode ValData)
SValue PythonCode
dim (Integer -> SValue PythonCode
forall (r :: * -> *). Literal r => Integer -> SValue r
litInt Integer
1) (MSBody PythonCode -> MSStatement PythonCode)
-> MSBody PythonCode -> MSStatement PythonCode
forall a b. (a -> b) -> a -> b
$ [MSBlock PythonCode] -> MSBody PythonCode
forall (r :: * -> *). BodySym r => [MSBlock r] -> MSBody r
body [[MSStatement PythonCode] -> MSBlock PythonCode
forall (r :: * -> *). BlockSym r => [MSStatement r] -> MSBlock r
block [MSStatement PythonCode
loopBody]]]

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

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

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

instance VectorExpression PythonCode where
  vecScale :: SValue PythonCode -> VSThunk PythonCode -> VSThunk PythonCode
vecScale SValue PythonCode
k = (PythonCode (Thunk PythonCode) -> PythonCode (Thunk PythonCode))
-> VSThunk PythonCode -> VSThunk PythonCode
forall a b.
(a -> b)
-> StateT ValueState Identity a -> StateT ValueState Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((PythonCode (Thunk PythonCode) -> PythonCode (Thunk PythonCode))
 -> VSThunk PythonCode -> VSThunk PythonCode)
-> (PythonCode (Thunk PythonCode) -> PythonCode (Thunk PythonCode))
-> VSThunk PythonCode
-> VSThunk PythonCode
forall a b. (a -> b) -> a -> b
$ (Thunk PythonCode -> Thunk PythonCode)
-> PythonCode (Thunk PythonCode) -> PythonCode (Thunk PythonCode)
forall a b. (a -> b) -> PythonCode a -> PythonCode b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Thunk PythonCode -> Thunk PythonCode)
 -> PythonCode (Thunk PythonCode) -> PythonCode (Thunk PythonCode))
-> (Thunk PythonCode -> Thunk PythonCode)
-> PythonCode (Thunk PythonCode)
-> PythonCode (Thunk PythonCode)
forall a b. (a -> b) -> a -> b
$ (StateT ValueState Identity ValData
 -> StateT ValueState Identity ValData)
-> CommonThunk (StateT ValueState Identity)
-> CommonThunk (StateT ValueState Identity)
forall (s :: * -> *).
(s ValData -> s ValData) -> CommonThunk s -> CommonThunk s
vectorize ((PythonCode ValData -> ValData)
-> VS (PythonCode ValData) -> StateT ValueState Identity ValData
forall a b.
(a -> b)
-> StateT ValueState Identity a -> StateT ValueState Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PythonCode ValData -> ValData
forall a. PythonCode a -> a
unPC (VS (PythonCode ValData) -> StateT ValueState Identity ValData)
-> (StateT ValueState Identity ValData -> VS (PythonCode ValData))
-> StateT ValueState Identity ValData
-> StateT ValueState Identity ValData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SValue PythonCode
k SValue PythonCode -> SValue PythonCode -> SValue PythonCode
forall (r :: * -> *).
NumericExpression r =>
SValue r -> SValue r -> SValue r
#*) (VS (PythonCode ValData) -> VS (PythonCode ValData))
-> (StateT ValueState Identity ValData -> VS (PythonCode ValData))
-> StateT ValueState Identity ValData
-> VS (PythonCode ValData)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ValData -> PythonCode ValData)
-> StateT ValueState Identity ValData -> VS (PythonCode ValData)
forall a b.
(a -> b)
-> StateT ValueState Identity a -> StateT ValueState Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ValData -> PythonCode ValData
forall a. a -> PythonCode a
forall (f :: * -> *) a. Applicative f => a -> f a
pure)
  vecAdd :: VSThunk PythonCode -> VSThunk PythonCode -> VSThunk PythonCode
vecAdd = (PythonCode (Thunk PythonCode)
 -> PythonCode (Thunk PythonCode) -> PythonCode (Thunk PythonCode))
-> VSThunk PythonCode -> VSThunk PythonCode -> VSThunk PythonCode
forall a b c.
(a -> b -> c)
-> StateT ValueState Identity a
-> StateT ValueState Identity b
-> StateT ValueState Identity c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 ((PythonCode (Thunk PythonCode)
  -> PythonCode (Thunk PythonCode) -> PythonCode (Thunk PythonCode))
 -> VSThunk PythonCode -> VSThunk PythonCode -> VSThunk PythonCode)
-> (PythonCode (Thunk PythonCode)
    -> PythonCode (Thunk PythonCode) -> PythonCode (Thunk PythonCode))
-> VSThunk PythonCode
-> VSThunk PythonCode
-> VSThunk PythonCode
forall a b. (a -> b) -> a -> b
$ (Thunk PythonCode -> Thunk PythonCode -> Thunk PythonCode)
-> PythonCode (Thunk PythonCode)
-> PythonCode (Thunk PythonCode)
-> PythonCode (Thunk PythonCode)
forall a b c.
(a -> b -> c) -> PythonCode a -> PythonCode b -> PythonCode c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 ((Thunk PythonCode -> Thunk PythonCode -> Thunk PythonCode)
 -> PythonCode (Thunk PythonCode)
 -> PythonCode (Thunk PythonCode)
 -> PythonCode (Thunk PythonCode))
-> (Thunk PythonCode -> Thunk PythonCode -> Thunk PythonCode)
-> PythonCode (Thunk PythonCode)
-> PythonCode (Thunk PythonCode)
-> PythonCode (Thunk PythonCode)
forall a b. (a -> b) -> a -> b
$ (StateT ValueState Identity ValData
 -> StateT ValueState Identity ValData
 -> StateT ValueState Identity ValData)
-> CommonThunk (StateT ValueState Identity)
-> CommonThunk (StateT ValueState Identity)
-> CommonThunk (StateT ValueState Identity)
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 -> (PythonCode ValData -> ValData)
-> VS (PythonCode ValData) -> StateT ValueState Identity ValData
forall a b.
(a -> b)
-> StateT ValueState Identity a -> StateT ValueState Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PythonCode ValData -> ValData
forall a. PythonCode a -> a
unPC (VS (PythonCode ValData) -> StateT ValueState Identity ValData)
-> VS (PythonCode ValData) -> StateT ValueState Identity ValData
forall a b. (a -> b) -> a -> b
$ (ValData -> PythonCode ValData)
-> StateT ValueState Identity ValData -> VS (PythonCode ValData)
forall a b.
(a -> b)
-> StateT ValueState Identity a -> StateT ValueState Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ValData -> PythonCode ValData
forall a. a -> PythonCode a
forall (f :: * -> *) a. Applicative f => a -> f a
pure StateT ValueState Identity ValData
v1 SValue PythonCode -> SValue PythonCode -> SValue PythonCode
forall (r :: * -> *).
NumericExpression r =>
SValue r -> SValue r -> SValue r
#+ (ValData -> PythonCode ValData)
-> StateT ValueState Identity ValData -> VS (PythonCode ValData)
forall a b.
(a -> b)
-> StateT ValueState Identity a -> StateT ValueState Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ValData -> PythonCode ValData
forall a. a -> PythonCode a
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 = (VSThunk PythonCode
-> (PythonCode (Thunk PythonCode) -> SValue PythonCode)
-> SValue PythonCode
forall a b.
StateT ValueState Identity a
-> (a -> StateT ValueState Identity b)
-> StateT ValueState Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ValData -> PythonCode ValData)
-> StateT ValueState Identity ValData -> VS (PythonCode ValData)
forall a b.
(a -> b)
-> StateT ValueState Identity a -> StateT ValueState Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ValData -> PythonCode ValData
forall a. a -> PythonCode a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StateT ValueState Identity ValData -> VS (PythonCode ValData))
-> (PythonCode (CommonThunk (StateT ValueState Identity))
    -> StateT ValueState Identity ValData)
-> PythonCode (CommonThunk (StateT ValueState Identity))
-> VS (PythonCode ValData)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StateT ValueState Identity ValData
 -> StateT ValueState Identity ValData)
-> CommonThunk (StateT ValueState Identity)
-> StateT ValueState Identity ValData
forall (s :: * -> *).
(s ValData -> s ValData) -> CommonThunk s -> s ValData
commonVecIndex ((PythonCode ValData -> ValData)
-> VS (PythonCode ValData) -> StateT ValueState Identity ValData
forall a b.
(a -> b)
-> StateT ValueState Identity a -> StateT ValueState Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PythonCode ValData -> ValData
forall a. PythonCode a -> a
unPC (VS (PythonCode ValData) -> StateT ValueState Identity ValData)
-> (StateT ValueState Identity ValData -> VS (PythonCode ValData))
-> StateT ValueState Identity ValData
-> StateT ValueState Identity ValData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VS (PythonCode ValData)
 -> VS (PythonCode ValData) -> VS (PythonCode ValData))
-> VS (PythonCode ValData)
-> VS (PythonCode ValData)
-> VS (PythonCode ValData)
forall a b c. (a -> b -> c) -> b -> a -> c
flip VS (PythonCode ValData)
-> VS (PythonCode ValData) -> VS (PythonCode ValData)
SValue PythonCode -> SValue PythonCode -> SValue PythonCode
forall (r :: * -> *). List r => SValue r -> SValue r -> SValue r
listAccess VS (PythonCode ValData)
SValue PythonCode
i (VS (PythonCode ValData) -> VS (PythonCode ValData))
-> (StateT ValueState Identity ValData -> VS (PythonCode ValData))
-> StateT ValueState Identity ValData
-> VS (PythonCode ValData)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ValData -> PythonCode ValData)
-> StateT ValueState Identity ValData -> VS (PythonCode ValData)
forall a b.
(a -> b)
-> StateT ValueState Identity a -> StateT ValueState Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ValData -> PythonCode ValData
forall a. a -> PythonCode a
forall (f :: * -> *) a. Applicative f => a -> f a
pure) (CommonThunk (StateT ValueState Identity)
 -> StateT ValueState Identity ValData)
-> (PythonCode (CommonThunk (StateT ValueState Identity))
    -> CommonThunk (StateT ValueState Identity))
-> PythonCode (CommonThunk (StateT ValueState Identity))
-> StateT ValueState Identity ValData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PythonCode (CommonThunk (StateT ValueState Identity))
-> CommonThunk (StateT ValueState Identity)
forall a. PythonCode a -> a
unPC)
  vecDot :: VSThunk PythonCode -> VSThunk PythonCode -> VSThunk PythonCode
vecDot = (PythonCode (Thunk PythonCode)
 -> PythonCode (Thunk PythonCode) -> PythonCode (Thunk PythonCode))
-> VSThunk PythonCode -> VSThunk PythonCode -> VSThunk PythonCode
forall a b c.
(a -> b -> c)
-> StateT ValueState Identity a
-> StateT ValueState Identity b
-> StateT ValueState Identity c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 ((PythonCode (Thunk PythonCode)
  -> PythonCode (Thunk PythonCode) -> PythonCode (Thunk PythonCode))
 -> VSThunk PythonCode -> VSThunk PythonCode -> VSThunk PythonCode)
-> (PythonCode (Thunk PythonCode)
    -> PythonCode (Thunk PythonCode) -> PythonCode (Thunk PythonCode))
-> VSThunk PythonCode
-> VSThunk PythonCode
-> VSThunk PythonCode
forall a b. (a -> b) -> a -> b
$ (Thunk PythonCode -> Thunk PythonCode -> Thunk PythonCode)
-> PythonCode (Thunk PythonCode)
-> PythonCode (Thunk PythonCode)
-> PythonCode (Thunk PythonCode)
forall a b c.
(a -> b -> c) -> PythonCode a -> PythonCode b -> PythonCode c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 ((Thunk PythonCode -> Thunk PythonCode -> Thunk PythonCode)
 -> PythonCode (Thunk PythonCode)
 -> PythonCode (Thunk PythonCode)
 -> PythonCode (Thunk PythonCode))
-> (Thunk PythonCode -> Thunk PythonCode -> Thunk PythonCode)
-> PythonCode (Thunk PythonCode)
-> PythonCode (Thunk PythonCode)
-> PythonCode (Thunk PythonCode)
forall a b. (a -> b) -> a -> b
$ (CommonThunk (StateT ValueState Identity)
 -> CommonThunk (StateT ValueState Identity))
-> (CommonThunk (StateT ValueState Identity)
    -> CommonThunk (StateT ValueState Identity))
-> CommonThunk (StateT ValueState Identity)
-> CommonThunk (StateT ValueState Identity)
forall a b.
(a -> b)
-> (CommonThunk (StateT ValueState Identity) -> a)
-> CommonThunk (StateT ValueState Identity)
-> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CommonThunk (StateT ValueState Identity)
-> CommonThunk (StateT ValueState Identity)
forall (s :: * -> *). CommonThunk s -> CommonThunk s
sumComponents ((CommonThunk (StateT ValueState Identity)
  -> CommonThunk (StateT ValueState Identity))
 -> CommonThunk (StateT ValueState Identity)
 -> CommonThunk (StateT ValueState Identity))
-> (CommonThunk (StateT ValueState Identity)
    -> CommonThunk (StateT ValueState Identity)
    -> CommonThunk (StateT ValueState Identity))
-> CommonThunk (StateT ValueState Identity)
-> CommonThunk (StateT ValueState Identity)
-> CommonThunk (StateT ValueState Identity)
forall (r :: * -> *) a b. Functor r => (a -> b) -> r a -> r b
<$> (StateT ValueState Identity ValData
 -> StateT ValueState Identity ValData
 -> StateT ValueState Identity ValData)
-> CommonThunk (StateT ValueState Identity)
-> CommonThunk (StateT ValueState Identity)
-> CommonThunk (StateT ValueState Identity)
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 -> (PythonCode ValData -> ValData)
-> VS (PythonCode ValData) -> StateT ValueState Identity ValData
forall a b.
(a -> b)
-> StateT ValueState Identity a -> StateT ValueState Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PythonCode ValData -> ValData
forall a. PythonCode a -> a
unPC (VS (PythonCode ValData) -> StateT ValueState Identity ValData)
-> VS (PythonCode ValData) -> StateT ValueState Identity ValData
forall a b. (a -> b) -> a -> b
$ (ValData -> PythonCode ValData)
-> StateT ValueState Identity ValData -> VS (PythonCode ValData)
forall a b.
(a -> b)
-> StateT ValueState Identity a -> StateT ValueState Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ValData -> PythonCode ValData
forall a. a -> PythonCode a
forall (f :: * -> *) a. Applicative f => a -> f a
pure StateT ValueState Identity ValData
v1 SValue PythonCode -> SValue PythonCode -> SValue PythonCode
forall (r :: * -> *).
NumericExpression r =>
SValue r -> SValue r -> SValue r
#* (ValData -> PythonCode ValData)
-> StateT ValueState Identity ValData -> VS (PythonCode ValData)
forall a b.
(a -> b)
-> StateT ValueState Identity a -> StateT ValueState Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ValData -> PythonCode ValData
forall a. a -> PythonCode a
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 = (PythonCode TypeData -> PythonCode FuncData)
-> StateT ValueState Identity (PythonCode TypeData)
-> StateT ValueState Identity (PythonCode FuncData)
forall a b s. (a -> b) -> State s a -> State s b
onStateValue ((TypeData -> FuncData)
-> PythonCode TypeData -> PythonCode FuncData
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 = (FuncData -> TypeData)
-> PythonCode FuncData -> PythonCode TypeData
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 (FuncData -> Doc)
-> (PythonCode FuncData -> FuncData) -> PythonCode FuncData -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PythonCode FuncData -> FuncData
forall a. PythonCode a -> a
unPC

instance InternalAssignStmt PythonCode where
  multiAssign :: [SVariable PythonCode]
-> [SValue PythonCode] -> MSStatement PythonCode
multiAssign = (Doc -> Doc)
-> [SVariable PythonCode]
-> [SValue PythonCode]
-> MSStatement PythonCode
forall (r :: * -> *).
CommonRenderSym r =>
(Doc -> Doc) -> [SVariable r] -> [SValue r] -> MSStatement r
CP.multiAssign Doc -> Doc
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 = (Doc -> Doc) -> [SValue PythonCode] -> MSStatement PythonCode
forall (r :: * -> *).
CommonRenderSym r =>
(Doc -> Doc) -> [SValue r] -> MSStatement r
CP.multiReturn Doc -> Doc
forall a. a -> a
id

instance RenderStatement PythonCode where
  stmt :: MSStatement PythonCode -> MSStatement PythonCode
stmt = MSStatement PythonCode -> MSStatement PythonCode
forall (r :: * -> *).
CommonRenderSym r =>
MSStatement r -> MSStatement r
G.stmt
  loopStmt :: MSStatement PythonCode -> MSStatement PythonCode
loopStmt = MSStatement PythonCode -> MSStatement PythonCode
forall (r :: * -> *).
CommonRenderSym r =>
MSStatement r -> MSStatement r
G.loopStmt
  stmtFromData :: Doc -> Terminator -> MSStatement PythonCode
stmtFromData Doc
d Terminator
t = PythonCode (Statement PythonCode) -> MSStatement PythonCode
forall a s. a -> State s a
toState (PythonCode (Statement PythonCode) -> MSStatement PythonCode)
-> PythonCode (Statement PythonCode) -> MSStatement PythonCode
forall a b. (a -> b) -> a -> b
$ (Doc, Terminator) -> PythonCode (Doc, Terminator)
forall (r :: * -> *) a. Monad r => a -> r a
toCode (Doc
d, Terminator
t)

instance StatementElim PythonCode where
  statement :: PythonCode (Statement PythonCode) -> Doc
statement = (Doc, Terminator) -> Doc
forall a b. (a, b) -> a
fst ((Doc, Terminator) -> Doc)
-> (PythonCode (Doc, Terminator) -> (Doc, Terminator))
-> PythonCode (Doc, Terminator)
-> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PythonCode (Doc, Terminator) -> (Doc, Terminator)
forall a. PythonCode a -> a
unPC
  statementTerm :: PythonCode (Statement PythonCode) -> Terminator
statementTerm = (Doc, Terminator) -> Terminator
forall a b. (a, b) -> b
snd ((Doc, Terminator) -> Terminator)
-> (PythonCode (Doc, Terminator) -> (Doc, Terminator))
-> PythonCode (Doc, Terminator)
-> Terminator
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PythonCode (Doc, Terminator) -> (Doc, Terminator)
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 = Terminator -> SValue PythonCode -> MSStatement PythonCode
forall (r :: * -> *).
CommonRenderSym r =>
Terminator -> SValue r -> MSStatement r
G.valStmt Terminator
Empty
  emptyStmt :: MSStatement PythonCode
emptyStmt = MSStatement PythonCode
forall (r :: * -> *). CommonRenderSym r => MSStatement r
G.emptyStmt
  multi :: [MSStatement PythonCode] -> MSStatement PythonCode
multi = ([PythonCode (Doc, Terminator)] -> PythonCode (Doc, Terminator))
-> [StateT MethodState Identity (PythonCode (Doc, Terminator))]
-> StateT MethodState Identity (PythonCode (Doc, Terminator))
forall a b s. ([a] -> b) -> [State s a] -> State s b
onStateList (([(Doc, Terminator)] -> (Doc, Terminator))
-> [PythonCode (Doc, Terminator)] -> PythonCode (Doc, Terminator)
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 = Terminator
-> SVariable PythonCode
-> SValue PythonCode
-> MSStatement PythonCode
forall (r :: * -> *).
CommonRenderSym r =>
Terminator -> SVariable r -> SValue r -> MSStatement r
G.assign Terminator
Empty
  &-= :: SVariable PythonCode -> SValue PythonCode -> MSStatement PythonCode
(&-=) = Terminator
-> SVariable PythonCode
-> SValue PythonCode
-> MSStatement PythonCode
forall (r :: * -> *).
CommonRenderSym r =>
Terminator -> SVariable r -> SValue r -> MSStatement r
G.subAssign Terminator
Empty
  &+= :: SVariable PythonCode -> SValue PythonCode -> MSStatement PythonCode
(&+=) = SVariable PythonCode -> SValue PythonCode -> MSStatement PythonCode
forall (r :: * -> *).
CommonRenderSym r =>
SVariable r -> SValue r -> MSStatement r
G.increment
  &++ :: SVariable PythonCode -> MSStatement PythonCode
(&++) = SVariable PythonCode -> MSStatement PythonCode
forall (r :: * -> *).
CommonRenderSym r =>
SVariable r -> MSStatement r
M.increment1
  &-- :: SVariable PythonCode -> MSStatement PythonCode
(&--) = SVariable PythonCode -> MSStatement PythonCode
forall (r :: * -> *).
CommonRenderSym r =>
SVariable r -> MSStatement r
M.decrement1

instance DeclStatement PythonCode where
  varDec :: SVariable PythonCode
-> PythonCode (Scope PythonCode) -> MSStatement PythonCode
varDec SVariable PythonCode
v PythonCode (Scope PythonCode)
scp = SVariable PythonCode
-> PythonCode (Scope PythonCode)
-> Maybe (SValue PythonCode)
-> MSStatement PythonCode
forall (r :: * -> *).
CommonRenderSym r =>
SVariable r -> r (Scope r) -> Maybe (SValue r) -> MSStatement r
CP.varDecDef SVariable PythonCode
v PythonCode (Scope PythonCode)
scp Maybe (VS (PythonCode ValData))
Maybe (SValue PythonCode)
forall a. Maybe a
Nothing
  varDecDef :: SVariable PythonCode
-> PythonCode (Scope PythonCode)
-> SValue PythonCode
-> MSStatement PythonCode
varDecDef SVariable PythonCode
v PythonCode (Scope PythonCode)
scp SValue PythonCode
e = SVariable PythonCode
-> PythonCode (Scope PythonCode)
-> Maybe (SValue PythonCode)
-> MSStatement PythonCode
forall (r :: * -> *).
CommonRenderSym r =>
SVariable r -> r (Scope r) -> Maybe (SValue r) -> MSStatement r
CP.varDecDef SVariable PythonCode
v PythonCode (Scope PythonCode)
scp (VS (PythonCode ValData) -> Maybe (VS (PythonCode ValData))
forall a. a -> Maybe a
Just VS (PythonCode ValData)
SValue PythonCode
e)
  setDec :: SVariable PythonCode
-> PythonCode (Scope PythonCode) -> MSStatement PythonCode
setDec = SVariable PythonCode
-> PythonCode (Scope PythonCode) -> MSStatement PythonCode
forall (r :: * -> *).
DeclStatement r =>
SVariable r -> r (Scope r) -> MSStatement r
varDec
  setDecDef :: SVariable PythonCode
-> PythonCode (Scope PythonCode)
-> SValue PythonCode
-> MSStatement PythonCode
setDecDef = SVariable PythonCode
-> PythonCode (Scope PythonCode)
-> SValue PythonCode
-> MSStatement PythonCode
forall (r :: * -> *).
DeclStatement r =>
SVariable r -> r (Scope r) -> SValue r -> MSStatement r
varDecDef
  listDec :: Integer
-> SVariable PythonCode
-> PythonCode (Scope PythonCode)
-> MSStatement PythonCode
listDec Integer
_ = SVariable PythonCode
-> PythonCode (Scope PythonCode) -> MSStatement PythonCode
forall (r :: * -> *).
CommonRenderSym r =>
SVariable r -> r (Scope r) -> MSStatement r
CP.listDec
  listDecDef :: SVariable PythonCode
-> PythonCode (Scope PythonCode)
-> [SValue PythonCode]
-> MSStatement PythonCode
listDecDef = SVariable PythonCode
-> PythonCode (Scope PythonCode)
-> [SValue PythonCode]
-> MSStatement PythonCode
forall (r :: * -> *).
CommonRenderSym r =>
SVariable r -> r (Scope r) -> [SValue r] -> MSStatement r
CP.listDecDef
  arrayDec :: Integer
-> SVariable PythonCode
-> PythonCode (Scope PythonCode)
-> MSStatement PythonCode
arrayDec = Integer
-> SVariable PythonCode
-> PythonCode (Scope PythonCode)
-> MSStatement PythonCode
forall (r :: * -> *).
DeclStatement r =>
Integer -> SVariable r -> r (Scope r) -> MSStatement r
listDec
  arrayDecDef :: SVariable PythonCode
-> PythonCode (Scope PythonCode)
-> [SValue PythonCode]
-> MSStatement PythonCode
arrayDecDef = SVariable PythonCode
-> PythonCode (Scope PythonCode)
-> [SValue PythonCode]
-> MSStatement PythonCode
forall (r :: * -> *).
DeclStatement r =>
SVariable r -> r (Scope r) -> [SValue r] -> MSStatement r
listDecDef
  constDecDef :: SVariable PythonCode
-> PythonCode (Scope PythonCode)
-> SValue PythonCode
-> MSStatement PythonCode
constDecDef SVariable PythonCode
v PythonCode (Scope PythonCode)
scp SValue PythonCode
e = do
    PythonCode VarData
v' <- LensLike'
  (Zoomed (StateT ValueState Identity) (PythonCode VarData))
  MethodState
  ValueState
-> StateT ValueState Identity (PythonCode VarData)
-> StateT MethodState Identity (PythonCode VarData)
forall c.
LensLike'
  (Zoomed (StateT ValueState Identity) c) MethodState ValueState
-> StateT ValueState Identity c -> StateT MethodState Identity c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (StateT ValueState Identity) (PythonCode VarData))
  MethodState
  ValueState
(ValueState -> Focusing Identity (PythonCode VarData) ValueState)
-> MethodState
-> Focusing Identity (PythonCode VarData) MethodState
Lens' MethodState ValueState
lensMStoVS StateT ValueState Identity (PythonCode VarData)
SVariable PythonCode
v
    let n :: String
n = String -> String
toConstName (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ PythonCode (Variable PythonCode) -> String
forall (r :: * -> *). VariableElim r => r (Variable r) -> String
variableName PythonCode VarData
PythonCode (Variable PythonCode)
v'
        newConst :: SVariable PythonCode
newConst = String -> VSType PythonCode -> SVariable PythonCode
forall (r :: * -> *).
VariableSym r =>
String -> VSType r -> SVariable r
constant String
n (PythonCode TypeData
-> StateT ValueState Identity (PythonCode TypeData)
forall a. a -> StateT ValueState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PythonCode (Variable PythonCode) -> PythonCode (Type PythonCode)
forall (r :: * -> *).
VariableElim r =>
r (Variable r) -> r (Type r)
variableType PythonCode VarData
PythonCode (Variable PythonCode)
v'))
    Bool
available <- String -> MS Bool
varNameAvailable String
n
    if Bool
available
      then SVariable PythonCode
-> PythonCode (Scope PythonCode)
-> SValue PythonCode
-> MSStatement PythonCode
forall (r :: * -> *).
DeclStatement r =>
SVariable r -> r (Scope r) -> SValue r -> MSStatement r
varDecDef SVariable PythonCode
newConst PythonCode (Scope PythonCode)
scp SValue PythonCode
e
      else String
-> StateT MethodState Identity (PythonCode (Doc, Terminator))
forall a. HasCallStack => String -> a
error String
"Cannot safely capitalize constant."
  funcDecDef :: SVariable PythonCode
-> PythonCode (Scope PythonCode)
-> [SVariable PythonCode]
-> MSBody PythonCode
-> MSStatement PythonCode
funcDecDef = SVariable PythonCode
-> PythonCode (Scope PythonCode)
-> [SVariable PythonCode]
-> MSBody PythonCode
-> MSStatement PythonCode
forall (r :: * -> *).
OORenderSym r =>
SVariable r
-> r (Scope r) -> [SVariable r] -> MSBody r -> MSStatement r
CP.funcDecDef

instance OODeclStatement PythonCode where
  objDecDef :: SVariable PythonCode
-> PythonCode (Scope PythonCode)
-> SValue PythonCode
-> MSStatement PythonCode
objDecDef = SVariable PythonCode
-> PythonCode (Scope PythonCode)
-> SValue PythonCode
-> MSStatement PythonCode
forall (r :: * -> *).
DeclStatement r =>
SVariable r -> r (Scope r) -> SValue r -> MSStatement r
varDecDef
  objDecNew :: SVariable PythonCode
-> PythonCode (Scope PythonCode)
-> [SValue PythonCode]
-> MSStatement PythonCode
objDecNew = SVariable PythonCode
-> PythonCode (Scope PythonCode)
-> [SValue PythonCode]
-> MSStatement PythonCode
forall (r :: * -> *).
OORenderSym r =>
SVariable r -> r (Scope r) -> [SValue r] -> MSStatement r
G.objDecNew
  extObjDecNew :: String
-> SVariable PythonCode
-> PythonCode (Scope PythonCode)
-> [SValue PythonCode]
-> MSStatement PythonCode
extObjDecNew String
lib SVariable PythonCode
v PythonCode (Scope PythonCode)
scp [SValue PythonCode]
vs = do
    (MethodState -> MethodState) -> StateT MethodState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (String -> MethodState -> MethodState
addModuleImport String
lib)
    SVariable PythonCode
-> PythonCode (Scope PythonCode)
-> SValue PythonCode
-> MSStatement PythonCode
forall (r :: * -> *).
DeclStatement r =>
SVariable r -> r (Scope r) -> SValue r -> MSStatement r
varDecDef SVariable PythonCode
v PythonCode (Scope PythonCode)
scp (PosCall PythonCode
forall (r :: * -> *).
OOValueExpression r =>
String -> PosCtorCall r
extNewObj String
lib ((PythonCode (Variable PythonCode) -> PythonCode TypeData)
-> SVariable PythonCode
-> StateT ValueState Identity (PythonCode TypeData)
forall a b s. (a -> b) -> State s a -> State s b
onStateValue PythonCode (Variable PythonCode) -> PythonCode TypeData
PythonCode (Variable PythonCode) -> PythonCode (Type PythonCode)
forall (r :: * -> *).
VariableElim r =>
r (Variable r) -> r (Type r)
variableType SVariable PythonCode
v) [SValue PythonCode]
vs)

instance IOStatement PythonCode where
  print :: SValue PythonCode -> MSStatement PythonCode
print      = Bool
-> Maybe (SValue PythonCode)
-> SValue PythonCode
-> SValue PythonCode
-> MSStatement PythonCode
forall (r :: * -> *).
CommonRenderSym r =>
Bool -> Maybe (SValue r) -> SValue r -> SValue r -> MSStatement r
pyOut Bool
False Maybe (VS (PythonCode ValData))
Maybe (SValue PythonCode)
forall a. Maybe a
Nothing SValue PythonCode
forall (r :: * -> *). RenderValue r => SValue r
printFunc
  printLn :: SValue PythonCode -> MSStatement PythonCode
printLn    = Bool
-> Maybe (SValue PythonCode)
-> SValue PythonCode
-> SValue PythonCode
-> MSStatement PythonCode
forall (r :: * -> *).
CommonRenderSym r =>
Bool -> Maybe (SValue r) -> SValue r -> SValue r -> MSStatement r
pyOut Bool
True  Maybe (VS (PythonCode ValData))
Maybe (SValue PythonCode)
forall a. Maybe a
Nothing SValue PythonCode
forall (r :: * -> *). RenderValue r => SValue r
printFunc
  printStr :: String -> MSStatement PythonCode
printStr   = SValue PythonCode
-> StateT MethodState Identity (PythonCode (Doc, Terminator))
SValue PythonCode -> MSStatement PythonCode
forall (r :: * -> *). IOStatement r => SValue r -> MSStatement r
print   (SValue PythonCode
 -> StateT MethodState Identity (PythonCode (Doc, Terminator)))
-> (String -> SValue PythonCode)
-> String
-> StateT MethodState Identity (PythonCode (Doc, Terminator))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> SValue PythonCode
forall (r :: * -> *). Literal r => String -> SValue r
litString
  printStrLn :: String -> MSStatement PythonCode
printStrLn = SValue PythonCode
-> StateT MethodState Identity (PythonCode (Doc, Terminator))
SValue PythonCode -> MSStatement PythonCode
forall (r :: * -> *). IOStatement r => SValue r -> MSStatement r
printLn (SValue PythonCode
 -> StateT MethodState Identity (PythonCode (Doc, Terminator)))
-> (String -> SValue PythonCode)
-> String
-> StateT MethodState Identity (PythonCode (Doc, Terminator))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> SValue PythonCode
forall (r :: * -> *). Literal r => String -> SValue r
litString

  printFile :: SValue PythonCode -> SValue PythonCode -> MSStatement PythonCode
printFile SValue PythonCode
f      = Bool
-> Maybe (SValue PythonCode)
-> SValue PythonCode
-> SValue PythonCode
-> MSStatement PythonCode
forall (r :: * -> *).
CommonRenderSym r =>
Bool -> Maybe (SValue r) -> SValue r -> SValue r -> MSStatement r
pyOut Bool
False (VS (PythonCode ValData) -> Maybe (VS (PythonCode ValData))
forall a. a -> Maybe a
Just VS (PythonCode ValData)
SValue PythonCode
f) SValue PythonCode
forall (r :: * -> *). RenderValue r => SValue r
printFunc
  printFileLn :: SValue PythonCode -> SValue PythonCode -> MSStatement PythonCode
printFileLn SValue PythonCode
f    = Bool
-> Maybe (SValue PythonCode)
-> SValue PythonCode
-> SValue PythonCode
-> MSStatement PythonCode
forall (r :: * -> *).
CommonRenderSym r =>
Bool -> Maybe (SValue r) -> SValue r -> SValue r -> MSStatement r
pyOut Bool
True  (VS (PythonCode ValData) -> Maybe (VS (PythonCode ValData))
forall a. a -> Maybe a
Just VS (PythonCode ValData)
SValue PythonCode
f) SValue PythonCode
forall (r :: * -> *). RenderValue r => SValue r
printFunc
  printFileStr :: SValue PythonCode -> String -> MSStatement PythonCode
printFileStr SValue PythonCode
f   = SValue PythonCode -> SValue PythonCode -> MSStatement PythonCode
forall (r :: * -> *).
IOStatement r =>
SValue r -> SValue r -> MSStatement r
printFile SValue PythonCode
f   (VS (PythonCode ValData)
 -> StateT MethodState Identity (PythonCode (Doc, Terminator)))
-> (String -> VS (PythonCode ValData))
-> String
-> StateT MethodState Identity (PythonCode (Doc, Terminator))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> VS (PythonCode ValData)
String -> SValue PythonCode
forall (r :: * -> *). Literal r => String -> SValue r
litString
  printFileStrLn :: SValue PythonCode -> String -> MSStatement PythonCode
printFileStrLn SValue PythonCode
f = SValue PythonCode -> SValue PythonCode -> MSStatement PythonCode
forall (r :: * -> *).
IOStatement r =>
SValue r -> SValue r -> MSStatement r
printFileLn SValue PythonCode
f (VS (PythonCode ValData)
 -> StateT MethodState Identity (PythonCode (Doc, Terminator)))
-> (String -> VS (PythonCode ValData))
-> String
-> StateT MethodState Identity (PythonCode (Doc, Terminator))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> VS (PythonCode ValData)
String -> SValue PythonCode
forall (r :: * -> *). Literal r => String -> SValue r
litString

  getInput :: SVariable PythonCode -> MSStatement PythonCode
getInput = SValue PythonCode -> SVariable PythonCode -> MSStatement PythonCode
pyInput SValue PythonCode
forall (r :: * -> *). RenderValue r => SValue r
inputFunc
  discardInput :: MSStatement PythonCode
discardInput = SValue PythonCode -> MSStatement PythonCode
forall (r :: * -> *). StatementSym r => SValue r -> MSStatement r
valStmt SValue PythonCode
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 (SValue PythonCode -> SValue PythonCode
forall (r :: * -> *). OORenderSym r => SValue r -> SValue r
readline SValue PythonCode
f)
  discardFileInput :: SValue PythonCode -> MSStatement PythonCode
discardFileInput SValue PythonCode
f = SValue PythonCode -> MSStatement PythonCode
forall (r :: * -> *). StatementSym r => SValue r -> MSStatement r
valStmt (SValue PythonCode -> SValue PythonCode
forall (r :: * -> *). OORenderSym 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 SVariable PythonCode -> SValue PythonCode -> MSStatement PythonCode
forall (r :: * -> *).
AssignStatement r =>
SVariable r -> SValue r -> MSStatement r
&= SValue PythonCode -> SValue PythonCode
forall (r :: * -> *). CommonRenderSym r => SValue r -> SValue r
CP.openFileR' SValue PythonCode
n
  openFileW :: SVariable PythonCode -> SValue PythonCode -> MSStatement PythonCode
openFileW SVariable PythonCode
f SValue PythonCode
n = SVariable PythonCode
f SVariable PythonCode -> SValue PythonCode -> MSStatement PythonCode
forall (r :: * -> *).
AssignStatement r =>
SVariable r -> SValue r -> MSStatement r
&= SValue PythonCode -> SValue PythonCode
forall (r :: * -> *). CommonRenderSym r => SValue r -> SValue r
CP.openFileW' SValue PythonCode
n
  openFileA :: SVariable PythonCode -> SValue PythonCode -> MSStatement PythonCode
openFileA SVariable PythonCode
f SValue PythonCode
n = SVariable PythonCode
f SVariable PythonCode -> SValue PythonCode -> MSStatement PythonCode
forall (r :: * -> *).
AssignStatement r =>
SVariable r -> SValue r -> MSStatement r
&= SValue PythonCode -> SValue PythonCode
forall (r :: * -> *). CommonRenderSym r => SValue r -> SValue r
CP.openFileA' SValue PythonCode
n
  closeFile :: SValue PythonCode -> MSStatement PythonCode
closeFile = String -> SValue PythonCode -> MSStatement PythonCode
forall (r :: * -> *).
OORenderSym r =>
String -> SValue r -> MSStatement r
G.closeFile String
pyClose

  getFileInputLine :: SValue PythonCode -> SVariable PythonCode -> MSStatement PythonCode
getFileInputLine = SValue PythonCode -> SVariable PythonCode -> MSStatement PythonCode
forall (r :: * -> *).
IOStatement r =>
SValue r -> SVariable r -> MSStatement r
getFileInput
  discardFileLine :: SValue PythonCode -> MSStatement PythonCode
discardFileLine = String -> SValue PythonCode -> MSStatement PythonCode
forall (r :: * -> *).
OORenderSym 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 SVariable PythonCode -> SValue PythonCode -> MSStatement PythonCode
forall (r :: * -> *).
AssignStatement r =>
SVariable r -> SValue r -> MSStatement r
&= SValue PythonCode -> SValue PythonCode
forall (r :: * -> *). OORenderSym 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 = SVariable PythonCode -> SValue PythonCode -> MSStatement PythonCode
forall (r :: * -> *).
AssignStatement r =>
SVariable r -> SValue r -> MSStatement r
assign SVariable PythonCode
vnew (SValue PythonCode -> VSFunction PythonCode -> SValue PythonCode
forall (r :: * -> *).
OOFunctionSym r =>
SValue r -> VSFunction r -> SValue r
objAccess SValue PythonCode
s (Char -> VSFunction PythonCode
forall (r :: * -> *). OORenderSym r => Char -> VSFunction r
splitFunc Char
d))

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

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

instance OOFuncAppStatement PythonCode where
  selfInOutCall :: InOutCall PythonCode
selfInOutCall = PosCall PythonCode -> InOutCall PythonCode
forall (r :: * -> *).
CommonRenderSym r =>
(String -> VSType r -> [SValue r] -> SValue r)
-> String
-> [SValue r]
-> [SVariable r]
-> [SVariable r]
-> MSStatement r
CP.inOutCall PosCall PythonCode
forall (r :: * -> *).
OOValueExpression r =>
String -> PosCtorCall r
selfFuncApp

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

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

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

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

  ifCond :: [(SValue PythonCode, MSBody PythonCode)]
-> MSBody PythonCode -> MSStatement PythonCode
ifCond = (Doc -> Doc)
-> Doc
-> OptionalSpace
-> Doc
-> Doc
-> Doc
-> [(SValue PythonCode, MSBody PythonCode)]
-> MSBody PythonCode
-> MSStatement PythonCode
forall (r :: * -> *).
CommonRenderSym r =>
(Doc -> Doc)
-> Doc
-> OptionalSpace
-> Doc
-> Doc
-> Doc
-> [(SValue r, MSBody r)]
-> MSBody r
-> MSStatement r
G.ifCond Doc -> Doc
forall a. a -> a
id Doc
pyBodyStart OptionalSpace
pySpace Doc
pyElseIf Doc
pyBodyEnd Doc
empty
  switch :: SValue PythonCode
-> [(SValue PythonCode, MSBody PythonCode)]
-> MSBody PythonCode
-> MSStatement PythonCode
switch = SValue PythonCode
-> [(SValue PythonCode, MSBody PythonCode)]
-> MSBody PythonCode
-> MSStatement PythonCode
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 = SValue PythonCode
-> MSBody PythonCode -> MSBody PythonCode -> MSStatement PythonCode
forall (r :: * -> *).
CommonRenderSym 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
_ = String -> MSStatement PythonCode
forall a. HasCallStack => String -> a
error (String -> MSStatement PythonCode)
-> String -> MSStatement PythonCode
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 = SVariable PythonCode
-> SValue PythonCode -> MSBody PythonCode -> MSStatement PythonCode
forall (r :: * -> *).
ControlStatement r =>
SVariable r -> SValue r -> MSBody r -> MSStatement r
forEach SVariable PythonCode
i (SValue PythonCode
-> SValue PythonCode -> SValue PythonCode -> SValue PythonCode
forall (r :: * -> *).
CommonRenderSym 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 = (PythonCode (Variable PythonCode)
 -> PythonCode (Value PythonCode)
 -> PythonCode (Body PythonCode)
 -> Doc)
-> SVariable PythonCode
-> SValue PythonCode
-> MSBody PythonCode
-> MSStatement PythonCode
forall (r :: * -> *).
CommonRenderSym r =>
(r (Variable r) -> r (Value r) -> r (Body r) -> Doc)
-> SVariable r -> SValue r -> MSBody r -> MSStatement r
CP.forEach' PythonCode (Variable PythonCode)
-> PythonCode (Value PythonCode)
-> PythonCode (Body PythonCode)
-> Doc
forall (r :: * -> *).
CommonRenderSym r =>
r (Variable r) -> r (Value r) -> r (Body r) -> Doc
pyForEach
  while :: SValue PythonCode -> MSBody PythonCode -> MSStatement PythonCode
while SValue PythonCode
v' MSBody PythonCode
b' = do 
    PythonCode ValData
v <- LensLike'
  (Zoomed (StateT ValueState Identity) (PythonCode ValData))
  MethodState
  ValueState
-> VS (PythonCode ValData)
-> StateT MethodState Identity (PythonCode ValData)
forall c.
LensLike'
  (Zoomed (StateT ValueState Identity) c) MethodState ValueState
-> StateT ValueState Identity c -> StateT MethodState Identity c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (StateT ValueState Identity) (PythonCode ValData))
  MethodState
  ValueState
(ValueState -> Focusing Identity (PythonCode ValData) ValueState)
-> MethodState
-> Focusing Identity (PythonCode ValData) MethodState
Lens' MethodState ValueState
lensMStoVS VS (PythonCode ValData)
SValue PythonCode
v'
    PythonCode Doc
b <- State MethodState (PythonCode Doc)
MSBody PythonCode
b'
    Doc -> MSStatement PythonCode
forall (r :: * -> *). CommonRenderSym r => Doc -> MSStatement r
mkStmtNoEnd (PythonCode (Value PythonCode)
-> PythonCode (Body PythonCode) -> Doc
forall (r :: * -> *).
CommonRenderSym r =>
r (Value r) -> r (Body r) -> Doc
pyWhile PythonCode ValData
PythonCode (Value PythonCode)
v PythonCode Doc
PythonCode (Body PythonCode)
b)

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

  assert :: SValue PythonCode -> SValue PythonCode -> MSStatement PythonCode
assert SValue PythonCode
condition SValue PythonCode
errorMessage = do
      PythonCode ValData
cond <- LensLike'
  (Zoomed (StateT ValueState Identity) (PythonCode ValData))
  MethodState
  ValueState
-> VS (PythonCode ValData)
-> StateT MethodState Identity (PythonCode ValData)
forall c.
LensLike'
  (Zoomed (StateT ValueState Identity) c) MethodState ValueState
-> StateT ValueState Identity c -> StateT MethodState Identity c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (StateT ValueState Identity) (PythonCode ValData))
  MethodState
  ValueState
(ValueState -> Focusing Identity (PythonCode ValData) ValueState)
-> MethodState
-> Focusing Identity (PythonCode ValData) MethodState
Lens' MethodState ValueState
lensMStoVS VS (PythonCode ValData)
SValue PythonCode
condition
      PythonCode ValData
errMsg <- LensLike'
  (Zoomed (StateT ValueState Identity) (PythonCode ValData))
  MethodState
  ValueState
-> VS (PythonCode ValData)
-> StateT MethodState Identity (PythonCode ValData)
forall c.
LensLike'
  (Zoomed (StateT ValueState Identity) c) MethodState ValueState
-> StateT ValueState Identity c -> StateT MethodState Identity c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (StateT ValueState Identity) (PythonCode ValData))
  MethodState
  ValueState
(ValueState -> Focusing Identity (PythonCode ValData) ValueState)
-> MethodState
-> Focusing Identity (PythonCode ValData) MethodState
Lens' MethodState ValueState
lensMStoVS VS (PythonCode ValData)
SValue PythonCode
errorMessage
      Doc -> MSStatement PythonCode
forall (r :: * -> *). CommonRenderSym r => Doc -> MSStatement r
mkStmtNoEnd (PythonCode (Value PythonCode)
-> PythonCode (Value PythonCode) -> Doc
forall (r :: * -> *).
CommonRenderSym r =>
r (Value r) -> r (Value r) -> Doc
pyAssert PythonCode ValData
PythonCode (Value PythonCode)
cond PythonCode ValData
PythonCode (Value PythonCode)
errMsg)

instance ObserverPattern PythonCode where
  notifyObservers :: VSFunction PythonCode
-> VSType PythonCode -> MSStatement PythonCode
notifyObservers = VSFunction PythonCode
-> VSType PythonCode -> MSStatement PythonCode
forall (r :: * -> *).
OORenderSym 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 = String
-> [(String, MSBody PythonCode)]
-> Maybe (SValue PythonCode)
-> Maybe (SVariable PythonCode)
-> State MethodState (PythonCode Doc)
String
-> [(String, MSBody PythonCode)]
-> Maybe (SValue PythonCode)
-> Maybe (SVariable PythonCode)
-> MSBlock PythonCode
forall (r :: * -> *).
(CommonRenderSym r, Monad r) =>
String
-> [(String, MSBody r)]
-> Maybe (SValue r)
-> Maybe (SVariable r)
-> MS (r Doc)
M.runStrategy

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

instance RenderVisibility PythonCode where
  visibilityFromData :: VisibilityTag -> Doc -> PythonCode (Visibility PythonCode)
visibilityFromData VisibilityTag
_ = Doc -> PythonCode Doc
Doc -> PythonCode (Visibility PythonCode)
forall (r :: * -> *) a. Monad r => a -> r a
toCode

instance VisibilityElim PythonCode where
  visibility :: PythonCode (Visibility PythonCode) -> Doc
visibility = PythonCode Doc -> Doc
PythonCode (Visibility PythonCode) -> Doc
forall a. PythonCode a -> a
unPC

instance MethodTypeSym PythonCode where
  type MethodType PythonCode = TypeData
  mType :: VSType PythonCode -> MSMthdType PythonCode
mType = LensLike'
  (Zoomed (StateT ValueState Identity) (PythonCode TypeData))
  MethodState
  ValueState
-> StateT ValueState Identity (PythonCode TypeData)
-> StateT MethodState Identity (PythonCode TypeData)
forall c.
LensLike'
  (Zoomed (StateT ValueState Identity) c) MethodState ValueState
-> StateT ValueState Identity c -> StateT MethodState Identity c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (StateT ValueState Identity) (PythonCode TypeData))
  MethodState
  ValueState
(ValueState -> Focusing Identity (PythonCode TypeData) ValueState)
-> MethodState
-> Focusing Identity (PythonCode TypeData) MethodState
Lens' MethodState ValueState
lensMStoVS
  
instance OOMethodTypeSym PythonCode where
  construct :: String -> MSMthdType PythonCode
construct = String -> MS (PythonCode (Type PythonCode))
String -> MSMthdType PythonCode
forall (r :: * -> *).
CommonRenderSym r =>
String -> MS (r (Type r))
G.construct

instance ParameterSym PythonCode where
  type Parameter PythonCode = ParamData
  param :: SVariable PythonCode -> MSParameter PythonCode
param = (PythonCode (Variable PythonCode) -> Doc)
-> SVariable PythonCode -> MSParameter PythonCode
forall (r :: * -> *).
CommonRenderSym r =>
(r (Variable r) -> Doc) -> SVariable r -> MSParameter r
G.param PythonCode (Variable PythonCode) -> Doc
forall (r :: * -> *). InternalVarElim r => r (Variable r) -> Doc
RC.variable
  pointerParam :: SVariable PythonCode -> MSParameter PythonCode
pointerParam = SVariable PythonCode -> MSParameter PythonCode
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 <- LensLike'
  (Zoomed (StateT ValueState Identity) (PythonCode VarData))
  MethodState
  ValueState
-> StateT ValueState Identity (PythonCode VarData)
-> StateT MethodState Identity (PythonCode VarData)
forall c.
LensLike'
  (Zoomed (StateT ValueState Identity) c) MethodState ValueState
-> StateT ValueState Identity c -> StateT MethodState Identity c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (StateT ValueState Identity) (PythonCode VarData))
  MethodState
  ValueState
(ValueState -> Focusing Identity (PythonCode VarData) ValueState)
-> MethodState
-> Focusing Identity (PythonCode VarData) MethodState
Lens' MethodState ValueState
lensMStoVS StateT ValueState Identity (PythonCode VarData)
SVariable PythonCode
v'
    PythonCode ParamData -> State MethodState (PythonCode ParamData)
forall a s. a -> State s a
toState (PythonCode ParamData -> State MethodState (PythonCode ParamData))
-> PythonCode ParamData -> State MethodState (PythonCode ParamData)
forall a b. (a -> b) -> a -> b
$ (VarData -> Doc -> ParamData)
-> PythonCode VarData -> PythonCode Doc -> PythonCode ParamData
forall (r :: * -> *) a b c.
Applicative r =>
(a -> b -> c) -> r a -> r b -> r c
on2CodeValues VarData -> Doc -> ParamData
pd PythonCode VarData
v (Doc -> PythonCode Doc
forall (r :: * -> *) a. Monad r => a -> r a
toCode Doc
d)
  
instance ParamElim PythonCode where
  parameterName :: PythonCode (Parameter PythonCode) -> String
parameterName = PythonCode VarData -> String
PythonCode (Variable PythonCode) -> String
forall (r :: * -> *). VariableElim r => r (Variable r) -> String
variableName (PythonCode VarData -> String)
-> (PythonCode ParamData -> PythonCode VarData)
-> PythonCode ParamData
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ParamData -> VarData)
-> PythonCode ParamData -> PythonCode VarData
forall (r :: * -> *) a b. Functor r => (a -> b) -> r a -> r b
onCodeValue ParamData -> VarData
paramVar
  parameterType :: PythonCode (Parameter PythonCode) -> PythonCode (Type PythonCode)
parameterType = PythonCode VarData -> PythonCode TypeData
PythonCode (Variable PythonCode) -> PythonCode (Type PythonCode)
forall (r :: * -> *).
VariableElim r =>
r (Variable r) -> r (Type r)
variableType (PythonCode VarData -> PythonCode TypeData)
-> (PythonCode ParamData -> PythonCode VarData)
-> PythonCode ParamData
-> PythonCode TypeData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ParamData -> VarData)
-> PythonCode ParamData -> PythonCode VarData
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 (ParamData -> Doc)
-> (PythonCode ParamData -> ParamData)
-> PythonCode ParamData
-> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PythonCode ParamData -> ParamData
forall a. PythonCode a -> a
unPC

instance MethodSym PythonCode where
  type Method PythonCode = MethodData
  docMain :: MSBody PythonCode -> SMethod PythonCode
docMain = MSBody PythonCode -> SMethod PythonCode
forall (r :: * -> *). MethodSym r => MSBody r -> SMethod r
mainFunction
  function :: String
-> PythonCode (Visibility PythonCode)
-> VSType PythonCode
-> [MSParameter PythonCode]
-> MSBody PythonCode
-> SMethod PythonCode
function = String
-> PythonCode (Visibility PythonCode)
-> VSType PythonCode
-> [MSParameter PythonCode]
-> MSBody PythonCode
-> SMethod PythonCode
forall (r :: * -> *).
OORenderSym r =>
String
-> r (Visibility r)
-> VSType r
-> [MSParameter r]
-> MSBody r
-> SMethod r
G.function
  mainFunction :: MSBody PythonCode -> SMethod PythonCode
mainFunction = MSBody PythonCode -> SMethod PythonCode
forall (r :: * -> *). CommonRenderSym r => MSBody r -> SMethod r
CP.mainBody
  docFunc :: String
-> [String]
-> Maybe String
-> SMethod PythonCode
-> SMethod PythonCode
docFunc = String
-> [String]
-> Maybe String
-> SMethod PythonCode
-> SMethod PythonCode
forall (r :: * -> *).
CommonRenderSym r =>
String -> [String] -> Maybe String -> SMethod r -> SMethod r
CP.doxFunc

  inOutFunc :: String
-> PythonCode (Visibility PythonCode) -> InOutFunc PythonCode
inOutFunc String
n PythonCode (Visibility PythonCode)
s = (VSType PythonCode
 -> [MSParameter PythonCode]
 -> MSBody PythonCode
 -> SMethod PythonCode)
-> InOutFunc PythonCode
forall (r :: * -> *).
CommonRenderSym r =>
(VSType r -> [MSParameter r] -> MSBody r -> SMethod r)
-> [SVariable r]
-> [SVariable r]
-> [SVariable r]
-> MSBody r
-> SMethod r
CP.inOutFunc (String
-> PythonCode (Visibility PythonCode)
-> VSType PythonCode
-> [MSParameter PythonCode]
-> MSBody PythonCode
-> SMethod PythonCode
forall (r :: * -> *).
MethodSym r =>
String
-> r (Visibility r)
-> VSType r
-> [MSParameter r]
-> MSBody r
-> SMethod r
function String
n PythonCode (Visibility PythonCode)
s)
  docInOutFunc :: String
-> PythonCode (Visibility PythonCode) -> DocInOutFunc PythonCode
docInOutFunc String
n PythonCode (Visibility PythonCode)
s = FuncDocRenderer -> InOutFunc PythonCode -> DocInOutFunc PythonCode
forall (r :: * -> *).
CommonRenderSym 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 (String
-> PythonCode (Visibility PythonCode) -> InOutFunc PythonCode
forall (r :: * -> *).
MethodSym r =>
String -> r (Visibility r) -> InOutFunc r
inOutFunc String
n PythonCode (Visibility PythonCode)
s)

instance OOMethodSym PythonCode where
  method :: String
-> PythonCode (Visibility PythonCode)
-> PythonCode (Permanence PythonCode)
-> VSType PythonCode
-> [MSParameter PythonCode]
-> MSBody PythonCode
-> SMethod PythonCode
method = String
-> PythonCode (Visibility PythonCode)
-> PythonCode (Permanence PythonCode)
-> VSType PythonCode
-> [MSParameter PythonCode]
-> MSBody PythonCode
-> SMethod PythonCode
forall (r :: * -> *).
OORenderSym r =>
String
-> r (Visibility r)
-> r (Permanence r)
-> VSType r
-> [MSParameter r]
-> MSBody r
-> SMethod r
G.method
  getMethod :: SVariable PythonCode -> SMethod PythonCode
getMethod = SVariable PythonCode -> SMethod PythonCode
forall (r :: * -> *). OORenderSym r => SVariable r -> SMethod r
G.getMethod
  setMethod :: SVariable PythonCode -> SMethod PythonCode
setMethod = SVariable PythonCode -> SMethod PythonCode
forall (r :: * -> *). OORenderSym r => SVariable r -> SMethod r
G.setMethod
  constructor :: [MSParameter PythonCode]
-> NamedArgs PythonCode -> MSBody PythonCode -> SMethod PythonCode
constructor = String
-> [MSParameter PythonCode]
-> NamedArgs PythonCode
-> MSBody PythonCode
-> SMethod PythonCode
forall (r :: * -> *).
OORenderSym r =>
String
-> [MSParameter r] -> Initializers r -> MSBody r -> SMethod r
CP.constructor String
initName

  inOutMethod :: String
-> PythonCode (Visibility PythonCode)
-> PythonCode (Permanence PythonCode)
-> InOutFunc PythonCode
inOutMethod String
n PythonCode (Visibility PythonCode)
s PythonCode (Permanence PythonCode)
p = (VSType PythonCode
 -> [MSParameter PythonCode]
 -> MSBody PythonCode
 -> SMethod PythonCode)
-> InOutFunc PythonCode
forall (r :: * -> *).
CommonRenderSym r =>
(VSType r -> [MSParameter r] -> MSBody r -> SMethod r)
-> [SVariable r]
-> [SVariable r]
-> [SVariable r]
-> MSBody r
-> SMethod r
CP.inOutFunc (String
-> PythonCode (Visibility PythonCode)
-> PythonCode (Permanence PythonCode)
-> VSType PythonCode
-> [MSParameter PythonCode]
-> MSBody PythonCode
-> SMethod PythonCode
forall (r :: * -> *).
OOMethodSym r =>
String
-> r (Visibility r)
-> r (Permanence r)
-> VSType r
-> [MSParameter r]
-> MSBody r
-> SMethod r
method String
n PythonCode (Visibility PythonCode)
s PythonCode (Permanence PythonCode)
p)
  docInOutMethod :: String
-> PythonCode (Visibility PythonCode)
-> PythonCode (Permanence PythonCode)
-> DocInOutFunc PythonCode
docInOutMethod String
n PythonCode (Visibility PythonCode)
s PythonCode (Permanence PythonCode)
p = FuncDocRenderer -> InOutFunc PythonCode -> DocInOutFunc PythonCode
forall (r :: * -> *).
CommonRenderSym 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 (String
-> PythonCode (Visibility PythonCode)
-> PythonCode (Permanence PythonCode)
-> InOutFunc PythonCode
forall (r :: * -> *).
OOMethodSym r =>
String -> r (Visibility r) -> r (Permanence r) -> InOutFunc r
inOutMethod String
n PythonCode (Visibility PythonCode)
s PythonCode (Permanence PythonCode)
p)

instance RenderMethod PythonCode where
  commentedFunc :: MS (PythonCode (BlockComment PythonCode))
-> SMethod PythonCode -> SMethod PythonCode
commentedFunc MS (PythonCode (BlockComment PythonCode))
cmt SMethod PythonCode
m = (PythonCode MethodData
 -> PythonCode (Doc -> Doc) -> PythonCode MethodData)
-> State MethodState (PythonCode MethodData)
-> State MethodState (PythonCode (Doc -> Doc))
-> State MethodState (PythonCode MethodData)
forall a b c s.
(a -> b -> c) -> State s a -> State s b -> State s c
on2StateValues ((MethodData -> (Doc -> Doc) -> MethodData)
-> PythonCode MethodData
-> PythonCode (Doc -> Doc)
-> PythonCode MethodData
forall (r :: * -> *) a b c.
Applicative r =>
(a -> b -> c) -> r a -> r b -> r c
on2CodeValues MethodData -> (Doc -> Doc) -> MethodData
updateMthd) State MethodState (PythonCode MethodData)
SMethod PythonCode
m 
    ((PythonCode Doc -> PythonCode (Doc -> Doc))
-> State MethodState (PythonCode Doc)
-> State MethodState (PythonCode (Doc -> Doc))
forall a b s. (a -> b) -> State s a -> State s b
onStateValue ((Doc -> Doc -> Doc) -> PythonCode Doc -> PythonCode (Doc -> Doc)
forall (r :: * -> *) a b. Functor r => (a -> b) -> r a -> r b
onCodeValue Doc -> Doc -> Doc
R.commentedItem) State MethodState (PythonCode Doc)
MS (PythonCode (BlockComment PythonCode))
cmt)
    
  mthdFromData :: VisibilityTag -> Doc -> SMethod PythonCode
mthdFromData VisibilityTag
_ Doc
d = PythonCode (Method PythonCode) -> SMethod PythonCode
forall a s. a -> State s a
toState (PythonCode (Method PythonCode) -> SMethod PythonCode)
-> PythonCode (Method PythonCode) -> SMethod PythonCode
forall a b. (a -> b) -> a -> b
$ MethodData -> PythonCode MethodData
forall (r :: * -> *) a. Monad r => a -> r a
toCode (MethodData -> PythonCode MethodData)
-> MethodData -> PythonCode MethodData
forall a b. (a -> b) -> a -> b
$ Doc -> MethodData
mthd Doc
d

instance OORenderMethod PythonCode where
  intMethod :: Bool
-> String
-> PythonCode (Visibility PythonCode)
-> PythonCode (Permanence PythonCode)
-> MSMthdType PythonCode
-> [MSParameter PythonCode]
-> MSBody PythonCode
-> SMethod PythonCode
intMethod Bool
m String
n PythonCode (Visibility PythonCode)
_ PythonCode (Permanence PythonCode)
_ MSMthdType PythonCode
_ [MSParameter PythonCode]
ps MSBody PythonCode
b = do
    (MethodState -> MethodState) -> StateT MethodState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (if Bool
m then MethodState -> MethodState
setCurrMain else MethodState -> MethodState
forall a. a -> a
id)
    PythonCode (Variable PythonCode)
sl <- LensLike'
  (Zoomed
     (StateT ValueState Identity) (PythonCode (Variable PythonCode)))
  MethodState
  ValueState
-> SVariable PythonCode
-> StateT MethodState Identity (PythonCode (Variable PythonCode))
forall c.
LensLike'
  (Zoomed (StateT ValueState Identity) c) MethodState ValueState
-> StateT ValueState Identity c -> StateT MethodState Identity c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed
     (StateT ValueState Identity) (PythonCode (Variable PythonCode)))
  MethodState
  ValueState
(ValueState
 -> Focusing Identity (PythonCode (Variable PythonCode)) ValueState)
-> MethodState
-> Focusing Identity (PythonCode (Variable PythonCode)) MethodState
Lens' MethodState ValueState
lensMStoVS SVariable PythonCode
forall (r :: * -> *). OOVariableSym r => SVariable r
self
    [PythonCode ParamData]
pms <- [State MethodState (PythonCode ParamData)]
-> StateT MethodState Identity [PythonCode ParamData]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [State MethodState (PythonCode ParamData)]
[MSParameter PythonCode]
ps
    MethodData -> PythonCode MethodData
forall (r :: * -> *) a. Monad r => a -> r a
toCode (MethodData -> PythonCode MethodData)
-> (PythonCode (Body PythonCode) -> MethodData)
-> PythonCode (Body PythonCode)
-> PythonCode MethodData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> MethodData
mthd (Doc -> MethodData)
-> (PythonCode (Body PythonCode) -> Doc)
-> PythonCode (Body PythonCode)
-> MethodData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String
-> PythonCode (Variable PythonCode)
-> [PythonCode (Parameter PythonCode)]
-> PythonCode (Body PythonCode)
-> Doc
forall (r :: * -> *).
CommonRenderSym r =>
String -> r (Variable r) -> [r (Parameter r)] -> r (Body r) -> Doc
pyMethod String
n PythonCode (Variable PythonCode)
sl [PythonCode ParamData]
[PythonCode (Parameter PythonCode)]
pms (PythonCode (Body PythonCode) -> PythonCode MethodData)
-> MSBody PythonCode -> State MethodState (PythonCode MethodData)
forall (r :: * -> *) a b. Functor r => (a -> b) -> r a -> r b
<$> MSBody PythonCode
b
  intFunc :: Bool
-> String
-> PythonCode (Visibility PythonCode)
-> PythonCode (Permanence PythonCode)
-> MSMthdType PythonCode
-> [MSParameter PythonCode]
-> MSBody PythonCode
-> SMethod PythonCode
intFunc Bool
m String
n PythonCode (Visibility PythonCode)
_ PythonCode (Permanence PythonCode)
_ MSMthdType PythonCode
_ [MSParameter PythonCode]
ps MSBody PythonCode
b = do
    (MethodState -> MethodState) -> StateT MethodState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (if Bool
m then MethodState -> MethodState
setCurrMain else MethodState -> MethodState
forall a. a -> a
id)
    PythonCode Doc
bd <- State MethodState (PythonCode Doc)
MSBody PythonCode
b
    [PythonCode ParamData]
pms <- [State MethodState (PythonCode ParamData)]
-> StateT MethodState Identity [PythonCode ParamData]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [State MethodState (PythonCode ParamData)]
[MSParameter PythonCode]
ps
    PythonCode MethodData -> State MethodState (PythonCode MethodData)
forall a. a -> StateT MethodState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PythonCode MethodData
 -> State MethodState (PythonCode MethodData))
-> PythonCode MethodData
-> State MethodState (PythonCode MethodData)
forall a b. (a -> b) -> a -> b
$ MethodData -> PythonCode MethodData
forall (r :: * -> *) a. Monad r => a -> r a
toCode (MethodData -> PythonCode MethodData)
-> MethodData -> PythonCode MethodData
forall a b. (a -> b) -> a -> b
$ Doc -> MethodData
mthd (Doc -> MethodData) -> Doc -> MethodData
forall a b. (a -> b) -> a -> b
$ String
-> [PythonCode (Parameter PythonCode)]
-> PythonCode (Body PythonCode)
-> Doc
forall (r :: * -> *).
CommonRenderSym r =>
String -> [r (Parameter r)] -> r (Body r) -> Doc
pyFunction String
n [PythonCode ParamData]
[PythonCode (Parameter PythonCode)]
pms PythonCode Doc
PythonCode (Body PythonCode)
bd
  destructor :: [CSStateVar PythonCode] -> SMethod PythonCode
destructor [CSStateVar PythonCode]
_ = String -> SMethod PythonCode
forall a. HasCallStack => String -> a
error (String -> SMethod PythonCode) -> String -> SMethod PythonCode
forall a b. (a -> b) -> a -> b
$ String -> String
CP.destructorError String
pyName
  
instance MethodElim PythonCode where
  method :: PythonCode (Method PythonCode) -> Doc
method = MethodData -> Doc
mthdDoc (MethodData -> Doc)
-> (PythonCode MethodData -> MethodData)
-> PythonCode MethodData
-> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PythonCode MethodData -> MethodData
forall a. PythonCode a -> a
unPC

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

instance ClassSym PythonCode where
  type Class PythonCode = Doc
  buildClass :: Maybe String
-> [CSStateVar PythonCode]
-> [SMethod PythonCode]
-> [SMethod PythonCode]
-> SClass PythonCode
buildClass Maybe String
par [CSStateVar PythonCode]
sVars [SMethod PythonCode]
cstrs = if [State MethodState (PythonCode MethodData)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [State MethodState (PythonCode MethodData)]
[SMethod PythonCode]
cstrs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1 
                                  then Maybe String
-> [CSStateVar PythonCode]
-> [SMethod PythonCode]
-> [SMethod PythonCode]
-> SClass PythonCode
forall (r :: * -> *).
OORenderSym r =>
Maybe String
-> [CSStateVar r] -> [SMethod r] -> [SMethod r] -> SClass r
G.buildClass Maybe String
par [CSStateVar PythonCode]
sVars [SMethod PythonCode]
cstrs
                                  else String
-> [State MethodState (PythonCode MethodData)]
-> State ClassState (PythonCode Doc)
forall a. HasCallStack => String -> a
error String
pyMultCstrsError
  extraClass :: String
-> Maybe String
-> [CSStateVar PythonCode]
-> [SMethod PythonCode]
-> [SMethod PythonCode]
-> SClass PythonCode
extraClass String
n Maybe String
par [CSStateVar PythonCode]
sVars [SMethod PythonCode]
cstrs = if 
                                  [State MethodState (PythonCode MethodData)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [State MethodState (PythonCode MethodData)]
[SMethod PythonCode]
cstrs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1
                                    then String
-> Maybe String
-> [CSStateVar PythonCode]
-> [SMethod PythonCode]
-> [SMethod PythonCode]
-> SClass PythonCode
forall (r :: * -> *).
OORenderSym r =>
String
-> Maybe String
-> [CSStateVar r]
-> [SMethod r]
-> [SMethod r]
-> SClass r
CP.extraClass String
n Maybe String
par [CSStateVar PythonCode]
sVars [SMethod PythonCode]
cstrs
                                    else String
-> [State MethodState (PythonCode MethodData)]
-> State ClassState (PythonCode Doc)
forall a. HasCallStack => String -> a
error String
pyMultCstrsError
  implementingClass :: String
-> [String]
-> [CSStateVar PythonCode]
-> [SMethod PythonCode]
-> [SMethod PythonCode]
-> SClass PythonCode
implementingClass String
n [String]
iNms [CSStateVar PythonCode]
sVars [SMethod PythonCode]
cstrs = if 
                                  [State MethodState (PythonCode MethodData)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [State MethodState (PythonCode MethodData)]
[SMethod PythonCode]
cstrs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1
                                    then String
-> [String]
-> [CSStateVar PythonCode]
-> [SMethod PythonCode]
-> [SMethod PythonCode]
-> SClass PythonCode
forall (r :: * -> *).
OORenderSym r =>
String
-> [String]
-> [CSStateVar r]
-> [SMethod r]
-> [SMethod r]
-> SClass r
G.implementingClass String
n [String]
iNms [CSStateVar PythonCode]
sVars [SMethod PythonCode]
cstrs
                                    else String
-> [State MethodState (PythonCode MethodData)]
-> State ClassState (PythonCode Doc)
forall a. HasCallStack => String -> a
error String
pyMultCstrsError

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

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

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

  commentedClass :: CS (PythonCode (BlockComment PythonCode))
-> SClass PythonCode -> SClass PythonCode
commentedClass = CS (PythonCode (BlockComment PythonCode))
-> SClass PythonCode -> State ClassState (PythonCode Doc)
CS (PythonCode (BlockComment PythonCode))
-> SClass PythonCode -> SClass PythonCode
forall (r :: * -> *).
(OORenderSym r, Monad r) =>
CS (r (BlockComment r)) -> SClass r -> CS (r Doc)
G.commentedClass
  
instance ClassElim PythonCode where
  class' :: PythonCode (Class PythonCode) -> Doc
class' = PythonCode Doc -> Doc
PythonCode (Class PythonCode) -> Doc
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 = String
-> FS Doc
-> FS Doc
-> FS Doc
-> [SMethod PythonCode]
-> [SClass PythonCode]
-> FSModule PythonCode
forall (r :: * -> *).
OORenderSym 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
    Doc -> FS Doc
forall a. a -> StateT FileState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc -> FS Doc) -> Doc -> FS Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vibcat [
      [Doc] -> Doc
vcat ((String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (PythonCode (Import PythonCode) -> Doc
forall (r :: * -> *). ImportElim r => r (Import r) -> Doc
RC.import' (PythonCode (Import PythonCode) -> Doc)
-> (String -> PythonCode (Import PythonCode)) -> String -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 
        (String -> PythonCode (Import PythonCode)
forall (r :: * -> *). ImportSym r => String -> r (Import r)
langImport :: Label -> PythonCode (Import PythonCode))) [String]
lis),
      [Doc] -> Doc
vcat ((String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (PythonCode (Import PythonCode) -> Doc
forall (r :: * -> *). ImportElim r => r (Import r) -> Doc
RC.import' (PythonCode (Import PythonCode) -> Doc)
-> (String -> PythonCode (Import PythonCode)) -> String -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 
        (String -> PythonCode (Import PythonCode)
forall (r :: * -> *). ImportSym r => String -> r (Import r)
langImport :: Label -> PythonCode (Import PythonCode))) ([String] -> [String]
forall a. Ord a => [a] -> [a]
sort ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [String]
is [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ 
        [String]
libis)),
      [Doc] -> Doc
vcat ((String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (PythonCode (Import PythonCode) -> Doc
forall (r :: * -> *). ImportElim r => r (Import r) -> Doc
RC.import' (PythonCode (Import PythonCode) -> Doc)
-> (String -> PythonCode (Import PythonCode)) -> String -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 
        (String -> PythonCode (Import PythonCode)
forall (r :: * -> *). ImportSym r => String -> r (Import r)
modImport :: Label -> PythonCode (Import PythonCode))) [String]
mis)]) 
    (Doc -> FS Doc
forall a. a -> StateT FileState Identity a
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 = String
-> (Doc -> PythonCode (Module PythonCode))
-> FS Doc
-> FSModule PythonCode
forall (r :: * -> *).
String -> (Doc -> r (Module r)) -> FS Doc -> FSModule r
G.modFromData String
n (ModData -> PythonCode ModData
forall (r :: * -> *) a. Monad r => a -> r a
toCode (ModData -> PythonCode ModData)
-> (Doc -> ModData) -> Doc -> PythonCode ModData
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 = (ModData -> ModData) -> PythonCode ModData -> PythonCode ModData
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 (ModData -> Doc)
-> (PythonCode ModData -> ModData) -> PythonCode ModData -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PythonCode ModData -> ModData
forall a. PythonCode a -> a
unPC

instance BlockCommentSym PythonCode where
  type BlockComment PythonCode = Doc
  blockComment :: [String] -> PythonCode (BlockComment PythonCode)
blockComment [String]
lns = Doc -> PythonCode Doc
forall (r :: * -> *) a. Monad r => a -> r a
toCode (Doc -> PythonCode Doc) -> Doc -> PythonCode Doc
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 = ([String] -> PythonCode Doc)
-> StateT a Identity [String] -> State a (PythonCode Doc)
forall a b s. (a -> b) -> State s a -> State s b
onStateValue (\[String]
lns -> Doc -> PythonCode Doc
forall (r :: * -> *) a. Monad r => a -> r a
toCode (Doc -> PythonCode Doc) -> Doc -> PythonCode Doc
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' = PythonCode Doc -> Doc
PythonCode (BlockComment PythonCode) -> Doc
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 (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ String
pyMath String -> String -> String
`access` String
piLabel

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

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

pyListSize, pyIndex, pyInsert, pyAppendFunc, pyReadline, pyReadlines, pyClose, 
  pySplit, pyRange, pyRstrip, pyMath, pyIn, pyAdd, pyRemove, pyUnion :: String
pyListSize :: String
pyListSize = String
"len"
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"
pyClose :: String
pyClose = String
"close"
pySplit :: String
pySplit = String
"split"
pyRange :: String
pyRange = String
"range"
pyRstrip :: String
pyRstrip = String
"rstrip"
pyMath :: String
pyMath = String
"math"
pyIn :: String
pyIn = String
"in"
pyAdd :: String
pyAdd = String
"add"
pyRemove :: String
pyRemove = String
"remove"
pyUnion :: String
pyUnion = String
"union"

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 = String -> VSOp r
forall (r :: * -> *). Monad r => String -> VSOp r
unOpPrec String
"not"

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

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

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

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

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

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

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

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

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

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

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

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

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

addmathImport :: VS a -> VS a
addmathImport :: forall a. VS a -> VS a
addmathImport = StateT ValueState Identity ()
-> StateT ValueState Identity a -> StateT ValueState Identity a
forall a b.
StateT ValueState Identity a
-> StateT ValueState Identity b -> StateT ValueState Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
(>>) (StateT ValueState Identity ()
 -> StateT ValueState Identity a -> StateT ValueState Identity a)
-> StateT ValueState Identity ()
-> StateT ValueState Identity a
-> StateT ValueState Identity a
forall a b. (a -> b) -> a -> b
$ (ValueState -> ValueState) -> StateT ValueState Identity ()
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 = VS (r OpData) -> VS (r OpData)
forall a. VS a -> VS a
addmathImport (VS (r OpData) -> VS (r OpData))
-> (String -> VS (r OpData)) -> String -> VS (r OpData)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> VS (r OpData)
forall (r :: * -> *). Monad r => String -> VSOp r
unOpPrec (String -> VS (r OpData))
-> (String -> String) -> String -> VS (r OpData)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
access String
pyMath 

splitFunc :: (OORenderSym r) => Char -> VSFunction r
splitFunc :: forall (r :: * -> *). OORenderSym r => Char -> VSFunction r
splitFunc Char
d = String
-> VSType r
-> [SValue r]
-> StateT ValueState Identity (r (Function r))
forall (r :: * -> *).
OOFunctionSym r =>
String -> VSType r -> [SValue r] -> VSFunction r
func String
pySplit (VSType r -> VSType r
forall (r :: * -> *). TypeSym r => VSType r -> VSType r
listType VSType r
forall (r :: * -> *). TypeSym r => VSType r
string) [String -> SValue r
forall (r :: * -> *). Literal r => String -> SValue r
litString [Char
d]]

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

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

range :: (CommonRenderSym r) => SValue r -> SValue r -> SValue r -> SValue r
range :: forall (r :: * -> *).
CommonRenderSym r =>
SValue r -> SValue r -> SValue r -> SValue r
range SValue r
initv SValue r
finalv SValue r
stepv = PosCall r
forall (r :: * -> *). ValueExpression r => PosCall r
funcApp String
pyRange (StateT ValueState Identity (r (Type r))
-> StateT ValueState Identity (r (Type r))
forall (r :: * -> *). TypeSym r => VSType r -> VSType r
listType StateT ValueState Identity (r (Type r))
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 :: (CommonRenderSym r) => SValue r -> SValue r -> SValue r -> SValue r
pyInlineIf :: forall (r :: * -> *).
CommonRenderSym 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'
  Maybe Int -> Maybe Integer -> VSType r -> Doc -> SValue r
forall (r :: * -> *).
RenderValue r =>
Maybe Int -> Maybe Integer -> VSType r -> Doc -> SValue r
valFromData (r (Value r) -> Maybe Int
forall (r :: * -> *). ValueElim r => r (Value r) -> Maybe Int
valuePrec r (Value r)
c) (r (Value r) -> Maybe Integer
forall (r :: * -> *). ValueElim r => r (Value r) -> Maybe Integer
valueInt r (Value r)
c) (r (Type r) -> VSType r
forall a s. a -> State s a
toState (r (Type r) -> VSType r) -> r (Type r) -> VSType r
forall a b. (a -> b) -> a -> b
$ r (Value r) -> r (Type r)
forall (r :: * -> *). ValueSym r => r (Value r) -> r (Type r)
valueType r (Value r)
v1) 
    (r (Value r) -> Doc
forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value r (Value r)
v1 Doc -> Doc -> Doc
<+> Doc
ifLabel Doc -> Doc -> Doc
<+> r (Value r) -> Doc
forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value r (Value r)
c Doc -> Doc -> Doc
<+> Doc
elseLabel Doc -> Doc -> Doc
<+> r (Value r) -> Doc
forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value r (Value r)
v2)

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

pyStringType :: (CommonRenderSym r) => VSType r
pyStringType :: forall (r :: * -> *). CommonRenderSym r => VSType r
pyStringType = CodeType
-> String -> Doc -> StateT ValueState Identity (r (Type r))
forall (r :: * -> *).
RenderType r =>
CodeType -> String -> Doc -> VSType r
typeFromData CodeType
String String
pyString (String -> Doc
text String
pyString)

pyExtNewObjMixedArgs :: (CommonRenderSym r) => Library -> MixedCtorCall r
pyExtNewObjMixedArgs :: forall (r :: * -> *). CommonRenderSym r => MixedCall r
pyExtNewObjMixedArgs String
l VSType r
tp [SValue r]
vs NamedArgs r
ns = VSType r
tp VSType r -> (r (Type r) -> SValue r) -> SValue r
forall a b.
StateT ValueState Identity a
-> (a -> StateT ValueState Identity b)
-> StateT ValueState Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\r (Type r)
t -> Maybe String -> Maybe Doc -> MixedCall r
forall (r :: * -> *).
RenderValue r =>
Maybe String -> Maybe Doc -> MixedCall r
call (String -> Maybe String
forall a. a -> Maybe a
Just String
l) Maybe Doc
forall a. Maybe a
Nothing 
  (r (Type r) -> String
forall (r :: * -> *). TypeElim r => r (Type r) -> String
getTypeString r (Type r)
t) (r (Type r) -> VSType r
forall a. a -> StateT ValueState Identity a
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 <- LensLike'
  (Zoomed
     (StateT ValueState Identity) (PythonCode (Value PythonCode)))
  MethodState
  ValueState
-> SValue PythonCode
-> StateT MethodState Identity (PythonCode (Value PythonCode))
forall c.
LensLike'
  (Zoomed (StateT ValueState Identity) c) MethodState ValueState
-> StateT ValueState Identity c -> StateT MethodState Identity c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed
     (StateT ValueState Identity) (PythonCode (Value PythonCode)))
  MethodState
  ValueState
(ValueState
 -> Focusing Identity (PythonCode (Value PythonCode)) ValueState)
-> MethodState
-> Focusing Identity (PythonCode (Value PythonCode)) MethodState
Lens' MethodState ValueState
lensMStoVS (SValue PythonCode
 -> StateT MethodState Identity (PythonCode (Value PythonCode)))
-> SValue PythonCode
-> StateT MethodState Identity (PythonCode (Value PythonCode))
forall a b. (a -> b) -> a -> b
$ SValue PythonCode -> Maybe (SValue PythonCode) -> SValue PythonCode
forall a. a -> Maybe a -> a
fromMaybe (VSType PythonCode -> Doc -> SValue PythonCode
forall (r :: * -> *).
CommonRenderSym r =>
VSType r -> Doc -> SValue r
mkStateVal VSType PythonCode
forall (r :: * -> *). TypeSym r => VSType r
void Doc
empty) Maybe (SValue PythonCode)
f'
    PythonCode ValData
prf <- LensLike'
  (Zoomed (StateT ValueState Identity) (PythonCode ValData))
  MethodState
  ValueState
-> VS (PythonCode ValData)
-> StateT MethodState Identity (PythonCode ValData)
forall c.
LensLike'
  (Zoomed (StateT ValueState Identity) c) MethodState ValueState
-> StateT ValueState Identity c -> StateT MethodState Identity c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (StateT ValueState Identity) (PythonCode ValData))
  MethodState
  ValueState
(ValueState -> Focusing Identity (PythonCode ValData) ValueState)
-> MethodState
-> Focusing Identity (PythonCode ValData) MethodState
Lens' MethodState ValueState
lensMStoVS VS (PythonCode ValData)
SValue PythonCode
p'
    PythonCode ValData
v <- LensLike'
  (Zoomed (StateT ValueState Identity) (PythonCode ValData))
  MethodState
  ValueState
-> VS (PythonCode ValData)
-> StateT MethodState Identity (PythonCode ValData)
forall c.
LensLike'
  (Zoomed (StateT ValueState Identity) c) MethodState ValueState
-> StateT ValueState Identity c -> StateT MethodState Identity c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (StateT ValueState Identity) (PythonCode ValData))
  MethodState
  ValueState
(ValueState -> Focusing Identity (PythonCode ValData) ValueState)
-> MethodState
-> Focusing Identity (PythonCode ValData) MethodState
Lens' MethodState ValueState
lensMStoVS VS (PythonCode ValData)
SValue PythonCode
v'
    PythonCode ValData
s <- LensLike'
  (Zoomed (StateT ValueState Identity) (PythonCode ValData))
  MethodState
  ValueState
-> VS (PythonCode ValData)
-> StateT MethodState Identity (PythonCode ValData)
forall c.
LensLike'
  (Zoomed (StateT ValueState Identity) c) MethodState ValueState
-> StateT ValueState Identity c -> StateT MethodState Identity c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (StateT ValueState Identity) (PythonCode ValData))
  MethodState
  ValueState
(ValueState -> Focusing Identity (PythonCode ValData) ValueState)
-> MethodState
-> Focusing Identity (PythonCode ValData) MethodState
Lens' MethodState ValueState
lensMStoVS (String -> SValue PythonCode
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
<> 
               PythonCode (Value PythonCode) -> Doc
forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value PythonCode ValData
PythonCode (Value PythonCode)
s
        fl :: Doc
fl = Doc -> Doc -> Doc
emptyIfEmpty (PythonCode (Value PythonCode) -> Doc
forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value PythonCode (Value PythonCode)
f) (Doc -> Doc) -> Doc -> Doc
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
<> PythonCode (Value PythonCode) -> Doc
forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value PythonCode (Value PythonCode)
f
    Doc -> MSStatement PythonCode
forall (r :: * -> *). CommonRenderSym r => Doc -> MSStatement r
mkStmtNoEnd (Doc -> MSStatement PythonCode) -> Doc -> MSStatement PythonCode
forall a b. (a -> b) -> a -> b
$ PythonCode (Value PythonCode) -> Doc
forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value PythonCode ValData
PythonCode (Value PythonCode)
prf Doc -> Doc -> Doc
<> Doc -> Doc
parens (PythonCode (Value PythonCode) -> Doc
forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value PythonCode ValData
PythonCode (Value PythonCode)
v Doc -> Doc -> Doc
<> Doc
nl Doc -> Doc -> Doc
<> Doc
fl)

pyOut :: (CommonRenderSym r) => Bool -> Maybe (SValue r) -> SValue r -> SValue r -> 
  MSStatement r
pyOut :: forall (r :: * -> *).
CommonRenderSym r =>
Bool -> Maybe (SValue r) -> SValue r -> SValue r -> MSStatement r
pyOut Bool
newLn Maybe (SValue r)
f SValue r
printFn SValue r
v = LensLike'
  (Zoomed (StateT ValueState Identity) (r (Value r)))
  MethodState
  ValueState
-> SValue r -> StateT MethodState Identity (r (Value r))
forall c.
LensLike'
  (Zoomed (StateT ValueState Identity) c) MethodState ValueState
-> StateT ValueState Identity c -> StateT MethodState Identity c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (StateT ValueState Identity) (r (Value r)))
  MethodState
  ValueState
(ValueState -> Focusing Identity (r (Value r)) ValueState)
-> MethodState -> Focusing Identity (r (Value r)) MethodState
Lens' MethodState ValueState
lensMStoVS SValue r
v StateT MethodState Identity (r (Value r))
-> (r (Value r) -> StateT MethodState Identity (r (Statement r)))
-> StateT MethodState Identity (r (Statement r))
forall a b.
StateT MethodState Identity a
-> (a -> StateT MethodState Identity b)
-> StateT MethodState Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CodeType -> StateT MethodState Identity (r (Statement r))
pyOut' (CodeType -> StateT MethodState Identity (r (Statement r)))
-> (r (Value r) -> CodeType)
-> r (Value r)
-> StateT MethodState Identity (r (Statement r))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r (Type r) -> CodeType
forall (r :: * -> *). TypeElim r => r (Type r) -> CodeType
getType (r (Type r) -> CodeType)
-> (r (Value r) -> r (Type r)) -> r (Value r) -> CodeType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r (Value r) -> r (Type r)
forall (r :: * -> *). ValueSym r => r (Value r) -> r (Type r)
valueType
  where pyOut' :: CodeType -> StateT MethodState Identity (r (Statement r))
pyOut' (List CodeType
_) = Bool
-> Maybe (SValue r)
-> SValue r
-> SValue r
-> StateT MethodState Identity (r (Statement r))
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
_ = Bool
-> Maybe (SValue r)
-> SValue r
-> SValue r
-> StateT MethodState Identity (r (Statement r))
forall (r :: * -> *).
CommonRenderSym 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 SVariable PythonCode -> SValue PythonCode -> MSStatement PythonCode
forall (r :: * -> *).
AssignStatement r =>
SVariable r -> SValue r -> MSStatement r
&= (StateT ValueState Identity (PythonCode VarData)
SVariable PythonCode
v StateT ValueState Identity (PythonCode VarData)
-> (PythonCode VarData -> VS (PythonCode ValData))
-> VS (PythonCode ValData)
forall a b.
StateT ValueState Identity a
-> (a -> StateT ValueState Identity b)
-> StateT ValueState Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CodeType -> VS (PythonCode ValData)
CodeType -> SValue PythonCode
pyInput' (CodeType -> VS (PythonCode ValData))
-> (PythonCode VarData -> CodeType)
-> PythonCode VarData
-> VS (PythonCode ValData)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PythonCode (Type PythonCode) -> CodeType
forall (r :: * -> *). TypeElim r => r (Type r) -> CodeType
getType (PythonCode (Type PythonCode) -> CodeType)
-> (PythonCode VarData -> PythonCode (Type PythonCode))
-> PythonCode VarData
-> CodeType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PythonCode VarData -> PythonCode (Type PythonCode)
PythonCode (Variable PythonCode) -> PythonCode (Type PythonCode)
forall (r :: * -> *).
VariableElim r =>
r (Variable r) -> r (Type r)
variableType)
  where pyInput' :: CodeType -> SValue PythonCode
pyInput' CodeType
Integer = SValue PythonCode -> SValue PythonCode
forall (r :: * -> *). OORenderSym r => SValue r -> SValue r
readInt SValue PythonCode
inSrc
        pyInput' CodeType
Float = SValue PythonCode -> SValue PythonCode
forall (r :: * -> *). OORenderSym r => SValue r -> SValue r
readDouble SValue PythonCode
inSrc
        pyInput' CodeType
Double = SValue PythonCode -> SValue PythonCode
forall (r :: * -> *). OORenderSym r => SValue r -> SValue r
readDouble SValue PythonCode
inSrc
        pyInput' CodeType
Boolean = SValue PythonCode
inSrc SValue PythonCode -> SValue PythonCode -> SValue PythonCode
forall (r :: * -> *).
Comparison r =>
SValue r -> SValue r -> SValue r
?!= String -> SValue PythonCode
forall (r :: * -> *). Literal r => String -> SValue r
litString String
"0"
        pyInput' CodeType
String = SValue PythonCode -> SValue PythonCode
forall (r :: * -> *). OORenderSym r => SValue r -> SValue r
readString SValue PythonCode
inSrc
        pyInput' CodeType
Char = SValue PythonCode
inSrc
        pyInput' CodeType
_ = String -> VS (PythonCode ValData)
forall a. HasCallStack => String -> a
error String
"Attempt to read a value of unreadable type"

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

pyForEach :: (CommonRenderSym r) => r (Variable r) -> r (Value r) -> r (Body r) -> Doc
pyForEach :: forall (r :: * -> *).
CommonRenderSym 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
<+> r (Variable r) -> Doc
forall (r :: * -> *). InternalVarElim r => r (Variable r) -> Doc
RC.variable r (Variable r)
i Doc -> Doc -> Doc
<+> Doc
inLabel Doc -> Doc -> Doc
<+> r (Value r) -> Doc
forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value r (Value r)
lstVar Doc -> Doc -> Doc
<> Doc
colon,
  Doc -> Doc
indent (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ r (Body r) -> Doc
forall (r :: * -> *). BodyElim r => r (Body r) -> Doc
RC.body r (Body r)
b]

pyWhile :: (CommonRenderSym r) => r (Value r) -> r (Body r) -> Doc
pyWhile :: forall (r :: * -> *).
CommonRenderSym 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
<+> r (Value r) -> Doc
forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value r (Value r)
v Doc -> Doc -> Doc
<> Doc
colon,
  Doc -> Doc
indent (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ r (Body r) -> Doc
forall (r :: * -> *). BodyElim r => r (Body r) -> Doc
RC.body r (Body r)
b]

pyTryCatch :: (CommonRenderSym r) => r (Body r) -> r (Body r) -> Doc
pyTryCatch :: forall (r :: * -> *).
CommonRenderSym 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 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ r (Body r) -> Doc
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 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ r (Body r) -> Doc
forall (r :: * -> *). BodyElim r => r (Body r) -> Doc
RC.body r (Body r)
catchB]

pyAssert :: (CommonRenderSym r) => r (Value r) -> r (Value r) -> Doc
pyAssert :: forall (r :: * -> *).
CommonRenderSym r =>
r (Value r) -> r (Value r) -> Doc
pyAssert r (Value r)
condition r (Value r)
message = String -> Doc
text String
"assert" Doc -> Doc -> Doc
<+> r (Value r) -> Doc
forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value r (Value r)
condition Doc -> Doc -> Doc
<> Doc
comma Doc -> Doc -> Doc
<+> r (Value r) -> Doc
forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value r (Value r)
message

pyListSlice :: (CommonRenderSym r, Monad r) => SVariable r -> SValue r -> SValue r -> 
  SValue r -> SValue r -> MS (r Doc)
pyListSlice :: forall (r :: * -> *).
(CommonRenderSym 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 = LensLike'
  (Zoomed (StateT ValueState Identity) (r Doc))
  MethodState
  ValueState
-> StateT ValueState Identity (r Doc)
-> StateT MethodState Identity (r Doc)
forall c.
LensLike'
  (Zoomed (StateT ValueState Identity) c) MethodState ValueState
-> StateT ValueState Identity c -> StateT MethodState Identity c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (StateT ValueState Identity) (r Doc))
  MethodState
  ValueState
(ValueState -> Focusing Identity (r Doc) ValueState)
-> MethodState -> Focusing Identity (r Doc) MethodState
Lens' MethodState ValueState
lensMStoVS (StateT ValueState Identity (r Doc)
 -> StateT MethodState Identity (r Doc))
-> StateT ValueState Identity (r Doc)
-> StateT MethodState Identity (r Doc)
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
  r Doc -> StateT ValueState Identity (r Doc)
forall a. a -> StateT ValueState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (r Doc -> StateT ValueState Identity (r Doc))
-> r Doc -> StateT ValueState Identity (r Doc)
forall a b. (a -> b) -> a -> b
$ Doc -> r Doc
forall (r :: * -> *) a. Monad r => a -> r a
toCode (Doc -> r Doc) -> Doc -> r Doc
forall a b. (a -> b) -> a -> b
$ r (Variable r) -> Doc
forall (r :: * -> *). InternalVarElim r => r (Variable r) -> Doc
RC.variable r (Variable r)
vnew Doc -> Doc -> Doc
<+> Doc
equals Doc -> Doc -> Doc
<+> r (Value r) -> Doc
forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value r (Value r)
vold Doc -> Doc -> Doc
<> 
    Doc -> Doc
brackets (r (Value r) -> Doc
forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value r (Value r)
b Doc -> Doc -> Doc
<> Doc
colon Doc -> Doc -> Doc
<> r (Value r) -> Doc
forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value r (Value r)
e Doc -> Doc -> Doc
<> Doc
colon Doc -> Doc -> Doc
<> r (Value r) -> Doc
forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value r (Value r)
s)

pyMethod :: (CommonRenderSym r) => Label -> r (Variable r) -> [r (Parameter r)] ->
  r (Body r) -> Doc
pyMethod :: forall (r :: * -> *).
CommonRenderSym 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 (r (Variable r) -> Doc
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 = [r (Parameter r)] -> Doc
forall (r :: * -> *). CommonRenderSym 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 (r (Body r) -> Doc
forall (r :: * -> *). BodyElim r => r (Body r) -> Doc
RC.body r (Body r)
b) = Doc
pyNull'
                  | Bool
otherwise = r (Body r) -> Doc
forall (r :: * -> *). BodyElim r => r (Body r) -> Doc
RC.body r (Body r)
b

pyFunction :: (CommonRenderSym r) => Label -> [r (Parameter r)] -> r (Body r) -> Doc
pyFunction :: forall (r :: * -> *).
CommonRenderSym 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 ([r (Parameter r)] -> Doc
forall (r :: * -> *). CommonRenderSym 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 (r (Body r) -> Doc
forall (r :: * -> *). BodyElim r => r (Body r) -> Doc
RC.body r (Body r)
b) = Doc
pyNull'
              | Bool
otherwise = r (Body r) -> Doc
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]

pyMultCstrsError :: String
pyMultCstrsError :: String
pyMultCstrsError = String
"Python classes cannot have multiple constructors"

pyBlockComment :: [String] -> Doc -> Doc
pyBlockComment :: [String] -> Doc -> Doc
pyBlockComment [String]
lns Doc
cmt = [Doc] -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Doc -> Doc -> Doc
(<+>) Doc
cmt (Doc -> Doc) -> (String -> Doc) -> String -> Doc
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 ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc
start Doc -> Doc -> Doc
<+> String -> Doc
text String
l Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Doc -> Doc -> Doc
(<+>) Doc
mid (Doc -> Doc) -> (String -> Doc) -> String -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 
  String -> Doc
text) [String]
lns

toConstName :: String -> String
toConstName :: String -> String
toConstName (Char
s:Char
s':String
ss) = if Char -> Bool
isLower Char
s Bool -> Bool -> Bool
&& Char -> Bool
isUpper Char
s'
                          then Char -> Char
toUpper Char
s Char -> String -> String
forall a. a -> [a] -> [a]
: Char
'_' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
s' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
toConstName String
ss
                          else Char -> Char
toUpper Char
s Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
toConstName (Char
s' Char -> String -> String
forall a. a -> [a] -> [a]
: String
ss)
toConstName (Char
s:String
ss)    = Char -> Char
toUpper Char
s Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
toConstName String
ss
toConstName String
""        = String
""