{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE PostfixOperators #-}

-- | The logic to render Java code is contained in this module
module Drasil.GOOL.LanguageRenderer.JavaRenderer (
  -- * Java Code Configuration -- defines syntax of all Java code
  JavaCode(..), jName, jVersion
) where

import Utils.Drasil (indent)

import Drasil.GOOL.CodeType (CodeType(..))
import Drasil.GOOL.InterfaceCommon (SharedProg, Label, MSBody, VSType,
  VSFunction, SVariable, SValue, MSStatement, MSParameter, SMethod, BodySym(..),
  oneLiner, 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(..), ScopeSym(..), ParameterSym(..), MethodSym(..))
import Drasil.GOOL.InterfaceGOOL (SClass, CSStateVar, OOProg, ProgramSym(..),
  FileSym(..), ModuleSym(..), ClassSym(..), OOTypeSym(..), OOVariableSym(..),
  StateVarSym(..), PermanenceSym(..), OOValueSym, OOVariableValue,
  OOValueExpression(..), selfFuncApp, newObj, InternalValueExp(..),
  OOFunctionSym(..), ($.), GetSet(..), 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 (dot, new, elseIfLabel, forLabel, tryLabel,
  catchLabel, throwLabel, throwsLabel, importLabel, blockCmtStart, blockCmtEnd, 
  docCmtStart, bodyStart, bodyEnd, endStatement, commentStart, exceptionObj', 
  new', args, printLabel, exceptionObj, mainFunc, new, nullLabel, listSep, 
  access, containing, mathFunc, functionDox, variableList, parameterList, 
  appendToBody, surroundBody, intValue)
import qualified Drasil.GOOL.LanguageRenderer as R (sqrt, abs, log10, 
  log, exp, sin, cos, tan, asin, acos, atan, floor, ceil, pow, package, class', 
  multiStmt, body, printFile, param, listDec, classVar, cast, castObj, static, 
  dynamic, break, continue, private, public, blockCmt, docCmt, addComments, 
  commentedMod, commentedItem)
import Drasil.GOOL.LanguageRenderer.Constructors (mkStmt, mkStateVal, mkVal,
  VSOp, unOpPrec, powerPrec, unExpr, unExpr', unExprNumDbl, typeUnExpr, binExpr,
  binExprNumDbl', typeBinExpr)
import qualified Drasil.GOOL.LanguageRenderer.LanguagePolymorphic as G (
  multiBody, block, multiBlock, listInnerType, obj, csc, sec, cot, negateOp,
  equalOp, notEqualOp, greaterOp, greaterEqualOp, lessOp, lessEqualOp, plusOp,
  minusOp, multOp, divideOp, moduloOp, var, staticVar, objVar, arrayElem,
  litChar, litDouble, litInt, litString, valueOf, arg, argsList, objAccess,
  objMethodCall, 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, defaultOptSpace, local)
import Drasil.GOOL.LanguageRenderer.LanguagePolymorphic (docFuncRepr)
import qualified Drasil.GOOL.LanguageRenderer.CommonPseudoOO as CP (int, 
  constructor, doxFunc, doxClass, doxMod, extVar, classVar, objVarSelf,
  extFuncAppMixedArgs, indexOf, contains, listAddFunc, discardFileLine, intClass, 
  funcType, arrayType, litSet, pi, printSt, arrayDec, arrayDecDef, openFileA, forEach, 
  docMain, mainFunction, buildModule', bindingError, listDecDef, 
  destructorError, stateVarDef, constVar, litArray, call', listSizeFunc, 
  listAccessFunc', notNull, doubleRender, double, openFileR, openFileW, 
  stateVar, floatRender, float, string', intToIndex, indexToInt, global, setMethodCall)
import qualified Drasil.GOOL.LanguageRenderer.CLike as C (float, double, char, 
  listType, void, notOp, andOp, orOp, self, litTrue, litFalse, litFloat, 
  inlineIf, libFuncAppMixedArgs, libNewObjMixedArgs, listSize, increment1, 
  decrement1, varDec, varDecDef, listDec, extObjDecNew, switch, for, while, 
  intFunc, multiAssignError, multiReturnError, multiTypeError, setType)
import qualified Drasil.GOOL.LanguageRenderer.Macros as M (ifExists, 
  runStrategy, listSlice, stringListVals, stringListLists, forRange, 
  notifyObservers)
import Drasil.GOOL.AST (Terminator(..), VisibilityTag(..), qualName,
  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.CodeAnalysis (Exception(..), ExceptionType(..), exception, 
  stdExc, HasException(..))
import Drasil.GOOL.Helpers (emptyIfNull, toCode, toState, onCodeValue, 
  onStateValue, on2CodeValues, on2StateValues, on3CodeValues, on3StateValues, 
  onCodeList, onStateList, on2StateWrapped)
import Drasil.GOOL.State (VS, lensGStoFS, lensMStoFS, lensMStoVS, lensVStoFS, 
  lensVStoMS, modifyReturn, modifyReturnList, revFiles, addProgNameToPaths, 
  addLangImport, addLangImportVS, addExceptionImports, getModuleName, 
  setFileType, getClassName, setCurrMain, setOutputsDeclared, 
  isOutputsDeclared, getExceptions, getMethodExcMap, addExceptions, useVarName,
  genLoopIndex, setVarScope)

import Prelude hiding (break,print,sin,cos,tan,floor,(<>))
import Control.Lens.Zoom (zoom)
import Control.Monad (join)
import Control.Monad.State (modify)
import Data.Composition ((.:))
import qualified Data.Map as Map (lookup)
import Data.List (nub, intercalate, sort)
import Text.PrettyPrint.HughesPJ (Doc, text, (<>), (<+>), ($$), parens, empty, 
  equals, vcat, lbrace, rbrace, braces, colon, quotes)

jExt :: String
jExt :: String
jExt = String
"java"

newtype JavaCode a = JC {forall a. JavaCode a -> a
unJC :: a}

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

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

instance Monad JavaCode where
  JC a
x >>= :: forall a b. JavaCode a -> (a -> JavaCode b) -> JavaCode b
>>= a -> JavaCode b
f = a -> JavaCode b
f a
x

instance SharedProg JavaCode
instance OOProg JavaCode

instance ProgramSym JavaCode where
  type Program JavaCode = ProgData
  prog :: String -> String -> [SFile JavaCode] -> GSProgram JavaCode
prog String
n String
st [SFile JavaCode]
fs = [State GOOLState (JavaCode FileData)]
-> (GOOLState -> GOOLState)
-> ([JavaCode FileData] -> JavaCode ProgData)
-> State GOOLState (JavaCode ProgData)
forall s b a. [State s b] -> (s -> s) -> ([b] -> a) -> State s a
modifyReturnList ((StateT FileState Identity (JavaCode FileData)
 -> State GOOLState (JavaCode FileData))
-> [StateT FileState Identity (JavaCode FileData)]
-> [State GOOLState (JavaCode FileData)]
forall a b. (a -> b) -> [a] -> [b]
map (LensLike'
  (Zoomed (StateT FileState Identity) (JavaCode FileData))
  GOOLState
  FileState
-> StateT FileState Identity (JavaCode FileData)
-> State GOOLState (JavaCode 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) (JavaCode FileData))
  GOOLState
  FileState
(FileState -> Focusing Identity (JavaCode FileData) FileState)
-> GOOLState -> Focusing Identity (JavaCode FileData) GOOLState
Lens' GOOLState FileState
lensGStoFS) [StateT FileState Identity (JavaCode FileData)]
[SFile JavaCode]
fs) (GOOLState -> GOOLState
revFiles (GOOLState -> GOOLState)
-> (GOOLState -> GOOLState) -> GOOLState -> GOOLState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 
    String -> GOOLState -> GOOLState
addProgNameToPaths String
n) (([FileData] -> ProgData)
-> [JavaCode FileData] -> JavaCode ProgData
forall (m :: * -> *) a b. Monad m => ([a] -> b) -> [m a] -> m b
onCodeList (String -> String -> [FileData] -> ProgData
progD String
n String
st ([FileData] -> ProgData)
-> ([FileData] -> [FileData]) -> [FileData] -> ProgData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FileData -> FileData) -> [FileData] -> [FileData]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Doc -> FileData -> FileData
R.package String
n 
    Doc
endStatement)))

instance CommonRenderSym JavaCode
instance OORenderSym JavaCode

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

  docMod :: String -> [String] -> String -> SFile JavaCode -> SFile JavaCode
docMod = String
-> String -> [String] -> String -> SFile JavaCode -> SFile JavaCode
forall (r :: * -> *).
OORenderSym r =>
String -> String -> [String] -> String -> SFile r -> SFile r
CP.doxMod String
jExt

instance RenderFile JavaCode where
  top :: JavaCode (Module JavaCode) -> JavaCode (Block JavaCode)
top JavaCode (Module JavaCode)
_ = Doc -> JavaCode Doc
forall (r :: * -> *) a. Monad r => a -> r a
toCode Doc
empty
  bottom :: JavaCode (Block JavaCode)
bottom = Doc -> JavaCode Doc
forall (r :: * -> *) a. Monad r => a -> r a
toCode Doc
empty
  
  commentedMod :: SFile JavaCode
-> FS (JavaCode (BlockComment JavaCode)) -> SFile JavaCode
commentedMod = (JavaCode FileData -> JavaCode Doc -> JavaCode FileData)
-> StateT FileState Identity (JavaCode FileData)
-> State FileState (JavaCode Doc)
-> StateT FileState Identity (JavaCode FileData)
forall a b c s.
(a -> b -> c) -> State s a -> State s b -> State s c
on2StateValues ((FileData -> Doc -> FileData)
-> JavaCode FileData -> JavaCode Doc -> JavaCode 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 JavaCode -> SFile JavaCode
fileFromData = (String -> JavaCode (Module JavaCode) -> JavaCode (File JavaCode))
-> String -> FSModule JavaCode -> SFile JavaCode
forall (r :: * -> *).
OORenderSym r =>
(String -> r (Module r) -> r (File r))
-> String -> FSModule r -> SFile r
G.fileFromData ((ModData -> FileData) -> JavaCode ModData -> JavaCode FileData
forall (r :: * -> *) a b. Functor r => (a -> b) -> r a -> r b
onCodeValue ((ModData -> FileData) -> JavaCode ModData -> JavaCode FileData)
-> (String -> ModData -> FileData)
-> String
-> JavaCode ModData
-> JavaCode FileData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ModData -> FileData
fileD)

instance ImportSym JavaCode where
  type Import JavaCode = Doc
  langImport :: String -> JavaCode (Import JavaCode)
langImport = Doc -> JavaCode Doc
forall (r :: * -> *) a. Monad r => a -> r a
toCode (Doc -> JavaCode Doc) -> (String -> Doc) -> String -> JavaCode Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Doc
jImport
  modImport :: String -> JavaCode (Import JavaCode)
modImport = String -> JavaCode (Import JavaCode)
forall (r :: * -> *). ImportSym r => String -> r (Import r)
langImport

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

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

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

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

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

instance RenderBody JavaCode where
  multiBody :: [MSBody JavaCode] -> MSBody JavaCode
multiBody = [MSBody JavaCode] -> State MethodState (JavaCode Doc)
[MSBody JavaCode] -> MSBody JavaCode
forall (r :: * -> *).
(CommonRenderSym r, Monad r) =>
[MSBody r] -> MS (r Doc)
G.multiBody 

instance BodyElim JavaCode where
  body :: JavaCode (Body JavaCode) -> Doc
body = JavaCode Doc -> Doc
JavaCode (Body JavaCode) -> Doc
forall a. JavaCode a -> a
unJC

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

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

instance BlockElim JavaCode where
  block :: JavaCode (Block JavaCode) -> Doc
block = JavaCode Doc -> Doc
JavaCode (Block JavaCode) -> Doc
forall a. JavaCode a -> a
unJC

instance TypeSym JavaCode where
  type Type JavaCode = TypeData
  bool :: VSType JavaCode
bool = VSType JavaCode
forall (r :: * -> *). CommonRenderSym r => VSType r
jBoolType
  int :: VSType JavaCode
int = VSType JavaCode
forall (r :: * -> *). CommonRenderSym r => VSType r
CP.int
  float :: VSType JavaCode
float = VSType JavaCode
forall (r :: * -> *). CommonRenderSym r => VSType r
C.float
  double :: VSType JavaCode
double = VSType JavaCode
forall (r :: * -> *). CommonRenderSym r => VSType r
C.double
  char :: VSType JavaCode
char = VSType JavaCode
forall (r :: * -> *). CommonRenderSym r => VSType r
C.char
  string :: VSType JavaCode
string = VSType JavaCode
forall (r :: * -> *). CommonRenderSym r => VSType r
CP.string'
  infile :: VSType JavaCode
infile = VSType JavaCode
forall (r :: * -> *). CommonRenderSym r => VSType r
jInfileType
  outfile :: VSType JavaCode
outfile = VSType JavaCode
forall (r :: * -> *). CommonRenderSym r => VSType r
jOutfileType
  listType :: VSType JavaCode -> VSType JavaCode
listType = VSType JavaCode -> VSType JavaCode
forall (r :: * -> *). CommonRenderSym r => VSType r -> VSType r
jListType
  setType :: VSType JavaCode -> VSType JavaCode
setType = VSType JavaCode -> VSType JavaCode
forall (r :: * -> *). OORenderSym r => VSType r -> VSType r
jSetType
  arrayType :: VSType JavaCode -> VSType JavaCode
arrayType = VSType JavaCode -> VSType JavaCode
forall (r :: * -> *). CommonRenderSym r => VSType r -> VSType r
CP.arrayType
  listInnerType :: VSType JavaCode -> VSType JavaCode
listInnerType = VSType JavaCode -> VSType JavaCode
forall (r :: * -> *). OORenderSym r => VSType r -> VSType r
G.listInnerType
  funcType :: [VSType JavaCode] -> VSType JavaCode -> VSType JavaCode
funcType = [VSType JavaCode] -> VSType JavaCode -> VSType JavaCode
forall (r :: * -> *).
CommonRenderSym r =>
[VSType r] -> VSType r -> VSType r
CP.funcType
  void :: VSType JavaCode
void = VSType JavaCode
forall (r :: * -> *). CommonRenderSym r => VSType r
C.void

instance OOTypeSym JavaCode where
  obj :: String -> VSType JavaCode
obj = String -> VSType JavaCode
forall (r :: * -> *). CommonRenderSym r => String -> VSType r
G.obj
  
instance TypeElim JavaCode where
  getType :: JavaCode (Type JavaCode) -> CodeType
getType = TypeData -> CodeType
cType (TypeData -> CodeType)
-> (JavaCode TypeData -> TypeData) -> JavaCode TypeData -> CodeType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JavaCode TypeData -> TypeData
forall a. JavaCode a -> a
unJC
  getTypeString :: JavaCode (Type JavaCode) -> String
getTypeString = TypeData -> String
typeString (TypeData -> String)
-> (JavaCode TypeData -> TypeData) -> JavaCode TypeData -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JavaCode TypeData -> TypeData
forall a. JavaCode a -> a
unJC
  
instance RenderType JavaCode where
  multiType :: [VSType JavaCode] -> VSType JavaCode
multiType [VSType JavaCode]
_ = String -> VSType JavaCode
forall a. HasCallStack => String -> a
error (String -> VSType JavaCode) -> String -> VSType JavaCode
forall a b. (a -> b) -> a -> b
$ String -> String
C.multiTypeError String
jName
  typeFromData :: CodeType -> String -> Doc -> VSType JavaCode
typeFromData CodeType
t String
s Doc
d = JavaCode (Type JavaCode) -> VSType JavaCode
forall a s. a -> State s a
toState (JavaCode (Type JavaCode) -> VSType JavaCode)
-> JavaCode (Type JavaCode) -> VSType JavaCode
forall a b. (a -> b) -> a -> b
$ TypeData -> JavaCode TypeData
forall (r :: * -> *) a. Monad r => a -> r a
toCode (TypeData -> JavaCode TypeData) -> TypeData -> JavaCode TypeData
forall a b. (a -> b) -> a -> b
$ CodeType -> String -> Doc -> TypeData
td CodeType
t String
s Doc
d

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

instance UnaryOpSym JavaCode where
  type UnaryOp JavaCode = OpData
  notOp :: VSUnOp JavaCode
notOp = VSOp JavaCode
VSUnOp JavaCode
forall (r :: * -> *). Monad r => VSOp r
C.notOp
  negateOp :: VSUnOp JavaCode
negateOp = VSOp JavaCode
VSUnOp JavaCode
forall (r :: * -> *). Monad r => VSOp r
G.negateOp
  sqrtOp :: VSUnOp JavaCode
sqrtOp = String -> VSOp JavaCode
forall (r :: * -> *). Monad r => String -> VSOp r
jUnaryMath String
R.sqrt
  absOp :: VSUnOp JavaCode
absOp = String -> VSOp JavaCode
forall (r :: * -> *). Monad r => String -> VSOp r
jUnaryMath String
R.abs
  logOp :: VSUnOp JavaCode
logOp = String -> VSOp JavaCode
forall (r :: * -> *). Monad r => String -> VSOp r
jUnaryMath String
R.log10
  lnOp :: VSUnOp JavaCode
lnOp = String -> VSOp JavaCode
forall (r :: * -> *). Monad r => String -> VSOp r
jUnaryMath String
R.log
  expOp :: VSUnOp JavaCode
expOp = String -> VSOp JavaCode
forall (r :: * -> *). Monad r => String -> VSOp r
jUnaryMath String
R.exp
  sinOp :: VSUnOp JavaCode
sinOp = String -> VSOp JavaCode
forall (r :: * -> *). Monad r => String -> VSOp r
jUnaryMath String
R.sin
  cosOp :: VSUnOp JavaCode
cosOp = String -> VSOp JavaCode
forall (r :: * -> *). Monad r => String -> VSOp r
jUnaryMath String
R.cos
  tanOp :: VSUnOp JavaCode
tanOp = String -> VSOp JavaCode
forall (r :: * -> *). Monad r => String -> VSOp r
jUnaryMath String
R.tan
  asinOp :: VSUnOp JavaCode
asinOp = String -> VSOp JavaCode
forall (r :: * -> *). Monad r => String -> VSOp r
jUnaryMath String
R.asin
  acosOp :: VSUnOp JavaCode
acosOp = String -> VSOp JavaCode
forall (r :: * -> *). Monad r => String -> VSOp r
jUnaryMath String
R.acos
  atanOp :: VSUnOp JavaCode
atanOp = String -> VSOp JavaCode
forall (r :: * -> *). Monad r => String -> VSOp r
jUnaryMath String
R.atan
  floorOp :: VSUnOp JavaCode
floorOp = String -> VSOp JavaCode
forall (r :: * -> *). Monad r => String -> VSOp r
jUnaryMath String
R.floor
  ceilOp :: VSUnOp JavaCode
ceilOp = String -> VSOp JavaCode
forall (r :: * -> *). Monad r => String -> VSOp r
jUnaryMath String
R.ceil

instance BinaryOpSym JavaCode where
  type BinaryOp JavaCode = OpData
  equalOp :: VSBinOp JavaCode
equalOp = VSOp JavaCode
VSBinOp JavaCode
forall (r :: * -> *). Monad r => VSOp r
G.equalOp
  notEqualOp :: VSBinOp JavaCode
notEqualOp = VSOp JavaCode
VSBinOp JavaCode
forall (r :: * -> *). Monad r => VSOp r
G.notEqualOp
  greaterOp :: VSBinOp JavaCode
greaterOp = VSOp JavaCode
VSBinOp JavaCode
forall (r :: * -> *). Monad r => VSOp r
G.greaterOp
  greaterEqualOp :: VSBinOp JavaCode
greaterEqualOp = VSOp JavaCode
VSBinOp JavaCode
forall (r :: * -> *). Monad r => VSOp r
G.greaterEqualOp
  lessOp :: VSBinOp JavaCode
lessOp = VSOp JavaCode
VSBinOp JavaCode
forall (r :: * -> *). Monad r => VSOp r
G.lessOp
  lessEqualOp :: VSBinOp JavaCode
lessEqualOp = VSOp JavaCode
VSBinOp JavaCode
forall (r :: * -> *). Monad r => VSOp r
G.lessEqualOp
  plusOp :: VSBinOp JavaCode
plusOp = VSOp JavaCode
VSBinOp JavaCode
forall (r :: * -> *). Monad r => VSOp r
G.plusOp
  minusOp :: VSBinOp JavaCode
minusOp = VSOp JavaCode
VSBinOp JavaCode
forall (r :: * -> *). Monad r => VSOp r
G.minusOp
  multOp :: VSBinOp JavaCode
multOp = VSOp JavaCode
VSBinOp JavaCode
forall (r :: * -> *). Monad r => VSOp r
G.multOp
  divideOp :: VSBinOp JavaCode
divideOp = VSOp JavaCode
VSBinOp JavaCode
forall (r :: * -> *). Monad r => VSOp r
G.divideOp
  powerOp :: VSBinOp JavaCode
powerOp = String -> VSOp JavaCode
forall (r :: * -> *). Monad r => String -> VSOp r
powerPrec (String -> VSOp JavaCode) -> String -> VSOp JavaCode
forall a b. (a -> b) -> a -> b
$ String -> String
mathFunc String
R.pow
  moduloOp :: VSBinOp JavaCode
moduloOp = VSOp JavaCode
VSBinOp JavaCode
forall (r :: * -> *). Monad r => VSOp r
G.moduloOp
  andOp :: VSBinOp JavaCode
andOp = VSOp JavaCode
VSBinOp JavaCode
forall (r :: * -> *). Monad r => VSOp r
C.andOp
  orOp :: VSBinOp JavaCode
orOp = VSOp JavaCode
VSBinOp JavaCode
forall (r :: * -> *). Monad r => VSOp r
C.orOp

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

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

instance ScopeElim JavaCode where
  scopeData :: JavaCode (Scope JavaCode) -> ScopeData
scopeData = JavaCode ScopeData -> ScopeData
JavaCode (Scope JavaCode) -> ScopeData
forall a. JavaCode a -> a
unJC

instance VariableSym JavaCode where
  type Variable JavaCode = VarData
  var :: String -> VSType JavaCode -> SVariable JavaCode
var         = String -> VSType JavaCode -> SVariable JavaCode
forall (r :: * -> *).
CommonRenderSym r =>
String -> VSType r -> SVariable r
G.var
  constant :: String -> VSType JavaCode -> SVariable JavaCode
constant    = String -> VSType JavaCode -> SVariable JavaCode
forall (r :: * -> *).
VariableSym r =>
String -> VSType r -> SVariable r
var
  extVar :: String -> String -> VSType JavaCode -> SVariable JavaCode
extVar      = String -> String -> VSType JavaCode -> SVariable JavaCode
forall (r :: * -> *).
CommonRenderSym r =>
String -> String -> VSType r -> SVariable r
CP.extVar
  arrayElem :: Integer -> SVariable JavaCode -> SVariable JavaCode
arrayElem Integer
i = SValue JavaCode -> SVariable JavaCode -> SVariable JavaCode
forall (r :: * -> *).
OORenderSym r =>
SValue r -> SVariable r -> SVariable r
G.arrayElem (Integer -> SValue JavaCode
forall (r :: * -> *). Literal r => Integer -> SValue r
litInt Integer
i)

instance OOVariableSym JavaCode where
  staticVar' :: Bool -> String -> VSType JavaCode -> SVariable JavaCode
staticVar' Bool
_ = String -> VSType JavaCode -> SVariable JavaCode
forall (r :: * -> *).
CommonRenderSym r =>
String -> VSType r -> SVariable r
G.staticVar
  self :: SVariable JavaCode
self = SVariable JavaCode
forall (r :: * -> *). OORenderSym r => SVariable r
C.self
  classVar :: VSType JavaCode -> SVariable JavaCode -> SVariable JavaCode
classVar = (Doc -> Doc -> Doc)
-> VSType JavaCode -> SVariable JavaCode -> SVariable JavaCode
forall (r :: * -> *).
CommonRenderSym r =>
(Doc -> Doc -> Doc) -> VSType r -> SVariable r -> SVariable r
CP.classVar Doc -> Doc -> Doc
R.classVar
  extClassVar :: VSType JavaCode -> SVariable JavaCode -> SVariable JavaCode
extClassVar = VSType JavaCode -> SVariable JavaCode -> SVariable JavaCode
forall (r :: * -> *).
OOVariableSym r =>
VSType r -> SVariable r -> SVariable r
classVar
  objVar :: SVariable JavaCode -> SVariable JavaCode -> SVariable JavaCode
objVar = SVariable JavaCode -> SVariable JavaCode -> SVariable JavaCode
forall (r :: * -> *).
CommonRenderSym r =>
SVariable r -> SVariable r -> SVariable r
G.objVar
  objVarSelf :: SVariable JavaCode -> SVariable JavaCode
objVarSelf = SVariable JavaCode -> SVariable JavaCode
forall (r :: * -> *). OORenderSym r => SVariable r -> SVariable r
CP.objVarSelf

instance VariableElim JavaCode where
  variableName :: JavaCode (Variable JavaCode) -> String
variableName = VarData -> String
varName (VarData -> String)
-> (JavaCode VarData -> VarData) -> JavaCode VarData -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JavaCode VarData -> VarData
forall a. JavaCode a -> a
unJC
  variableType :: JavaCode (Variable JavaCode) -> JavaCode (Type JavaCode)
variableType = (VarData -> TypeData) -> JavaCode VarData -> JavaCode TypeData
forall (r :: * -> *) a b. Functor r => (a -> b) -> r a -> r b
onCodeValue VarData -> TypeData
varType
  
instance InternalVarElim JavaCode where
  variableBind :: JavaCode (Variable JavaCode) -> Binding
variableBind = VarData -> Binding
varBind (VarData -> Binding)
-> (JavaCode VarData -> VarData) -> JavaCode VarData -> Binding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JavaCode VarData -> VarData
forall a. JavaCode a -> a
unJC
  variable :: JavaCode (Variable JavaCode) -> Doc
variable = VarData -> Doc
varDoc (VarData -> Doc)
-> (JavaCode VarData -> VarData) -> JavaCode VarData -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JavaCode VarData -> VarData
forall a. JavaCode a -> a
unJC

instance RenderVariable JavaCode where
  varFromData :: Binding -> String -> VSType JavaCode -> Doc -> SVariable JavaCode
varFromData Binding
b String
n VSType JavaCode
t' Doc
d =  do 
    JavaCode TypeData
t <- StateT ValueState Identity (JavaCode TypeData)
VSType JavaCode
t'
    JavaCode VarData -> State ValueState (JavaCode VarData)
forall a s. a -> State s a
toState (JavaCode VarData -> State ValueState (JavaCode VarData))
-> JavaCode VarData -> State ValueState (JavaCode VarData)
forall a b. (a -> b) -> a -> b
$ (TypeData -> Doc -> VarData)
-> JavaCode TypeData -> JavaCode Doc -> JavaCode 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) JavaCode TypeData
t (Doc -> JavaCode Doc
forall (r :: * -> *) a. Monad r => a -> r a
toCode Doc
d)

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

instance OOValueSym JavaCode

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

instance Literal JavaCode where
  litTrue :: SValue JavaCode
litTrue = SValue JavaCode
forall (r :: * -> *). CommonRenderSym r => SValue r
C.litTrue
  litFalse :: SValue JavaCode
litFalse = SValue JavaCode
forall (r :: * -> *). CommonRenderSym r => SValue r
C.litFalse
  litChar :: Char -> SValue JavaCode
litChar = (Doc -> Doc) -> Char -> SValue JavaCode
forall (r :: * -> *).
CommonRenderSym r =>
(Doc -> Doc) -> Char -> SValue r
G.litChar Doc -> Doc
quotes
  litDouble :: Double -> SValue JavaCode
litDouble = Double -> SValue JavaCode
forall (r :: * -> *). CommonRenderSym r => Double -> SValue r
G.litDouble
  litFloat :: Float -> SValue JavaCode
litFloat = Float -> SValue JavaCode
forall (r :: * -> *). CommonRenderSym r => Float -> SValue r
C.litFloat
  litInt :: Integer -> SValue JavaCode
litInt = Integer -> SValue JavaCode
forall (r :: * -> *). CommonRenderSym r => Integer -> SValue r
G.litInt
  litString :: String -> SValue JavaCode
litString = String -> SValue JavaCode
forall (r :: * -> *). CommonRenderSym r => String -> SValue r
G.litString
  litArray :: VSType JavaCode -> [SValue JavaCode] -> SValue JavaCode
litArray = (Doc -> Doc)
-> VSType JavaCode -> [SValue JavaCode] -> SValue JavaCode
forall (r :: * -> *).
CommonRenderSym r =>
(Doc -> Doc) -> VSType r -> [SValue r] -> SValue r
CP.litArray Doc -> Doc
braces
  litSet :: VSType JavaCode -> [SValue JavaCode] -> SValue JavaCode
litSet = (Doc -> Doc)
-> (Doc -> Doc)
-> VSType JavaCode
-> [SValue JavaCode]
-> SValue JavaCode
forall (r :: * -> *).
CommonRenderSym r =>
(Doc -> Doc) -> (Doc -> Doc) -> VSType r -> [SValue r] -> SValue r
CP.litSet (String -> Doc
text String
jSetOf <>) Doc -> Doc
parens

  litList :: VSType JavaCode -> [SValue JavaCode] -> SValue JavaCode
litList VSType JavaCode
t [SValue JavaCode]
es = do
    LensLike'
  (Zoomed (StateT MethodState Identity) ()) ValueState MethodState
-> StateT MethodState Identity () -> StateT ValueState Identity ()
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) ()) ValueState MethodState
Lens' ValueState MethodState
lensVStoMS (StateT MethodState Identity () -> StateT ValueState Identity ())
-> StateT MethodState Identity () -> StateT ValueState Identity ()
forall a b. (a -> b) -> a -> b
$ (MethodState -> MethodState) -> StateT MethodState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (if [VS (JavaCode ValData)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [VS (JavaCode ValData)]
[SValue JavaCode]
es then MethodState -> MethodState
forall a. a -> a
id else String -> MethodState -> MethodState
addLangImport (String -> MethodState -> MethodState)
-> String -> MethodState -> MethodState
forall a b. (a -> b) -> a -> b
$ String -> String
utilImport
      String
jArrays)
    VSType JavaCode -> [SValue JavaCode] -> SValue JavaCode
forall (r :: * -> *). OOValueExpression r => PosCtorCall r
newObj (VSType JavaCode -> VSType JavaCode
forall (r :: * -> *). TypeSym r => VSType r -> VSType r
listType VSType JavaCode
t) [VSType JavaCode -> [SValue JavaCode] -> SValue JavaCode
jAsListFunc VSType JavaCode
t [SValue JavaCode]
es | Bool -> Bool
not ([VS (JavaCode ValData)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [VS (JavaCode ValData)]
[SValue JavaCode]
es)]

instance MathConstant JavaCode where
  pi :: SValue JavaCode
pi = SValue JavaCode
forall (r :: * -> *). CommonRenderSym r => SValue r
CP.pi

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

instance OOVariableValue JavaCode

instance CommandLineArgs JavaCode where
  arg :: Integer -> SValue JavaCode
arg Integer
n = SValue JavaCode -> SValue JavaCode -> SValue JavaCode
forall (r :: * -> *).
CommonRenderSym r =>
SValue r -> SValue r -> SValue r
G.arg (Integer -> SValue JavaCode
forall (r :: * -> *). Literal r => Integer -> SValue r
litInt Integer
n) SValue JavaCode
forall (r :: * -> *). CommandLineArgs r => SValue r
argsList
  argsList :: SValue JavaCode
argsList = String -> SValue JavaCode
forall (r :: * -> *). CommonRenderSym r => String -> SValue r
G.argsList String
args
  argExists :: Integer -> SValue JavaCode
argExists Integer
i = SValue JavaCode -> SValue JavaCode
forall (r :: * -> *). List r => SValue r -> SValue r
listSize SValue JavaCode
forall (r :: * -> *). CommandLineArgs r => SValue r
argsList SValue JavaCode -> SValue JavaCode -> SValue JavaCode
forall (r :: * -> *).
Comparison r =>
SValue r -> SValue r -> SValue r
?> Integer -> SValue JavaCode
forall (r :: * -> *). Literal r => Integer -> SValue r
litInt (Integer -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i)

instance NumericExpression JavaCode where
  #~ :: SValue JavaCode -> SValue JavaCode
(#~) = VSUnOp JavaCode -> SValue JavaCode -> SValue JavaCode
forall (r :: * -> *).
CommonRenderSym r =>
VSUnOp r -> SValue r -> SValue r
unExpr' VSUnOp JavaCode
forall (r :: * -> *). UnaryOpSym r => VSUnOp r
negateOp
  #/^ :: SValue JavaCode -> SValue JavaCode
(#/^) = VSUnOp JavaCode -> SValue JavaCode -> SValue JavaCode
forall (r :: * -> *).
CommonRenderSym r =>
VSUnOp r -> SValue r -> SValue r
unExprNumDbl VSUnOp JavaCode
forall (r :: * -> *). UnaryOpSym r => VSUnOp r
sqrtOp
  #| :: SValue JavaCode -> SValue JavaCode
(#|) = VSUnOp JavaCode -> SValue JavaCode -> SValue JavaCode
forall (r :: * -> *).
CommonRenderSym r =>
VSUnOp r -> SValue r -> SValue r
unExpr VSUnOp JavaCode
forall (r :: * -> *). UnaryOpSym r => VSUnOp r
absOp
  #+ :: SValue JavaCode -> SValue JavaCode -> SValue JavaCode
(#+) = VSBinOp JavaCode
-> SValue JavaCode -> SValue JavaCode -> SValue JavaCode
forall (r :: * -> *).
CommonRenderSym r =>
VSBinOp r -> SValue r -> SValue r -> SValue r
binExpr VSBinOp JavaCode
forall (r :: * -> *). BinaryOpSym r => VSBinOp r
plusOp
  #- :: SValue JavaCode -> SValue JavaCode -> SValue JavaCode
(#-) = VSBinOp JavaCode
-> SValue JavaCode -> SValue JavaCode -> SValue JavaCode
forall (r :: * -> *).
CommonRenderSym r =>
VSBinOp r -> SValue r -> SValue r -> SValue r
binExpr VSBinOp JavaCode
forall (r :: * -> *). BinaryOpSym r => VSBinOp r
minusOp
  #* :: SValue JavaCode -> SValue JavaCode -> SValue JavaCode
(#*) = VSBinOp JavaCode
-> SValue JavaCode -> SValue JavaCode -> SValue JavaCode
forall (r :: * -> *).
CommonRenderSym r =>
VSBinOp r -> SValue r -> SValue r -> SValue r
binExpr VSBinOp JavaCode
forall (r :: * -> *). BinaryOpSym r => VSBinOp r
multOp
  #/ :: SValue JavaCode -> SValue JavaCode -> SValue JavaCode
(#/) = VSBinOp JavaCode
-> SValue JavaCode -> SValue JavaCode -> SValue JavaCode
forall (r :: * -> *).
CommonRenderSym r =>
VSBinOp r -> SValue r -> SValue r -> SValue r
binExpr VSBinOp JavaCode
forall (r :: * -> *). BinaryOpSym r => VSBinOp r
divideOp
  #% :: SValue JavaCode -> SValue JavaCode -> SValue JavaCode
(#%) = VSBinOp JavaCode
-> SValue JavaCode -> SValue JavaCode -> SValue JavaCode
forall (r :: * -> *).
CommonRenderSym r =>
VSBinOp r -> SValue r -> SValue r -> SValue r
binExpr VSBinOp JavaCode
forall (r :: * -> *). BinaryOpSym r => VSBinOp r
moduloOp
  #^ :: SValue JavaCode -> SValue JavaCode -> SValue JavaCode
(#^) = VSBinOp JavaCode
-> SValue JavaCode -> SValue JavaCode -> SValue JavaCode
forall (r :: * -> *).
CommonRenderSym r =>
VSBinOp r -> SValue r -> SValue r -> SValue r
binExprNumDbl' VSBinOp JavaCode
forall (r :: * -> *). BinaryOpSym r => VSBinOp r
powerOp

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

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

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

  -- Exceptions from function/method calls should already be in the exception 
  -- map from the CodeInfo pass, but it's possible that one of the higher-level 
  -- functions implicitly calls these functions in the Java renderer, so we 
  -- also check here to add the exceptions from the called function to the map
  funcAppMixedArgs :: MixedCall JavaCode
funcAppMixedArgs String
n VSType JavaCode
t [SValue JavaCode]
vs NamedArgs JavaCode
ns = do
    String -> StateT ValueState Identity ()
addCallExcsCurrMod String
n 
    MixedCall JavaCode
forall (r :: * -> *). CommonRenderSym r => MixedCall r
G.funcAppMixedArgs String
n VSType JavaCode
t [SValue JavaCode]
vs NamedArgs JavaCode
ns
  extFuncAppMixedArgs :: String -> MixedCall JavaCode
extFuncAppMixedArgs String
l String
n VSType JavaCode
t [SValue JavaCode]
vs NamedArgs JavaCode
ns = do
    Map QualifiedName [ExceptionType]
mem <- VS (Map QualifiedName [ExceptionType])
getMethodExcMap
    (ValueState -> ValueState) -> StateT ValueState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((ValueState -> ValueState)
-> ([ExceptionType] -> ValueState -> ValueState)
-> Maybe [ExceptionType]
-> ValueState
-> ValueState
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ValueState -> ValueState
forall a. a -> a
id [ExceptionType] -> ValueState -> ValueState
addExceptions (QualifiedName
-> Map QualifiedName [ExceptionType] -> Maybe [ExceptionType]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (String -> String -> QualifiedName
qualName String
l String
n) Map QualifiedName [ExceptionType]
mem))
    String -> MixedCall JavaCode
forall (r :: * -> *). CommonRenderSym r => String -> MixedCall r
CP.extFuncAppMixedArgs String
l String
n VSType JavaCode
t [SValue JavaCode]
vs NamedArgs JavaCode
ns
  libFuncAppMixedArgs :: String -> MixedCall JavaCode
libFuncAppMixedArgs = String -> MixedCall JavaCode
forall (r :: * -> *). CommonRenderSym r => String -> MixedCall r
C.libFuncAppMixedArgs

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

  notNull :: SValue JavaCode -> SValue JavaCode
notNull = String -> SValue JavaCode -> SValue JavaCode
forall (r :: * -> *).
CommonRenderSym r =>
String -> SValue r -> SValue r
CP.notNull String
nullLabel

instance OOValueExpression JavaCode where
  selfFuncAppMixedArgs :: MixedCall JavaCode
selfFuncAppMixedArgs String
n VSType JavaCode
t [SValue JavaCode]
ps NamedArgs JavaCode
ns = do
    String -> StateT ValueState Identity ()
addCallExcsCurrMod String
n
    Doc -> SVariable JavaCode -> MixedCall JavaCode
forall (r :: * -> *).
CommonRenderSym r =>
Doc -> SVariable r -> MixedCall r
G.selfFuncAppMixedArgs Doc
dot SVariable JavaCode
forall (r :: * -> *). OOVariableSym r => SVariable r
self String
n VSType JavaCode
t [SValue JavaCode]
ps NamedArgs JavaCode
ns
  newObjMixedArgs :: MixedCtorCall JavaCode
newObjMixedArgs VSType JavaCode
ot [SValue JavaCode]
vs NamedArgs JavaCode
ns = VSType JavaCode
-> (VSType JavaCode -> SValue JavaCode) -> SValue JavaCode
forall (r :: * -> *).
CommonRenderSym r =>
VSType r -> (VSType r -> SValue r) -> SValue r
addConstructorCallExcsCurrMod VSType JavaCode
ot (\VSType JavaCode
t -> 
    MixedCall JavaCode
forall (r :: * -> *). CommonRenderSym r => MixedCall r
G.newObjMixedArgs (String
new String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" ") VSType JavaCode
t [SValue JavaCode]
vs NamedArgs JavaCode
ns)
  extNewObjMixedArgs :: MixedCall JavaCode
extNewObjMixedArgs String
l VSType JavaCode
ot [SValue JavaCode]
vs NamedArgs JavaCode
ns = do
    JavaCode TypeData
t <- StateT ValueState Identity (JavaCode TypeData)
VSType JavaCode
ot
    Map QualifiedName [ExceptionType]
mem <- VS (Map QualifiedName [ExceptionType])
getMethodExcMap
    let tp :: String
tp = JavaCode (Type JavaCode) -> String
forall (r :: * -> *). TypeElim r => r (Type r) -> String
getTypeString JavaCode TypeData
JavaCode (Type JavaCode)
t
    (ValueState -> ValueState) -> StateT ValueState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((ValueState -> ValueState)
-> ([ExceptionType] -> ValueState -> ValueState)
-> Maybe [ExceptionType]
-> ValueState
-> ValueState
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ValueState -> ValueState
forall a. a -> a
id [ExceptionType] -> ValueState -> ValueState
addExceptions (QualifiedName
-> Map QualifiedName [ExceptionType] -> Maybe [ExceptionType]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (String -> String -> QualifiedName
qualName String
l String
tp) Map QualifiedName [ExceptionType]
mem))
    MixedCtorCall JavaCode
forall (r :: * -> *). OOValueExpression r => MixedCtorCall r
newObjMixedArgs (JavaCode TypeData -> StateT ValueState Identity (JavaCode TypeData)
forall a s. a -> State s a
toState JavaCode TypeData
t) [SValue JavaCode]
vs NamedArgs JavaCode
ns
  libNewObjMixedArgs :: MixedCall JavaCode
libNewObjMixedArgs = MixedCall JavaCode
forall (r :: * -> *). OORenderSym r => String -> MixedCtorCall r
C.libNewObjMixedArgs

instance RenderValue JavaCode where
  inputFunc :: SValue JavaCode
inputFunc = (ValueState -> ValueState) -> StateT ValueState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (String -> ValueState -> ValueState
addLangImportVS (String -> ValueState -> ValueState)
-> String -> ValueState -> ValueState
forall a b. (a -> b) -> a -> b
$ String -> String
utilImport String
jScanner) StateT ValueState Identity ()
-> VS (JavaCode ValData) -> VS (JavaCode ValData)
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
>> VSType JavaCode -> Doc -> SValue JavaCode
forall (r :: * -> *).
CommonRenderSym r =>
VSType r -> Doc -> SValue r
mkStateVal 
    (String -> VSType JavaCode
forall (r :: * -> *). OOTypeSym r => String -> VSType r
obj String
jScanner) (Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc
new' Doc -> Doc -> Doc
<+> Doc
jScanner' Doc -> Doc -> Doc
<> Doc -> Doc
parens (String -> Doc
jSystem String
jStdIn))
  printFunc :: SValue JavaCode
printFunc = VSType JavaCode -> Doc -> SValue JavaCode
forall (r :: * -> *).
CommonRenderSym r =>
VSType r -> Doc -> SValue r
mkStateVal VSType JavaCode
forall (r :: * -> *). TypeSym r => VSType r
void (String -> Doc
jSystem (String
jStdOut String -> String -> String
`access` String
printLabel))
  printLnFunc :: SValue JavaCode
printLnFunc = VSType JavaCode -> Doc -> SValue JavaCode
forall (r :: * -> *).
CommonRenderSym r =>
VSType r -> Doc -> SValue r
mkStateVal VSType JavaCode
forall (r :: * -> *). TypeSym r => VSType r
void (String -> Doc
jSystem (String
jStdOut String -> String -> String
`access` String
jPrintLn))
  printFileFunc :: SValue JavaCode -> SValue JavaCode
printFileFunc = (JavaCode TypeData -> JavaCode ValData -> VS (JavaCode ValData))
-> StateT ValueState Identity (JavaCode TypeData)
-> VS (JavaCode ValData)
-> VS (JavaCode ValData)
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> m c) -> m a -> m b -> m c
on2StateWrapped (\JavaCode TypeData
v -> JavaCode (Type JavaCode) -> Doc -> SValue JavaCode
forall (r :: * -> *).
CommonRenderSym r =>
r (Type r) -> Doc -> SValue r
mkVal JavaCode TypeData
JavaCode (Type JavaCode)
v (Doc -> VS (JavaCode ValData))
-> (JavaCode ValData -> Doc)
-> JavaCode ValData
-> VS (JavaCode ValData)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Doc -> Doc
R.printFile String
printLabel (Doc -> Doc)
-> (JavaCode ValData -> Doc) -> JavaCode ValData -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 
    JavaCode ValData -> Doc
JavaCode (Value JavaCode) -> Doc
forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value) StateT ValueState Identity (JavaCode TypeData)
VSType JavaCode
forall (r :: * -> *). TypeSym r => VSType r
void
  printFileLnFunc :: SValue JavaCode -> SValue JavaCode
printFileLnFunc = (JavaCode TypeData -> JavaCode ValData -> VS (JavaCode ValData))
-> StateT ValueState Identity (JavaCode TypeData)
-> VS (JavaCode ValData)
-> VS (JavaCode ValData)
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> m c) -> m a -> m b -> m c
on2StateWrapped (\JavaCode TypeData
v -> JavaCode (Type JavaCode) -> Doc -> SValue JavaCode
forall (r :: * -> *).
CommonRenderSym r =>
r (Type r) -> Doc -> SValue r
mkVal JavaCode TypeData
JavaCode (Type JavaCode)
v (Doc -> VS (JavaCode ValData))
-> (JavaCode ValData -> Doc)
-> JavaCode ValData
-> VS (JavaCode ValData)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Doc -> Doc
R.printFile String
jPrintLn (Doc -> Doc)
-> (JavaCode ValData -> Doc) -> JavaCode ValData -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 
    JavaCode ValData -> Doc
JavaCode (Value JavaCode) -> Doc
forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value) StateT ValueState Identity (JavaCode TypeData)
VSType JavaCode
forall (r :: * -> *). TypeSym r => VSType r
void
  
  cast :: VSType JavaCode -> SValue JavaCode -> SValue JavaCode
cast = VSType JavaCode -> SValue JavaCode -> SValue JavaCode
jCast

  call :: Maybe String -> Maybe Doc -> MixedCall JavaCode
call = String -> Maybe String -> Maybe Doc -> MixedCall JavaCode
forall (r :: * -> *).
CommonRenderSym r =>
String -> Maybe String -> Maybe Doc -> MixedCall r
CP.call' String
jName
  
  valFromData :: Maybe Int
-> Maybe Integer -> VSType JavaCode -> Doc -> SValue JavaCode
valFromData Maybe Int
p Maybe Integer
i VSType JavaCode
t' Doc
d = do 
    JavaCode TypeData
t <- StateT ValueState Identity (JavaCode TypeData)
VSType JavaCode
t'
    JavaCode ValData -> VS (JavaCode ValData)
forall a s. a -> State s a
toState (JavaCode ValData -> VS (JavaCode ValData))
-> JavaCode ValData -> VS (JavaCode ValData)
forall a b. (a -> b) -> a -> b
$ (TypeData -> Doc -> ValData)
-> JavaCode TypeData -> JavaCode Doc -> JavaCode 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) JavaCode TypeData
t (Doc -> JavaCode Doc
forall (r :: * -> *) a. Monad r => a -> r a
toCode Doc
d)

instance ValueElim JavaCode where
  valuePrec :: JavaCode (Value JavaCode) -> Maybe Int
valuePrec = ValData -> Maybe Int
valPrec (ValData -> Maybe Int)
-> (JavaCode ValData -> ValData) -> JavaCode ValData -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JavaCode ValData -> ValData
forall a. JavaCode a -> a
unJC
  valueInt :: JavaCode (Value JavaCode) -> Maybe Integer
valueInt = ValData -> Maybe Integer
valInt (ValData -> Maybe Integer)
-> (JavaCode ValData -> ValData)
-> JavaCode ValData
-> Maybe Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JavaCode ValData -> ValData
forall a. JavaCode a -> a
unJC
  value :: JavaCode (Value JavaCode) -> Doc
value = ValData -> Doc
val (ValData -> Doc)
-> (JavaCode ValData -> ValData) -> JavaCode ValData -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JavaCode ValData -> ValData
forall a. JavaCode a -> a
unJC

instance InternalValueExp JavaCode where
  objMethodCallMixedArgs' :: String
-> VSType JavaCode
-> SValue JavaCode
-> [SValue JavaCode]
-> NamedArgs JavaCode
-> SValue JavaCode
objMethodCallMixedArgs' String
f VSType JavaCode
t SValue JavaCode
o [SValue JavaCode]
ps NamedArgs JavaCode
ns = do
    JavaCode ValData
ob <- VS (JavaCode ValData)
SValue JavaCode
o
    Map QualifiedName [ExceptionType]
mem <- VS (Map QualifiedName [ExceptionType])
getMethodExcMap
    let tp :: String
tp = JavaCode (Type JavaCode) -> String
forall (r :: * -> *). TypeElim r => r (Type r) -> String
getTypeString (JavaCode (Value JavaCode) -> JavaCode (Type JavaCode)
forall (r :: * -> *). ValueSym r => r (Value r) -> r (Type r)
valueType JavaCode ValData
JavaCode (Value JavaCode)
ob)
    (ValueState -> ValueState) -> StateT ValueState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((ValueState -> ValueState)
-> ([ExceptionType] -> ValueState -> ValueState)
-> Maybe [ExceptionType]
-> ValueState
-> ValueState
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ValueState -> ValueState
forall a. a -> a
id [ExceptionType] -> ValueState -> ValueState
addExceptions (QualifiedName
-> Map QualifiedName [ExceptionType] -> Maybe [ExceptionType]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (String -> String -> QualifiedName
qualName String
tp String
f) Map QualifiedName [ExceptionType]
mem))
    String
-> VSType JavaCode
-> SValue JavaCode
-> [SValue JavaCode]
-> NamedArgs JavaCode
-> SValue JavaCode
forall (r :: * -> *).
CommonRenderSym r =>
String
-> VSType r -> SValue r -> [SValue r] -> NamedArgs r -> SValue r
G.objMethodCall String
f VSType JavaCode
t SValue JavaCode
o [SValue JavaCode]
ps NamedArgs JavaCode
ns

instance FunctionSym JavaCode where
  type Function JavaCode = FuncData

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

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

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

instance Set JavaCode where
  contains :: SValue JavaCode -> SValue JavaCode -> SValue JavaCode
contains = String -> SValue JavaCode -> SValue JavaCode -> SValue JavaCode
forall (r :: * -> *).
OORenderSym r =>
String -> SValue r -> SValue r -> SValue r
CP.contains String
jContains
  setAdd :: SValue JavaCode -> SValue JavaCode -> SValue JavaCode
setAdd = String -> SValue JavaCode -> SValue JavaCode -> SValue JavaCode
forall (r :: * -> *).
OORenderSym r =>
String -> SValue r -> SValue r -> SValue r
CP.setMethodCall String
jListAdd
  setRemove :: SValue JavaCode -> SValue JavaCode -> SValue JavaCode
setRemove = String -> SValue JavaCode -> SValue JavaCode -> SValue JavaCode
forall (r :: * -> *).
OORenderSym r =>
String -> SValue r -> SValue r -> SValue r
CP.setMethodCall String
jListRemove
  setUnion :: SValue JavaCode -> SValue JavaCode -> SValue JavaCode
setUnion = String -> SValue JavaCode -> SValue JavaCode -> SValue JavaCode
forall (r :: * -> *).
OORenderSym r =>
String -> SValue r -> SValue r -> SValue r
CP.setMethodCall String
jListUnion

instance InternalList JavaCode where
  listSlice' :: Maybe (SValue JavaCode)
-> Maybe (SValue JavaCode)
-> Maybe (SValue JavaCode)
-> SVariable JavaCode
-> SValue JavaCode
-> MSBlock JavaCode
listSlice' = Maybe (SValue JavaCode)
-> Maybe (SValue JavaCode)
-> Maybe (SValue JavaCode)
-> SVariable JavaCode
-> SValue JavaCode
-> MSBlock JavaCode
forall (r :: * -> *).
CommonRenderSym r =>
Maybe (SValue r)
-> Maybe (SValue r)
-> Maybe (SValue r)
-> SVariable r
-> SValue r
-> MSBlock r
M.listSlice

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

instance InternalListFunc JavaCode where
  listSizeFunc :: SValue JavaCode -> VSFunction JavaCode
listSizeFunc SValue JavaCode
_ = VSFunction JavaCode
forall (r :: * -> *). OORenderSym r => VSFunction r
CP.listSizeFunc
  listAddFunc :: SValue JavaCode
-> SValue JavaCode -> SValue JavaCode -> VSFunction JavaCode
listAddFunc SValue JavaCode
_ = String -> SValue JavaCode -> SValue JavaCode -> VSFunction JavaCode
forall (r :: * -> *).
OORenderSym r =>
String -> SValue r -> SValue r -> VSFunction r
CP.listAddFunc String
jListAdd
  listAppendFunc :: SValue JavaCode -> SValue JavaCode -> VSFunction JavaCode
listAppendFunc SValue JavaCode
_ = String -> SValue JavaCode -> VSFunction JavaCode
forall (r :: * -> *).
OORenderSym r =>
String -> SValue r -> VSFunction r
G.listAppendFunc String
jListAdd
  listAccessFunc :: VSType JavaCode -> SValue JavaCode -> VSFunction JavaCode
listAccessFunc = String -> VSType JavaCode -> SValue JavaCode -> VSFunction JavaCode
forall (r :: * -> *).
OORenderSym r =>
String -> VSType r -> SValue r -> VSFunction r
CP.listAccessFunc' String
jListAccess
  listSetFunc :: SValue JavaCode
-> SValue JavaCode -> SValue JavaCode -> VSFunction JavaCode
listSetFunc = SValue JavaCode
-> SValue JavaCode -> SValue JavaCode -> VSFunction JavaCode
jListSetFunc

instance ThunkSym JavaCode where
  type Thunk JavaCode = CommonThunk VS

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

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

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

instance VectorThunk JavaCode where
  vecThunk :: SVariable JavaCode -> VSThunk JavaCode
vecThunk = JavaCode (CommonThunk (StateT ValueState Identity))
-> StateT
     ValueState
     Identity
     (JavaCode (CommonThunk (StateT ValueState Identity)))
forall a. a -> StateT ValueState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (JavaCode (CommonThunk (StateT ValueState Identity))
 -> StateT
      ValueState
      Identity
      (JavaCode (CommonThunk (StateT ValueState Identity))))
-> (State ValueState (JavaCode VarData)
    -> JavaCode (CommonThunk (StateT ValueState Identity)))
-> State ValueState (JavaCode VarData)
-> StateT
     ValueState
     Identity
     (JavaCode (CommonThunk (StateT ValueState Identity)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommonThunk (StateT ValueState Identity)
-> JavaCode (CommonThunk (StateT ValueState Identity))
forall a. a -> JavaCode a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CommonThunk (StateT ValueState Identity)
 -> JavaCode (CommonThunk (StateT ValueState Identity)))
-> (State ValueState (JavaCode VarData)
    -> CommonThunk (StateT ValueState Identity))
-> State ValueState (JavaCode VarData)
-> JavaCode (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))
-> (State ValueState (JavaCode VarData)
    -> StateT ValueState Identity ValData)
-> State ValueState (JavaCode VarData)
-> CommonThunk (StateT ValueState Identity)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (JavaCode ValData -> ValData)
-> VS (JavaCode 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 JavaCode ValData -> ValData
forall a. JavaCode a -> a
unJC (VS (JavaCode ValData) -> StateT ValueState Identity ValData)
-> (State ValueState (JavaCode VarData) -> VS (JavaCode ValData))
-> State ValueState (JavaCode VarData)
-> StateT ValueState Identity ValData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State ValueState (JavaCode VarData) -> VS (JavaCode ValData)
SVariable JavaCode -> SValue JavaCode
forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
valueOf

instance VectorExpression JavaCode where
  vecScale :: SValue JavaCode -> VSThunk JavaCode -> VSThunk JavaCode
vecScale SValue JavaCode
k = (JavaCode (Thunk JavaCode) -> JavaCode (Thunk JavaCode))
-> VSThunk JavaCode -> VSThunk JavaCode
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 ((JavaCode (Thunk JavaCode) -> JavaCode (Thunk JavaCode))
 -> VSThunk JavaCode -> VSThunk JavaCode)
-> (JavaCode (Thunk JavaCode) -> JavaCode (Thunk JavaCode))
-> VSThunk JavaCode
-> VSThunk JavaCode
forall a b. (a -> b) -> a -> b
$ (Thunk JavaCode -> Thunk JavaCode)
-> JavaCode (Thunk JavaCode) -> JavaCode (Thunk JavaCode)
forall a b. (a -> b) -> JavaCode a -> JavaCode b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Thunk JavaCode -> Thunk JavaCode)
 -> JavaCode (Thunk JavaCode) -> JavaCode (Thunk JavaCode))
-> (Thunk JavaCode -> Thunk JavaCode)
-> JavaCode (Thunk JavaCode)
-> JavaCode (Thunk JavaCode)
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 ((JavaCode ValData -> ValData)
-> VS (JavaCode 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 JavaCode ValData -> ValData
forall a. JavaCode a -> a
unJC (VS (JavaCode ValData) -> StateT ValueState Identity ValData)
-> (StateT ValueState Identity ValData -> VS (JavaCode ValData))
-> StateT ValueState Identity ValData
-> StateT ValueState Identity ValData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SValue JavaCode
k #*) (VS (JavaCode ValData) -> VS (JavaCode ValData))
-> (StateT ValueState Identity ValData -> VS (JavaCode ValData))
-> StateT ValueState Identity ValData
-> VS (JavaCode ValData)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ValData -> JavaCode ValData)
-> StateT ValueState Identity ValData -> VS (JavaCode 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 -> JavaCode ValData
forall a. a -> JavaCode a
forall (f :: * -> *) a. Applicative f => a -> f a
pure)
  vecAdd :: VSThunk JavaCode -> VSThunk JavaCode -> VSThunk JavaCode
vecAdd = (JavaCode (Thunk JavaCode)
 -> JavaCode (Thunk JavaCode) -> JavaCode (Thunk JavaCode))
-> VSThunk JavaCode -> VSThunk JavaCode -> VSThunk JavaCode
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 ((JavaCode (Thunk JavaCode)
  -> JavaCode (Thunk JavaCode) -> JavaCode (Thunk JavaCode))
 -> VSThunk JavaCode -> VSThunk JavaCode -> VSThunk JavaCode)
-> (JavaCode (Thunk JavaCode)
    -> JavaCode (Thunk JavaCode) -> JavaCode (Thunk JavaCode))
-> VSThunk JavaCode
-> VSThunk JavaCode
-> VSThunk JavaCode
forall a b. (a -> b) -> a -> b
$ (Thunk JavaCode -> Thunk JavaCode -> Thunk JavaCode)
-> JavaCode (Thunk JavaCode)
-> JavaCode (Thunk JavaCode)
-> JavaCode (Thunk JavaCode)
forall a b c.
(a -> b -> c) -> JavaCode a -> JavaCode b -> JavaCode c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 ((Thunk JavaCode -> Thunk JavaCode -> Thunk JavaCode)
 -> JavaCode (Thunk JavaCode)
 -> JavaCode (Thunk JavaCode)
 -> JavaCode (Thunk JavaCode))
-> (Thunk JavaCode -> Thunk JavaCode -> Thunk JavaCode)
-> JavaCode (Thunk JavaCode)
-> JavaCode (Thunk JavaCode)
-> JavaCode (Thunk JavaCode)
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 -> (JavaCode ValData -> ValData)
-> VS (JavaCode 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 JavaCode ValData -> ValData
forall a. JavaCode a -> a
unJC (VS (JavaCode ValData) -> StateT ValueState Identity ValData)
-> VS (JavaCode ValData) -> StateT ValueState Identity ValData
forall a b. (a -> b) -> a -> b
$ (ValData -> JavaCode ValData)
-> StateT ValueState Identity ValData -> VS (JavaCode 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 -> JavaCode ValData
forall a. a -> JavaCode a
forall (f :: * -> *) a. Applicative f => a -> f a
pure StateT ValueState Identity ValData
v1 SValue JavaCode -> SValue JavaCode -> SValue JavaCode
forall (r :: * -> *).
NumericExpression r =>
SValue r -> SValue r -> SValue r
#+ (ValData -> JavaCode ValData)
-> StateT ValueState Identity ValData -> VS (JavaCode 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 -> JavaCode ValData
forall a. a -> JavaCode a
forall (f :: * -> *) a. Applicative f => a -> f a
pure StateT ValueState Identity ValData
v2)
  vecIndex :: SValue JavaCode -> VSThunk JavaCode -> SValue JavaCode
vecIndex SValue JavaCode
i = (VSThunk JavaCode
-> (JavaCode (Thunk JavaCode) -> SValue JavaCode)
-> SValue JavaCode
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 -> JavaCode ValData)
-> StateT ValueState Identity ValData -> VS (JavaCode 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 -> JavaCode ValData
forall a. a -> JavaCode a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StateT ValueState Identity ValData -> VS (JavaCode ValData))
-> (JavaCode (CommonThunk (StateT ValueState Identity))
    -> StateT ValueState Identity ValData)
-> JavaCode (CommonThunk (StateT ValueState Identity))
-> VS (JavaCode 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 ((JavaCode ValData -> ValData)
-> VS (JavaCode 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 JavaCode ValData -> ValData
forall a. JavaCode a -> a
unJC (VS (JavaCode ValData) -> StateT ValueState Identity ValData)
-> (StateT ValueState Identity ValData -> VS (JavaCode ValData))
-> StateT ValueState Identity ValData
-> StateT ValueState Identity ValData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VS (JavaCode ValData)
 -> VS (JavaCode ValData) -> VS (JavaCode ValData))
-> VS (JavaCode ValData)
-> VS (JavaCode ValData)
-> VS (JavaCode ValData)
forall a b c. (a -> b -> c) -> b -> a -> c
flip VS (JavaCode ValData)
-> VS (JavaCode ValData) -> VS (JavaCode ValData)
SValue JavaCode -> SValue JavaCode -> SValue JavaCode
forall (r :: * -> *). List r => SValue r -> SValue r -> SValue r
listAccess VS (JavaCode ValData)
SValue JavaCode
i (VS (JavaCode ValData) -> VS (JavaCode ValData))
-> (StateT ValueState Identity ValData -> VS (JavaCode ValData))
-> StateT ValueState Identity ValData
-> VS (JavaCode ValData)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ValData -> JavaCode ValData)
-> StateT ValueState Identity ValData -> VS (JavaCode 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 -> JavaCode ValData
forall a. a -> JavaCode a
forall (f :: * -> *) a. Applicative f => a -> f a
pure) (CommonThunk (StateT ValueState Identity)
 -> StateT ValueState Identity ValData)
-> (JavaCode (CommonThunk (StateT ValueState Identity))
    -> CommonThunk (StateT ValueState Identity))
-> JavaCode (CommonThunk (StateT ValueState Identity))
-> StateT ValueState Identity ValData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JavaCode (CommonThunk (StateT ValueState Identity))
-> CommonThunk (StateT ValueState Identity)
forall a. JavaCode a -> a
unJC)
  vecDot :: VSThunk JavaCode -> VSThunk JavaCode -> VSThunk JavaCode
vecDot = (JavaCode (Thunk JavaCode)
 -> JavaCode (Thunk JavaCode) -> JavaCode (Thunk JavaCode))
-> VSThunk JavaCode -> VSThunk JavaCode -> VSThunk JavaCode
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 ((JavaCode (Thunk JavaCode)
  -> JavaCode (Thunk JavaCode) -> JavaCode (Thunk JavaCode))
 -> VSThunk JavaCode -> VSThunk JavaCode -> VSThunk JavaCode)
-> (JavaCode (Thunk JavaCode)
    -> JavaCode (Thunk JavaCode) -> JavaCode (Thunk JavaCode))
-> VSThunk JavaCode
-> VSThunk JavaCode
-> VSThunk JavaCode
forall a b. (a -> b) -> a -> b
$ (Thunk JavaCode -> Thunk JavaCode -> Thunk JavaCode)
-> JavaCode (Thunk JavaCode)
-> JavaCode (Thunk JavaCode)
-> JavaCode (Thunk JavaCode)
forall a b c.
(a -> b -> c) -> JavaCode a -> JavaCode b -> JavaCode c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 ((Thunk JavaCode -> Thunk JavaCode -> Thunk JavaCode)
 -> JavaCode (Thunk JavaCode)
 -> JavaCode (Thunk JavaCode)
 -> JavaCode (Thunk JavaCode))
-> (Thunk JavaCode -> Thunk JavaCode -> Thunk JavaCode)
-> JavaCode (Thunk JavaCode)
-> JavaCode (Thunk JavaCode)
-> JavaCode (Thunk JavaCode)
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 -> (JavaCode ValData -> ValData)
-> VS (JavaCode 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 JavaCode ValData -> ValData
forall a. JavaCode a -> a
unJC (VS (JavaCode ValData) -> StateT ValueState Identity ValData)
-> VS (JavaCode ValData) -> StateT ValueState Identity ValData
forall a b. (a -> b) -> a -> b
$ (ValData -> JavaCode ValData)
-> StateT ValueState Identity ValData -> VS (JavaCode 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 -> JavaCode ValData
forall a. a -> JavaCode a
forall (f :: * -> *) a. Applicative f => a -> f a
pure StateT ValueState Identity ValData
v1 SValue JavaCode -> SValue JavaCode -> SValue JavaCode
forall (r :: * -> *).
NumericExpression r =>
SValue r -> SValue r -> SValue r
#* (ValData -> JavaCode ValData)
-> StateT ValueState Identity ValData -> VS (JavaCode 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 -> JavaCode ValData
forall a. a -> JavaCode a
forall (f :: * -> *) a. Applicative f => a -> f a
pure StateT ValueState Identity ValData
v2)

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

instance InternalAssignStmt JavaCode where
  multiAssign :: [SVariable JavaCode] -> [SValue JavaCode] -> MSStatement JavaCode
multiAssign [SVariable JavaCode]
_ [SValue JavaCode]
_ = String -> MSStatement JavaCode
forall a. HasCallStack => String -> a
error (String -> MSStatement JavaCode) -> String -> MSStatement JavaCode
forall a b. (a -> b) -> a -> b
$ String -> String
C.multiAssignError String
jName

instance InternalIOStmt JavaCode where
  printSt :: Bool
-> Maybe (SValue JavaCode)
-> SValue JavaCode
-> SValue JavaCode
-> MSStatement JavaCode
printSt Bool
_ Maybe (SValue JavaCode)
_ = SValue JavaCode -> SValue JavaCode -> MSStatement JavaCode
forall (r :: * -> *).
CommonRenderSym r =>
SValue r -> SValue r -> MSStatement r
CP.printSt

instance InternalControlStmt JavaCode where
  multiReturn :: [SValue JavaCode] -> MSStatement JavaCode
multiReturn [SValue JavaCode]
_ = String -> MSStatement JavaCode
forall a. HasCallStack => String -> a
error (String -> MSStatement JavaCode) -> String -> MSStatement JavaCode
forall a b. (a -> b) -> a -> b
$ String -> String
C.multiReturnError String
jName

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

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

instance StatementSym JavaCode where
  -- Terminator determines how statements end
  type Statement JavaCode = (Doc, Terminator)
  valStmt :: SValue JavaCode -> MSStatement JavaCode
valStmt = Terminator -> SValue JavaCode -> MSStatement JavaCode
forall (r :: * -> *).
CommonRenderSym r =>
Terminator -> SValue r -> MSStatement r
G.valStmt Terminator
Semi
  emptyStmt :: MSStatement JavaCode
emptyStmt = MSStatement JavaCode
forall (r :: * -> *). CommonRenderSym r => MSStatement r
G.emptyStmt
  multi :: [MSStatement JavaCode] -> MSStatement JavaCode
multi = ([JavaCode (Doc, Terminator)] -> JavaCode (Doc, Terminator))
-> [StateT MethodState Identity (JavaCode (Doc, Terminator))]
-> StateT MethodState Identity (JavaCode (Doc, Terminator))
forall a b s. ([a] -> b) -> [State s a] -> State s b
onStateList (([(Doc, Terminator)] -> (Doc, Terminator))
-> [JavaCode (Doc, Terminator)] -> JavaCode (Doc, Terminator)
forall (m :: * -> *) a b. Monad m => ([a] -> b) -> [m a] -> m b
onCodeList [(Doc, Terminator)] -> (Doc, Terminator)
R.multiStmt)

instance AssignStatement JavaCode where
  assign :: SVariable JavaCode -> SValue JavaCode -> MSStatement JavaCode
assign = Terminator
-> SVariable JavaCode -> SValue JavaCode -> MSStatement JavaCode
forall (r :: * -> *).
CommonRenderSym r =>
Terminator -> SVariable r -> SValue r -> MSStatement r
G.assign Terminator
Semi
  &-= :: SVariable JavaCode -> SValue JavaCode -> MSStatement JavaCode
(&-=) = Terminator
-> SVariable JavaCode -> SValue JavaCode -> MSStatement JavaCode
forall (r :: * -> *).
CommonRenderSym r =>
Terminator -> SVariable r -> SValue r -> MSStatement r
G.subAssign Terminator
Semi
  &+= :: SVariable JavaCode -> SValue JavaCode -> MSStatement JavaCode
(&+=) = SVariable JavaCode -> SValue JavaCode -> MSStatement JavaCode
forall (r :: * -> *).
CommonRenderSym r =>
SVariable r -> SValue r -> MSStatement r
G.increment
  &++ :: SVariable JavaCode -> MSStatement JavaCode
(&++) = SVariable JavaCode -> MSStatement JavaCode
forall (r :: * -> *).
CommonRenderSym r =>
SVariable r -> MSStatement r
C.increment1
  &-- :: SVariable JavaCode -> MSStatement JavaCode
(&--) = SVariable JavaCode -> MSStatement JavaCode
forall (r :: * -> *).
CommonRenderSym r =>
SVariable r -> MSStatement r
C.decrement1

instance DeclStatement JavaCode where
  varDec :: SVariable JavaCode
-> JavaCode (Scope JavaCode) -> MSStatement JavaCode
varDec = JavaCode (Permanence JavaCode)
-> JavaCode (Permanence JavaCode)
-> Doc
-> SVariable JavaCode
-> JavaCode (Scope JavaCode)
-> MSStatement JavaCode
forall (r :: * -> *).
OORenderSym r =>
r (Permanence r)
-> r (Permanence r)
-> Doc
-> SVariable r
-> r (Scope r)
-> MSStatement r
C.varDec JavaCode (Permanence JavaCode)
forall (r :: * -> *). PermanenceSym r => r (Permanence r)
static JavaCode (Permanence JavaCode)
forall (r :: * -> *). PermanenceSym r => r (Permanence r)
dynamic Doc
empty
  varDecDef :: SVariable JavaCode
-> JavaCode (Scope JavaCode)
-> SValue JavaCode
-> MSStatement JavaCode
varDecDef = Terminator
-> SVariable JavaCode
-> JavaCode (Scope JavaCode)
-> SValue JavaCode
-> MSStatement JavaCode
forall (r :: * -> *).
CommonRenderSym r =>
Terminator
-> SVariable r -> r (Scope r) -> SValue r -> MSStatement r
C.varDecDef Terminator
Semi
  setDec :: SVariable JavaCode
-> JavaCode (Scope JavaCode) -> MSStatement JavaCode
setDec = SVariable JavaCode
-> JavaCode (Scope JavaCode) -> MSStatement JavaCode
forall (r :: * -> *).
DeclStatement r =>
SVariable r -> r (Scope r) -> MSStatement r
varDec
  setDecDef :: SVariable JavaCode
-> JavaCode (Scope JavaCode)
-> SValue JavaCode
-> MSStatement JavaCode
setDecDef = SVariable JavaCode
-> JavaCode (Scope JavaCode)
-> SValue JavaCode
-> MSStatement JavaCode
forall (r :: * -> *).
DeclStatement r =>
SVariable r -> r (Scope r) -> SValue r -> MSStatement r
varDecDef
  listDec :: Integer
-> SVariable JavaCode
-> JavaCode (Scope JavaCode)
-> MSStatement JavaCode
listDec Integer
n SVariable JavaCode
v JavaCode (Scope JavaCode)
scp = LensLike'
  (Zoomed (StateT ValueState Identity) (JavaCode VarData))
  MethodState
  ValueState
-> State ValueState (JavaCode VarData)
-> StateT MethodState Identity (JavaCode 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) (JavaCode VarData))
  MethodState
  ValueState
(ValueState -> Focusing Identity (JavaCode VarData) ValueState)
-> MethodState -> Focusing Identity (JavaCode VarData) MethodState
Lens' MethodState ValueState
lensMStoVS State ValueState (JavaCode VarData)
SVariable JavaCode
v StateT MethodState Identity (JavaCode VarData)
-> (JavaCode VarData
    -> StateT MethodState Identity (JavaCode (Doc, Terminator)))
-> StateT MethodState Identity (JavaCode (Doc, Terminator))
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
>>= (\JavaCode VarData
v' -> (JavaCode (Value JavaCode) -> Doc)
-> SValue JavaCode
-> SVariable JavaCode
-> JavaCode (Scope JavaCode)
-> MSStatement JavaCode
forall (r :: * -> *).
CommonRenderSym r =>
(r (Value r) -> Doc)
-> SValue r -> SVariable r -> r (Scope r) -> MSStatement r
C.listDec (JavaCode (Variable JavaCode) -> JavaCode (Value JavaCode) -> Doc
forall (r :: * -> *).
CommonRenderSym r =>
r (Variable r) -> r (Value r) -> Doc
R.listDec JavaCode VarData
JavaCode (Variable JavaCode)
v') 
    (Integer -> SValue JavaCode
forall (r :: * -> *). Literal r => Integer -> SValue r
litInt Integer
n) SVariable JavaCode
v JavaCode (Scope JavaCode)
scp)
  listDecDef :: SVariable JavaCode
-> JavaCode (Scope JavaCode)
-> [SValue JavaCode]
-> MSStatement JavaCode
listDecDef = SVariable JavaCode
-> JavaCode (Scope JavaCode)
-> [SValue JavaCode]
-> MSStatement JavaCode
forall (r :: * -> *).
CommonRenderSym r =>
SVariable r -> r (Scope r) -> [SValue r] -> MSStatement r
CP.listDecDef
  arrayDec :: Integer
-> SVariable JavaCode
-> JavaCode (Scope JavaCode)
-> MSStatement JavaCode
arrayDec Integer
n = SValue JavaCode
-> SVariable JavaCode
-> JavaCode (Scope JavaCode)
-> MSStatement JavaCode
forall (r :: * -> *).
CommonRenderSym r =>
SValue r -> SVariable r -> r (Scope r) -> MSStatement r
CP.arrayDec (Integer -> SValue JavaCode
forall (r :: * -> *). Literal r => Integer -> SValue r
litInt Integer
n)
  arrayDecDef :: SVariable JavaCode
-> JavaCode (Scope JavaCode)
-> [SValue JavaCode]
-> MSStatement JavaCode
arrayDecDef = SVariable JavaCode
-> JavaCode (Scope JavaCode)
-> [SValue JavaCode]
-> MSStatement JavaCode
forall (r :: * -> *).
CommonRenderSym r =>
SVariable r -> r (Scope r) -> [SValue r] -> MSStatement r
CP.arrayDecDef
  constDecDef :: SVariable JavaCode
-> JavaCode (Scope JavaCode)
-> SValue JavaCode
-> MSStatement JavaCode
constDecDef = SVariable JavaCode
-> JavaCode (Scope JavaCode)
-> SValue JavaCode
-> MSStatement JavaCode
forall (r :: * -> *).
CommonRenderSym r =>
SVariable r -> r (Scope r) -> SValue r -> MSStatement r
jConstDecDef
  funcDecDef :: SVariable JavaCode
-> JavaCode (Scope JavaCode)
-> [SVariable JavaCode]
-> MSBody JavaCode
-> MSStatement JavaCode
funcDecDef = SVariable JavaCode
-> JavaCode (Scope JavaCode)
-> [SVariable JavaCode]
-> MSBody JavaCode
-> MSStatement JavaCode
forall (r :: * -> *).
CommonRenderSym r =>
SVariable r
-> r (Scope r) -> [SVariable r] -> MSBody r -> MSStatement r
jFuncDecDef

instance OODeclStatement JavaCode where
  objDecDef :: SVariable JavaCode
-> JavaCode (Scope JavaCode)
-> SValue JavaCode
-> MSStatement JavaCode
objDecDef = SVariable JavaCode
-> JavaCode (Scope JavaCode)
-> SValue JavaCode
-> MSStatement JavaCode
forall (r :: * -> *).
DeclStatement r =>
SVariable r -> r (Scope r) -> SValue r -> MSStatement r
varDecDef
  objDecNew :: SVariable JavaCode
-> JavaCode (Scope JavaCode)
-> [SValue JavaCode]
-> MSStatement JavaCode
objDecNew = SVariable JavaCode
-> JavaCode (Scope JavaCode)
-> [SValue JavaCode]
-> MSStatement JavaCode
forall (r :: * -> *).
OORenderSym r =>
SVariable r -> r (Scope r) -> [SValue r] -> MSStatement r
G.objDecNew
  extObjDecNew :: String
-> SVariable JavaCode
-> JavaCode (Scope JavaCode)
-> [SValue JavaCode]
-> MSStatement JavaCode
extObjDecNew = String
-> SVariable JavaCode
-> JavaCode (Scope JavaCode)
-> [SValue JavaCode]
-> MSStatement JavaCode
forall (r :: * -> *).
OORenderSym r =>
String -> SVariable r -> r (Scope r) -> [SValue r] -> MSStatement r
C.extObjDecNew

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

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

  getInput :: SVariable JavaCode -> MSStatement JavaCode
getInput SVariable JavaCode
v = SVariable JavaCode
v SVariable JavaCode -> SValue JavaCode -> MSStatement JavaCode
forall (r :: * -> *).
AssignStatement r =>
SVariable r -> SValue r -> MSStatement r
&= SVariable JavaCode -> SValue JavaCode -> SValue JavaCode
jInput SVariable JavaCode
v SValue JavaCode
forall (r :: * -> *). RenderValue r => SValue r
inputFunc
  discardInput :: MSStatement JavaCode
discardInput = SValue JavaCode -> MSStatement JavaCode
jDiscardInput SValue JavaCode
forall (r :: * -> *). RenderValue r => SValue r
inputFunc
  getFileInput :: SValue JavaCode -> SVariable JavaCode -> MSStatement JavaCode
getFileInput SValue JavaCode
f SVariable JavaCode
v = SVariable JavaCode
v SVariable JavaCode -> SValue JavaCode -> MSStatement JavaCode
forall (r :: * -> *).
AssignStatement r =>
SVariable r -> SValue r -> MSStatement r
&= SVariable JavaCode -> SValue JavaCode -> SValue JavaCode
jInput SVariable JavaCode
v SValue JavaCode
f
  discardFileInput :: SValue JavaCode -> MSStatement JavaCode
discardFileInput = SValue JavaCode -> MSStatement JavaCode
jDiscardInput

  openFileR :: SVariable JavaCode -> SValue JavaCode -> MSStatement JavaCode
openFileR = (SValue JavaCode -> VSType JavaCode -> SValue JavaCode)
-> SVariable JavaCode -> SValue JavaCode -> MSStatement JavaCode
forall (r :: * -> *).
CommonRenderSym r =>
(SValue r -> VSType r -> SValue r)
-> SVariable r -> SValue r -> MSStatement r
CP.openFileR SValue JavaCode -> VSType JavaCode -> SValue JavaCode
forall (r :: * -> *).
OORenderSym r =>
SValue r -> VSType r -> SValue r
jOpenFileR
  openFileW :: SVariable JavaCode -> SValue JavaCode -> MSStatement JavaCode
openFileW = (SValue JavaCode
 -> VSType JavaCode -> SValue JavaCode -> SValue JavaCode)
-> SVariable JavaCode -> SValue JavaCode -> MSStatement JavaCode
forall (r :: * -> *).
CommonRenderSym r =>
(SValue r -> VSType r -> SValue r -> SValue r)
-> SVariable r -> SValue r -> MSStatement r
CP.openFileW SValue JavaCode
-> VSType JavaCode -> SValue JavaCode -> SValue JavaCode
forall (r :: * -> *).
OORenderSym r =>
SValue r -> VSType r -> SValue r -> SValue r
jOpenFileWorA
  openFileA :: SVariable JavaCode -> SValue JavaCode -> MSStatement JavaCode
openFileA = (SValue JavaCode
 -> VSType JavaCode -> SValue JavaCode -> SValue JavaCode)
-> SVariable JavaCode -> SValue JavaCode -> MSStatement JavaCode
forall (r :: * -> *).
CommonRenderSym r =>
(SValue r -> VSType r -> SValue r -> SValue r)
-> SVariable r -> SValue r -> MSStatement r
CP.openFileA SValue JavaCode
-> VSType JavaCode -> SValue JavaCode -> SValue JavaCode
forall (r :: * -> *).
OORenderSym r =>
SValue r -> VSType r -> SValue r -> SValue r
jOpenFileWorA
  closeFile :: SValue JavaCode -> MSStatement JavaCode
closeFile = String -> SValue JavaCode -> MSStatement JavaCode
forall (r :: * -> *).
OORenderSym r =>
String -> SValue r -> MSStatement r
G.closeFile String
jClose

  getFileInputLine :: SValue JavaCode -> SVariable JavaCode -> MSStatement JavaCode
getFileInputLine SValue JavaCode
f SVariable JavaCode
v = SVariable JavaCode
v SVariable JavaCode -> SValue JavaCode -> MSStatement JavaCode
forall (r :: * -> *).
AssignStatement r =>
SVariable r -> SValue r -> MSStatement r
&= SValue JavaCode
f SValue JavaCode -> VSFunction JavaCode -> SValue JavaCode
forall (r :: * -> *).
OOFunctionSym r =>
SValue r -> VSFunction r -> SValue r
$. VSFunction JavaCode
jNextLineFunc
  discardFileLine :: SValue JavaCode -> MSStatement JavaCode
discardFileLine = String -> SValue JavaCode -> MSStatement JavaCode
forall (r :: * -> *).
OORenderSym r =>
String -> SValue r -> MSStatement r
CP.discardFileLine String
jNextLine
  getFileInputAll :: SValue JavaCode -> SVariable JavaCode -> MSStatement JavaCode
getFileInputAll SValue JavaCode
f SVariable JavaCode
v = SValue JavaCode -> MSBody JavaCode -> MSStatement JavaCode
forall (r :: * -> *).
ControlStatement r =>
SValue r -> MSBody r -> MSStatement r
while (SValue JavaCode
f SValue JavaCode -> VSFunction JavaCode -> SValue JavaCode
forall (r :: * -> *).
OOFunctionSym r =>
SValue r -> VSFunction r -> SValue r
$. VSFunction JavaCode
jHasNextLineFunc)
    (MSStatement JavaCode -> MSBody JavaCode
forall (r :: * -> *). BodySym r => MSStatement r -> MSBody r
oneLiner (MSStatement JavaCode -> MSBody JavaCode)
-> MSStatement JavaCode -> MSBody JavaCode
forall a b. (a -> b) -> a -> b
$ SValue JavaCode -> MSStatement JavaCode
forall (r :: * -> *). StatementSym r => SValue r -> MSStatement r
valStmt (SValue JavaCode -> MSStatement JavaCode)
-> SValue JavaCode -> MSStatement JavaCode
forall a b. (a -> b) -> a -> b
$ SValue JavaCode -> SValue JavaCode -> SValue JavaCode
forall (r :: * -> *). List r => SValue r -> SValue r -> SValue r
listAppend (SVariable JavaCode -> SValue JavaCode
forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
valueOf SVariable JavaCode
v) (SValue JavaCode
f SValue JavaCode -> VSFunction JavaCode -> SValue JavaCode
forall (r :: * -> *).
OOFunctionSym r =>
SValue r -> VSFunction r -> SValue r
$. VSFunction JavaCode
jNextLineFunc))

instance StringStatement JavaCode where
  stringSplit :: Char
-> SVariable JavaCode -> SValue JavaCode -> MSStatement JavaCode
stringSplit Char
d SVariable JavaCode
vnew SValue JavaCode
s = do
    (MethodState -> MethodState) -> StateT MethodState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (String -> MethodState -> MethodState
addLangImport (String -> MethodState -> MethodState)
-> String -> MethodState -> MethodState
forall a b. (a -> b) -> a -> b
$ String -> String
utilImport String
jArrays) 
    Doc
ss <- LensLike'
  (Zoomed (StateT ValueState Identity) Doc) MethodState ValueState
-> StateT ValueState Identity Doc
-> StateT MethodState Identity 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) Doc) MethodState ValueState
(ValueState -> Focusing Identity Doc ValueState)
-> MethodState -> Focusing Identity Doc MethodState
Lens' MethodState ValueState
lensMStoVS (StateT ValueState Identity Doc -> StateT MethodState Identity Doc)
-> StateT ValueState Identity Doc
-> StateT MethodState Identity Doc
forall a b. (a -> b) -> a -> b
$ 
      SVariable JavaCode
-> SValue JavaCode -> StateT ValueState Identity Doc
forall (r :: * -> *).
CommonRenderSym r =>
SVariable r -> SValue r -> StateT ValueState Identity Doc
jStringSplit SVariable JavaCode
vnew (VSType JavaCode -> [SValue JavaCode] -> SValue JavaCode
jAsListFunc VSType JavaCode
forall (r :: * -> *). TypeSym r => VSType r
string [SValue JavaCode
s SValue JavaCode -> VSFunction JavaCode -> SValue JavaCode
forall (r :: * -> *).
OOFunctionSym r =>
SValue r -> VSFunction r -> SValue r
$. Char -> VSFunction JavaCode
forall (r :: * -> *). OORenderSym r => Char -> VSFunction r
jSplitFunc Char
d])
    Doc -> MSStatement JavaCode
forall (r :: * -> *). CommonRenderSym r => Doc -> MSStatement r
mkStmt Doc
ss 

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

instance FuncAppStatement JavaCode where
  inOutCall :: InOutCall JavaCode
inOutCall = (String -> VSType JavaCode -> [SValue JavaCode] -> SValue JavaCode)
-> InOutCall JavaCode
jInOutCall String -> VSType JavaCode -> [SValue JavaCode] -> SValue JavaCode
forall (r :: * -> *). ValueExpression r => PosCall r
funcApp
  extInOutCall :: String -> InOutCall JavaCode
extInOutCall String
m = (String -> VSType JavaCode -> [SValue JavaCode] -> SValue JavaCode)
-> InOutCall JavaCode
jInOutCall (String
-> String
-> VSType JavaCode
-> [SValue JavaCode]
-> SValue JavaCode
forall (r :: * -> *). ValueExpression r => String -> PosCall r
extFuncApp String
m)

instance OOFuncAppStatement JavaCode where
  selfInOutCall :: InOutCall JavaCode
selfInOutCall = (String -> VSType JavaCode -> [SValue JavaCode] -> SValue JavaCode)
-> InOutCall JavaCode
jInOutCall String -> VSType JavaCode -> [SValue JavaCode] -> SValue JavaCode
forall (r :: * -> *). OOValueExpression r => PosCall r
selfFuncApp

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

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

  returnStmt :: SValue JavaCode -> MSStatement JavaCode
returnStmt = Terminator -> SValue JavaCode -> MSStatement JavaCode
forall (r :: * -> *).
CommonRenderSym r =>
Terminator -> SValue r -> MSStatement r
G.returnStmt Terminator
Semi
  
  throw :: String -> MSStatement JavaCode
throw = (JavaCode (Value JavaCode) -> Doc)
-> Terminator -> String -> MSStatement JavaCode
forall (r :: * -> *).
CommonRenderSym r =>
(r (Value r) -> Doc) -> Terminator -> String -> MSStatement r
G.throw JavaCode (Value JavaCode) -> Doc
forall (r :: * -> *). CommonRenderSym r => r (Value r) -> Doc
jThrowDoc Terminator
Semi

  ifCond :: [(SValue JavaCode, MSBody JavaCode)]
-> MSBody JavaCode -> MSStatement JavaCode
ifCond = (Doc -> Doc)
-> Doc
-> OptionalSpace
-> Doc
-> Doc
-> Doc
-> [(SValue JavaCode, MSBody JavaCode)]
-> MSBody JavaCode
-> MSStatement JavaCode
forall (r :: * -> *).
CommonRenderSym r =>
(Doc -> Doc)
-> Doc
-> OptionalSpace
-> Doc
-> Doc
-> Doc
-> [(SValue r, MSBody r)]
-> MSBody r
-> MSStatement r
G.ifCond Doc -> Doc
parens Doc
bodyStart OptionalSpace
G.defaultOptSpace Doc
elseIfLabel Doc
bodyEnd Doc
empty
  switch :: SValue JavaCode
-> [(SValue JavaCode, MSBody JavaCode)]
-> MSBody JavaCode
-> MSStatement JavaCode
switch  = (Doc -> Doc)
-> MSStatement JavaCode
-> SValue JavaCode
-> [(SValue JavaCode, MSBody JavaCode)]
-> MSBody JavaCode
-> MSStatement JavaCode
forall (r :: * -> *).
CommonRenderSym r =>
(Doc -> Doc)
-> MSStatement r
-> SValue r
-> [(SValue r, MSBody r)]
-> MSBody r
-> MSStatement r
C.switch Doc -> Doc
parens MSStatement JavaCode
forall (r :: * -> *). ControlStatement r => MSStatement r
break

  ifExists :: SValue JavaCode
-> MSBody JavaCode -> MSBody JavaCode -> MSStatement JavaCode
ifExists = SValue JavaCode
-> MSBody JavaCode -> MSBody JavaCode -> MSStatement JavaCode
forall (r :: * -> *).
CommonRenderSym r =>
SValue r -> MSBody r -> MSBody r -> MSStatement r
M.ifExists

  for :: MSStatement JavaCode
-> SValue JavaCode
-> MSStatement JavaCode
-> MSBody JavaCode
-> MSStatement JavaCode
for = Doc
-> Doc
-> MSStatement JavaCode
-> SValue JavaCode
-> MSStatement JavaCode
-> MSBody JavaCode
-> MSStatement JavaCode
forall (r :: * -> *).
CommonRenderSym r =>
Doc
-> Doc
-> MSStatement r
-> SValue r
-> MSStatement r
-> MSBody r
-> MSStatement r
C.for Doc
bodyStart Doc
bodyEnd
  forRange :: SVariable JavaCode
-> SValue JavaCode
-> SValue JavaCode
-> SValue JavaCode
-> MSBody JavaCode
-> MSStatement JavaCode
forRange = SVariable JavaCode
-> SValue JavaCode
-> SValue JavaCode
-> SValue JavaCode
-> MSBody JavaCode
-> MSStatement JavaCode
forall (r :: * -> *).
CommonRenderSym r =>
SVariable r
-> SValue r -> SValue r -> SValue r -> MSBody r -> MSStatement r
M.forRange 
  forEach :: SVariable JavaCode
-> SValue JavaCode -> MSBody JavaCode -> MSStatement JavaCode
forEach = Doc
-> Doc
-> Doc
-> Doc
-> SVariable JavaCode
-> SValue JavaCode
-> MSBody JavaCode
-> MSStatement JavaCode
forall (r :: * -> *).
CommonRenderSym r =>
Doc
-> Doc
-> Doc
-> Doc
-> SVariable r
-> SValue r
-> MSBody r
-> MSStatement r
CP.forEach Doc
bodyStart Doc
bodyEnd Doc
forLabel Doc
colon
  while :: SValue JavaCode -> MSBody JavaCode -> MSStatement JavaCode
while = (Doc -> Doc)
-> Doc
-> Doc
-> SValue JavaCode
-> MSBody JavaCode
-> MSStatement JavaCode
forall (r :: * -> *).
CommonRenderSym r =>
(Doc -> Doc) -> Doc -> Doc -> SValue r -> MSBody r -> MSStatement r
C.while Doc -> Doc
parens Doc
bodyStart Doc
bodyEnd

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

  assert :: SValue JavaCode -> SValue JavaCode -> MSStatement JavaCode
assert SValue JavaCode
condition SValue JavaCode
errorMessage = do
    JavaCode ValData
cond <- LensLike'
  (Zoomed (StateT ValueState Identity) (JavaCode ValData))
  MethodState
  ValueState
-> VS (JavaCode ValData)
-> StateT MethodState Identity (JavaCode 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) (JavaCode ValData))
  MethodState
  ValueState
(ValueState -> Focusing Identity (JavaCode ValData) ValueState)
-> MethodState -> Focusing Identity (JavaCode ValData) MethodState
Lens' MethodState ValueState
lensMStoVS VS (JavaCode ValData)
SValue JavaCode
condition
    JavaCode ValData
errMsg <- LensLike'
  (Zoomed (StateT ValueState Identity) (JavaCode ValData))
  MethodState
  ValueState
-> VS (JavaCode ValData)
-> StateT MethodState Identity (JavaCode 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) (JavaCode ValData))
  MethodState
  ValueState
(ValueState -> Focusing Identity (JavaCode ValData) ValueState)
-> MethodState -> Focusing Identity (JavaCode ValData) MethodState
Lens' MethodState ValueState
lensMStoVS VS (JavaCode ValData)
SValue JavaCode
errorMessage
    Doc -> MSStatement JavaCode
forall (r :: * -> *). CommonRenderSym r => Doc -> MSStatement r
mkStmt (JavaCode (Value JavaCode) -> JavaCode (Value JavaCode) -> Doc
forall (r :: * -> *).
CommonRenderSym r =>
r (Value r) -> r (Value r) -> Doc
jAssert JavaCode ValData
JavaCode (Value JavaCode)
cond JavaCode ValData
JavaCode (Value JavaCode)
errMsg)
  
instance ObserverPattern JavaCode where
  notifyObservers :: VSFunction JavaCode -> VSType JavaCode -> MSStatement JavaCode
notifyObservers = VSFunction JavaCode -> VSType JavaCode -> MSStatement JavaCode
forall (r :: * -> *).
OORenderSym r =>
VSFunction r -> VSType r -> MSStatement r
M.notifyObservers

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

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

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

instance MethodTypeSym JavaCode where
  type MethodType JavaCode = TypeData
  mType :: VSType JavaCode -> MSMthdType JavaCode
mType = LensLike'
  (Zoomed (StateT ValueState Identity) (JavaCode TypeData))
  MethodState
  ValueState
-> StateT ValueState Identity (JavaCode TypeData)
-> StateT MethodState Identity (JavaCode 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) (JavaCode TypeData))
  MethodState
  ValueState
(ValueState -> Focusing Identity (JavaCode TypeData) ValueState)
-> MethodState -> Focusing Identity (JavaCode TypeData) MethodState
Lens' MethodState ValueState
lensMStoVS
  
instance OOMethodTypeSym JavaCode where
  construct :: String -> MSMthdType JavaCode
construct = String -> MS (JavaCode (Type JavaCode))
String -> MSMthdType JavaCode
forall (r :: * -> *).
CommonRenderSym r =>
String -> MS (r (Type r))
G.construct

instance ParameterSym JavaCode where
  type Parameter JavaCode = ParamData
  param :: SVariable JavaCode -> MSParameter JavaCode
param = (JavaCode (Variable JavaCode) -> Doc)
-> SVariable JavaCode -> MSParameter JavaCode
forall (r :: * -> *).
CommonRenderSym r =>
(r (Variable r) -> Doc) -> SVariable r -> MSParameter r
G.param JavaCode (Variable JavaCode) -> Doc
forall (r :: * -> *). CommonRenderSym r => r (Variable r) -> Doc
R.param
  pointerParam :: SVariable JavaCode -> MSParameter JavaCode
pointerParam = SVariable JavaCode -> MSParameter JavaCode
forall (r :: * -> *).
ParameterSym r =>
SVariable r -> MSParameter r
param

instance RenderParam JavaCode where
  paramFromData :: SVariable JavaCode -> Doc -> MSParameter JavaCode
paramFromData SVariable JavaCode
v' Doc
d = do 
    JavaCode VarData
v <- LensLike'
  (Zoomed (StateT ValueState Identity) (JavaCode VarData))
  MethodState
  ValueState
-> State ValueState (JavaCode VarData)
-> StateT MethodState Identity (JavaCode 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) (JavaCode VarData))
  MethodState
  ValueState
(ValueState -> Focusing Identity (JavaCode VarData) ValueState)
-> MethodState -> Focusing Identity (JavaCode VarData) MethodState
Lens' MethodState ValueState
lensMStoVS State ValueState (JavaCode VarData)
SVariable JavaCode
v'
    JavaCode ParamData -> State MethodState (JavaCode ParamData)
forall a s. a -> State s a
toState (JavaCode ParamData -> State MethodState (JavaCode ParamData))
-> JavaCode ParamData -> State MethodState (JavaCode ParamData)
forall a b. (a -> b) -> a -> b
$ (VarData -> Doc -> ParamData)
-> JavaCode VarData -> JavaCode Doc -> JavaCode ParamData
forall (r :: * -> *) a b c.
Applicative r =>
(a -> b -> c) -> r a -> r b -> r c
on2CodeValues VarData -> Doc -> ParamData
pd JavaCode VarData
v (Doc -> JavaCode Doc
forall (r :: * -> *) a. Monad r => a -> r a
toCode Doc
d)

instance ParamElim JavaCode where
  parameterName :: JavaCode (Parameter JavaCode) -> String
parameterName = JavaCode VarData -> String
JavaCode (Variable JavaCode) -> String
forall (r :: * -> *). VariableElim r => r (Variable r) -> String
variableName (JavaCode VarData -> String)
-> (JavaCode ParamData -> JavaCode VarData)
-> JavaCode ParamData
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ParamData -> VarData) -> JavaCode ParamData -> JavaCode VarData
forall (r :: * -> *) a b. Functor r => (a -> b) -> r a -> r b
onCodeValue ParamData -> VarData
paramVar
  parameterType :: JavaCode (Parameter JavaCode) -> JavaCode (Type JavaCode)
parameterType = JavaCode VarData -> JavaCode TypeData
JavaCode (Variable JavaCode) -> JavaCode (Type JavaCode)
forall (r :: * -> *).
VariableElim r =>
r (Variable r) -> r (Type r)
variableType (JavaCode VarData -> JavaCode TypeData)
-> (JavaCode ParamData -> JavaCode VarData)
-> JavaCode ParamData
-> JavaCode TypeData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ParamData -> VarData) -> JavaCode ParamData -> JavaCode VarData
forall (r :: * -> *) a b. Functor r => (a -> b) -> r a -> r b
onCodeValue ParamData -> VarData
paramVar
  parameter :: JavaCode (Parameter JavaCode) -> Doc
parameter = ParamData -> Doc
paramDoc (ParamData -> Doc)
-> (JavaCode ParamData -> ParamData) -> JavaCode ParamData -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JavaCode ParamData -> ParamData
forall a. JavaCode a -> a
unJC

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

  inOutFunc :: String -> JavaCode (Visibility JavaCode) -> InOutFunc JavaCode
inOutFunc String
n JavaCode (Visibility JavaCode)
s = (VSType JavaCode
 -> [MSParameter JavaCode] -> MSBody JavaCode -> SMethod JavaCode)
-> InOutFunc JavaCode
jInOut (String
-> JavaCode (Visibility JavaCode)
-> VSType JavaCode
-> [MSParameter JavaCode]
-> MSBody JavaCode
-> SMethod JavaCode
forall (r :: * -> *).
MethodSym r =>
String
-> r (Visibility r)
-> VSType r
-> [MSParameter r]
-> MSBody r
-> SMethod r
function String
n JavaCode (Visibility JavaCode)
s)
  docInOutFunc :: String -> JavaCode (Visibility JavaCode) -> DocInOutFunc JavaCode
docInOutFunc String
n JavaCode (Visibility JavaCode)
s = InOutFunc JavaCode -> DocInOutFunc JavaCode
forall (r :: * -> *).
CommonRenderSym r =>
([SVariable r]
 -> [SVariable r] -> [SVariable r] -> MSBody r -> SMethod r)
-> String
-> [(String, SVariable r)]
-> [(String, SVariable r)]
-> [(String, SVariable r)]
-> MSBody r
-> SMethod r
jDocInOut (String -> JavaCode (Visibility JavaCode) -> InOutFunc JavaCode
forall (r :: * -> *).
MethodSym r =>
String -> r (Visibility r) -> InOutFunc r
inOutFunc String
n JavaCode (Visibility JavaCode)
s)

instance OOMethodSym JavaCode where
  method :: String
-> JavaCode (Visibility JavaCode)
-> JavaCode (Permanence JavaCode)
-> VSType JavaCode
-> [MSParameter JavaCode]
-> MSBody JavaCode
-> SMethod JavaCode
method = String
-> JavaCode (Visibility JavaCode)
-> JavaCode (Permanence JavaCode)
-> VSType JavaCode
-> [MSParameter JavaCode]
-> MSBody JavaCode
-> SMethod JavaCode
forall (r :: * -> *).
OORenderSym r =>
String
-> r (Visibility r)
-> r (Permanence r)
-> VSType r
-> [MSParameter r]
-> MSBody r
-> SMethod r
G.method
  getMethod :: SVariable JavaCode -> SMethod JavaCode
getMethod = SVariable JavaCode -> SMethod JavaCode
forall (r :: * -> *). OORenderSym r => SVariable r -> SMethod r
G.getMethod
  setMethod :: SVariable JavaCode -> SMethod JavaCode
setMethod = SVariable JavaCode -> SMethod JavaCode
forall (r :: * -> *). OORenderSym r => SVariable r -> SMethod r
G.setMethod
  constructor :: [MSParameter JavaCode]
-> NamedArgs JavaCode -> MSBody JavaCode -> SMethod JavaCode
constructor [MSParameter JavaCode]
ps NamedArgs JavaCode
is MSBody JavaCode
b = MS String
getClassName MS String
-> (String -> StateT MethodState Identity (JavaCode MethodData))
-> StateT MethodState Identity (JavaCode MethodData)
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
>>= (\String
n -> String
-> [MSParameter JavaCode]
-> NamedArgs JavaCode
-> MSBody JavaCode
-> SMethod JavaCode
forall (r :: * -> *).
OORenderSym r =>
String
-> [MSParameter r] -> Initializers r -> MSBody r -> SMethod r
CP.constructor String
n [MSParameter JavaCode]
ps NamedArgs JavaCode
is MSBody JavaCode
b)

  inOutMethod :: String
-> JavaCode (Visibility JavaCode)
-> JavaCode (Permanence JavaCode)
-> InOutFunc JavaCode
inOutMethod String
n JavaCode (Visibility JavaCode)
s JavaCode (Permanence JavaCode)
p = (VSType JavaCode
 -> [MSParameter JavaCode] -> MSBody JavaCode -> SMethod JavaCode)
-> InOutFunc JavaCode
jInOut (String
-> JavaCode (Visibility JavaCode)
-> JavaCode (Permanence JavaCode)
-> VSType JavaCode
-> [MSParameter JavaCode]
-> MSBody JavaCode
-> SMethod JavaCode
forall (r :: * -> *).
OOMethodSym r =>
String
-> r (Visibility r)
-> r (Permanence r)
-> VSType r
-> [MSParameter r]
-> MSBody r
-> SMethod r
method String
n JavaCode (Visibility JavaCode)
s JavaCode (Permanence JavaCode)
p)
  docInOutMethod :: String
-> JavaCode (Visibility JavaCode)
-> JavaCode (Permanence JavaCode)
-> DocInOutFunc JavaCode
docInOutMethod String
n JavaCode (Visibility JavaCode)
s JavaCode (Permanence JavaCode)
p = InOutFunc JavaCode -> DocInOutFunc JavaCode
forall (r :: * -> *).
CommonRenderSym r =>
([SVariable r]
 -> [SVariable r] -> [SVariable r] -> MSBody r -> SMethod r)
-> String
-> [(String, SVariable r)]
-> [(String, SVariable r)]
-> [(String, SVariable r)]
-> MSBody r
-> SMethod r
jDocInOut (String
-> JavaCode (Visibility JavaCode)
-> JavaCode (Permanence JavaCode)
-> InOutFunc JavaCode
forall (r :: * -> *).
OOMethodSym r =>
String -> r (Visibility r) -> r (Permanence r) -> InOutFunc r
inOutMethod String
n JavaCode (Visibility JavaCode)
s JavaCode (Permanence JavaCode)
p)

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

instance OORenderMethod JavaCode where
  intMethod :: Bool
-> String
-> JavaCode (Visibility JavaCode)
-> JavaCode (Permanence JavaCode)
-> MSMthdType JavaCode
-> [MSParameter JavaCode]
-> MSBody JavaCode
-> SMethod JavaCode
intMethod Bool
m String
n JavaCode (Visibility JavaCode)
s JavaCode (Permanence JavaCode)
p MSMthdType JavaCode
t [MSParameter JavaCode]
ps MSBody JavaCode
b = do
    JavaCode TypeData
tp <- StateT MethodState Identity (JavaCode TypeData)
MSMthdType JavaCode
t
    [JavaCode ParamData]
pms <- [State MethodState (JavaCode ParamData)]
-> StateT MethodState Identity [JavaCode 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 (JavaCode ParamData)]
[MSParameter JavaCode]
ps
    JavaCode Doc
bd <- State MethodState (JavaCode Doc)
MSBody JavaCode
b
    Map QualifiedName [ExceptionType]
mem <- LensLike'
  (Zoomed
     (StateT ValueState Identity) (Map QualifiedName [ExceptionType]))
  MethodState
  ValueState
-> VS (Map QualifiedName [ExceptionType])
-> StateT MethodState Identity (Map QualifiedName [ExceptionType])
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) (Map QualifiedName [ExceptionType]))
  MethodState
  ValueState
(ValueState
 -> Focusing
      Identity (Map QualifiedName [ExceptionType]) ValueState)
-> MethodState
-> Focusing
     Identity (Map QualifiedName [ExceptionType]) MethodState
Lens' MethodState ValueState
lensMStoVS VS (Map QualifiedName [ExceptionType])
getMethodExcMap
    [ExceptionType]
es <- MS [ExceptionType]
getExceptions
    String
mn <- LensLike'
  (Zoomed (StateT FileState Identity) String) MethodState FileState
-> StateT FileState Identity String -> MS String
forall c.
LensLike'
  (Zoomed (StateT FileState Identity) c) MethodState FileState
-> StateT FileState 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 FileState Identity) String) MethodState FileState
(FileState -> Focusing Identity String FileState)
-> MethodState -> Focusing Identity String MethodState
Lens' MethodState FileState
lensMStoFS StateT FileState Identity String
getModuleName
    let excs :: [Exception]
excs = (ExceptionType -> Exception) -> [ExceptionType] -> [Exception]
forall a b. (a -> b) -> [a] -> [b]
map (JavaCode Exception -> Exception
forall a. JavaCode a -> a
unJC (JavaCode Exception -> Exception)
-> (ExceptionType -> JavaCode Exception)
-> ExceptionType
-> Exception
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptionType -> JavaCode Exception
forall (r :: * -> *).
HasException r =>
ExceptionType -> r Exception
toConcreteExc) ([ExceptionType] -> [Exception]) -> [ExceptionType] -> [Exception]
forall a b. (a -> b) -> a -> b
$ [ExceptionType]
-> ([ExceptionType] -> [ExceptionType])
-> Maybe [ExceptionType]
-> [ExceptionType]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [ExceptionType]
es ([ExceptionType] -> [ExceptionType]
forall a. Eq a => [a] -> [a]
nub ([ExceptionType] -> [ExceptionType])
-> ([ExceptionType] -> [ExceptionType])
-> [ExceptionType]
-> [ExceptionType]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([ExceptionType] -> [ExceptionType] -> [ExceptionType]
forall a. [a] -> [a] -> [a]
++ [ExceptionType]
es)) 
          (QualifiedName
-> Map QualifiedName [ExceptionType] -> Maybe [ExceptionType]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (String -> String -> QualifiedName
qualName String
mn String
n) Map QualifiedName [ExceptionType]
mem)
    (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) (MethodState -> MethodState)
-> (MethodState -> MethodState) -> MethodState -> MethodState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Exception] -> MethodState -> MethodState
addExceptionImports [Exception]
excs) 
    JavaCode MethodData
-> StateT MethodState Identity (JavaCode MethodData)
forall a. a -> StateT MethodState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (JavaCode MethodData
 -> StateT MethodState Identity (JavaCode MethodData))
-> JavaCode MethodData
-> StateT MethodState Identity (JavaCode MethodData)
forall a b. (a -> b) -> a -> b
$ MethodData -> JavaCode MethodData
forall (r :: * -> *) a. Monad r => a -> r a
toCode (MethodData -> JavaCode MethodData)
-> MethodData -> JavaCode MethodData
forall a b. (a -> b) -> a -> b
$ Doc -> MethodData
mthd (Doc -> MethodData) -> Doc -> MethodData
forall a b. (a -> b) -> a -> b
$ String
-> [String]
-> JavaCode (Visibility JavaCode)
-> JavaCode (Permanence JavaCode)
-> JavaCode (Type JavaCode)
-> [JavaCode (Parameter JavaCode)]
-> JavaCode (Body JavaCode)
-> Doc
forall (r :: * -> *).
OORenderSym r =>
String
-> [String]
-> r (Visibility r)
-> r (Permanence r)
-> r (Type r)
-> [r (Parameter r)]
-> r (Body r)
-> Doc
jMethod String
n ((Exception -> String) -> [Exception] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Exception -> String
exc [Exception]
excs) JavaCode (Visibility JavaCode)
s JavaCode (Permanence JavaCode)
p JavaCode TypeData
JavaCode (Type JavaCode)
tp [JavaCode ParamData]
[JavaCode (Parameter JavaCode)]
pms JavaCode Doc
JavaCode (Body JavaCode)
bd
  intFunc :: Bool
-> String
-> JavaCode (Visibility JavaCode)
-> JavaCode (Permanence JavaCode)
-> MSMthdType JavaCode
-> [MSParameter JavaCode]
-> MSBody JavaCode
-> SMethod JavaCode
intFunc = Bool
-> String
-> JavaCode (Visibility JavaCode)
-> JavaCode (Permanence JavaCode)
-> MSMthdType JavaCode
-> [MSParameter JavaCode]
-> MSBody JavaCode
-> SMethod JavaCode
forall (r :: * -> *).
OORenderSym r =>
Bool
-> String
-> r (Visibility r)
-> r (Permanence r)
-> MSMthdType r
-> [MSParameter r]
-> MSBody r
-> SMethod r
C.intFunc
  destructor :: [CSStateVar JavaCode] -> SMethod JavaCode
destructor [CSStateVar JavaCode]
_ = String -> SMethod JavaCode
forall a. HasCallStack => String -> a
error (String -> SMethod JavaCode) -> String -> SMethod JavaCode
forall a b. (a -> b) -> a -> b
$ String -> String
CP.destructorError String
jName
  
instance MethodElim JavaCode where
  method :: JavaCode (Method JavaCode) -> Doc
method = MethodData -> Doc
mthdDoc (MethodData -> Doc)
-> (JavaCode MethodData -> MethodData)
-> JavaCode MethodData
-> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JavaCode MethodData -> MethodData
forall a. JavaCode a -> a
unJC

instance StateVarSym JavaCode where
  type StateVar JavaCode = Doc
  stateVar :: JavaCode (Visibility JavaCode)
-> JavaCode (Permanence JavaCode)
-> SVariable JavaCode
-> CSStateVar JavaCode
stateVar = JavaCode (Visibility JavaCode)
-> JavaCode (Permanence JavaCode)
-> SVariable JavaCode
-> CS (JavaCode Doc)
JavaCode (Visibility JavaCode)
-> JavaCode (Permanence JavaCode)
-> SVariable JavaCode
-> CSStateVar JavaCode
forall (r :: * -> *).
(OORenderSym r, Monad r) =>
r (Visibility r) -> r (Permanence r) -> SVariable r -> CS (r Doc)
CP.stateVar
  stateVarDef :: JavaCode (Visibility JavaCode)
-> JavaCode (Permanence JavaCode)
-> SVariable JavaCode
-> SValue JavaCode
-> CSStateVar JavaCode
stateVarDef = JavaCode (Visibility JavaCode)
-> JavaCode (Permanence JavaCode)
-> SVariable JavaCode
-> SValue JavaCode
-> CS (JavaCode Doc)
JavaCode (Visibility JavaCode)
-> JavaCode (Permanence JavaCode)
-> SVariable JavaCode
-> SValue JavaCode
-> CSStateVar JavaCode
forall (r :: * -> *).
(OORenderSym r, Monad r) =>
r (Visibility r)
-> r (Permanence r) -> SVariable r -> SValue r -> CS (r Doc)
CP.stateVarDef
  constVar :: JavaCode (Visibility JavaCode)
-> SVariable JavaCode -> SValue JavaCode -> CSStateVar JavaCode
constVar = Doc
-> JavaCode (Visibility JavaCode)
-> SVariable JavaCode
-> SValue JavaCode
-> CS (JavaCode Doc)
forall (r :: * -> *).
(CommonRenderSym r, Monad r) =>
Doc -> r (Visibility r) -> SVariable r -> SValue r -> CS (r Doc)
CP.constVar (JavaCode (Permanence JavaCode) -> Doc
forall (r :: * -> *). PermElim r => r (Permanence r) -> Doc
RC.perm (JavaCode (Permanence JavaCode)
forall (r :: * -> *). PermanenceSym r => r (Permanence r)
static :: JavaCode (Permanence JavaCode)))
  
instance StateVarElim JavaCode where
  stateVar :: JavaCode (StateVar JavaCode) -> Doc
stateVar = JavaCode Doc -> Doc
JavaCode (StateVar JavaCode) -> Doc
forall a. JavaCode a -> a
unJC

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

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

instance RenderClass JavaCode where
  intClass :: String
-> JavaCode (Visibility JavaCode)
-> JavaCode Doc
-> [CSStateVar JavaCode]
-> [SMethod JavaCode]
-> [SMethod JavaCode]
-> SClass JavaCode
intClass = (String -> Doc -> Doc -> Doc -> Doc -> Doc)
-> String
-> JavaCode (Visibility JavaCode)
-> JavaCode Doc
-> [CSStateVar JavaCode]
-> [SMethod JavaCode]
-> [SMethod JavaCode]
-> CS (JavaCode 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
R.class'
  
  inherit :: Maybe String -> JavaCode Doc
inherit Maybe String
n = Doc -> JavaCode Doc
forall (r :: * -> *) a. Monad r => a -> r a
toCode (Doc -> JavaCode Doc) -> Doc -> JavaCode 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
jExtends <+>) (Doc -> Doc) -> (String -> Doc) -> String -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Doc
text) Maybe String
n
  implements :: [String] -> JavaCode Doc
implements [String]
is = Doc -> JavaCode Doc
forall (r :: * -> *) a. Monad r => a -> r a
toCode (Doc -> JavaCode Doc) -> Doc -> JavaCode Doc
forall a b. (a -> b) -> a -> b
$ Doc
jImplements Doc -> Doc -> Doc
<+> String -> Doc
text (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
listSep [String]
is)

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

instance ModuleSym JavaCode where
  type Module JavaCode = ModData
  buildModule :: String
-> [String]
-> [SMethod JavaCode]
-> [SClass JavaCode]
-> FSModule JavaCode
buildModule String
n = String
-> (String -> JavaCode (Import JavaCode))
-> [String]
-> [SMethod JavaCode]
-> [SClass JavaCode]
-> FSModule JavaCode
forall (r :: * -> *).
OORenderSym r =>
String
-> (String -> r (Import r))
-> [String]
-> [SMethod r]
-> [SClass r]
-> FSModule r
CP.buildModule' String
n String -> JavaCode (Import JavaCode)
forall (r :: * -> *). ImportSym r => String -> r (Import r)
langImport
  
instance RenderMod JavaCode where
  modFromData :: String -> FS Doc -> FSModule JavaCode
modFromData String
n = String
-> (Doc -> JavaCode (Module JavaCode))
-> FS Doc
-> FSModule JavaCode
forall (r :: * -> *).
String -> (Doc -> r (Module r)) -> FS Doc -> FSModule r
G.modFromData String
n (ModData -> JavaCode ModData
forall (r :: * -> *) a. Monad r => a -> r a
toCode (ModData -> JavaCode ModData)
-> (Doc -> ModData) -> Doc -> JavaCode ModData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Doc -> ModData
md String
n)
  updateModuleDoc :: (Doc -> Doc)
-> JavaCode (Module JavaCode) -> JavaCode (Module JavaCode)
updateModuleDoc Doc -> Doc
f = (ModData -> ModData) -> JavaCode ModData -> JavaCode ModData
forall (r :: * -> *) a b. Functor r => (a -> b) -> r a -> r b
onCodeValue ((Doc -> Doc) -> ModData -> ModData
updateMod Doc -> Doc
f)
  
instance ModuleElim JavaCode where
  module' :: JavaCode (Module JavaCode) -> Doc
module' = ModData -> Doc
modDoc (ModData -> Doc)
-> (JavaCode ModData -> ModData) -> JavaCode ModData -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JavaCode ModData -> ModData
forall a. JavaCode a -> a
unJC

instance BlockCommentSym JavaCode where
  type BlockComment JavaCode = Doc
  blockComment :: [String] -> JavaCode (BlockComment JavaCode)
blockComment [String]
lns = Doc -> JavaCode Doc
forall (r :: * -> *) a. Monad r => a -> r a
toCode (Doc -> JavaCode Doc) -> Doc -> JavaCode Doc
forall a b. (a -> b) -> a -> b
$ [String] -> Doc -> Doc -> Doc
R.blockCmt [String]
lns Doc
blockCmtStart Doc
blockCmtEnd
  docComment :: forall a.
State a [String] -> State a (JavaCode (BlockComment JavaCode))
docComment = ([String] -> JavaCode Doc)
-> StateT a Identity [String] -> State a (JavaCode Doc)
forall a b s. (a -> b) -> State s a -> State s b
onStateValue (\[String]
lns -> Doc -> JavaCode Doc
forall (r :: * -> *) a. Monad r => a -> r a
toCode (Doc -> JavaCode Doc) -> Doc -> JavaCode Doc
forall a b. (a -> b) -> a -> b
$ [String] -> Doc -> Doc -> Doc
R.docCmt [String]
lns Doc
docCmtStart 
    Doc
blockCmtEnd)

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

instance HasException JavaCode where
  toConcreteExc :: ExceptionType -> JavaCode Exception
toConcreteExc ExceptionType
Standard = Exception -> JavaCode Exception
forall (r :: * -> *) a. Monad r => a -> r a
toCode (Exception -> JavaCode Exception)
-> Exception -> JavaCode Exception
forall a b. (a -> b) -> a -> b
$ String -> Exception
stdExc String
exceptionObj
  toConcreteExc ExceptionType
FileNotFound = Exception -> JavaCode Exception
forall (r :: * -> *) a. Monad r => a -> r a
toCode (Exception -> JavaCode Exception)
-> Exception -> JavaCode Exception
forall a b. (a -> b) -> a -> b
$ String -> String -> Exception
exception (String -> String
javaImport String
io) String
jFNFExc
  toConcreteExc ExceptionType
IO = Exception -> JavaCode Exception
forall (r :: * -> *) a. Monad r => a -> r a
toCode (Exception -> JavaCode Exception)
-> Exception -> JavaCode Exception
forall a b. (a -> b) -> a -> b
$ String -> String -> Exception
exception (String -> String
javaImport String
io) String
jIOExc

jName, jVersion :: String
jName :: String
jName = String
"Java"
jVersion :: String
jVersion = String
"14"

jImport :: Label -> Doc
jImport :: String -> Doc
jImport String
n = Doc
importLabel Doc -> Doc -> Doc
<+> String -> Doc
text String
n Doc -> Doc -> Doc
<> Doc
endStatement

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

jInfileType :: (CommonRenderSym r) => VSType r
jInfileType :: forall (r :: * -> *). CommonRenderSym r => VSType r
jInfileType = do 
  r (Type r)
tpf <- CodeType -> String -> Doc -> VSType r
forall (r :: * -> *).
RenderType r =>
CodeType -> String -> Doc -> VSType r
typeFromData CodeType
InFile String
jScanner Doc
jScanner'
  (ValueState -> ValueState) -> r (Type r) -> VSType r
forall s a. (s -> s) -> a -> State s a
modifyReturn (String -> ValueState -> ValueState
addLangImportVS (String -> ValueState -> ValueState)
-> String -> ValueState -> ValueState
forall a b. (a -> b) -> a -> b
$ String -> String
utilImport String
jScanner) r (Type r)
tpf

jOutfileType :: (CommonRenderSym r) => VSType r
jOutfileType :: forall (r :: * -> *). CommonRenderSym r => VSType r
jOutfileType = do 
  r (Type r)
tpf <- CodeType -> String -> Doc -> VSType r
forall (r :: * -> *).
RenderType r =>
CodeType -> String -> Doc -> VSType r
typeFromData CodeType
OutFile String
jPrintWriter (String -> Doc
text String
jPrintWriter)
  (ValueState -> ValueState) -> r (Type r) -> VSType r
forall s a. (s -> s) -> a -> State s a
modifyReturn (String -> ValueState -> ValueState
addLangImportVS (String -> ValueState -> ValueState)
-> String -> ValueState -> ValueState
forall a b. (a -> b) -> a -> b
$ String -> String
ioImport String
jPrintWriter) r (Type r)
tpf

jExtends, jImplements, jFinal, jScanner', jLambdaSep :: Doc
jExtends :: Doc
jExtends = String -> Doc
text String
"extends"
jImplements :: Doc
jImplements = String -> Doc
text String
"implements"
jFinal :: Doc
jFinal = String -> Doc
text String
"final"
jScanner' :: Doc
jScanner' = String -> Doc
text String
jScanner
jLambdaSep :: Doc
jLambdaSep = String -> Doc
text String
"->"

arrayList, jBool, jBool', jInteger, jObject, jScanner, jContains,
  jPrintWriter, jFile, jFileWriter, jIOExc, jFNFExc, jArrays, jSet, jAsList, jSetOf, jStdIn, 
  jStdOut, jPrintLn, jEquals, jParseInt, jParseDbl, jParseFloat, jIndex, 
  jListAdd, jListRemove, jListUnion, jListAccess, jListSet, jClose, jNext, jNextLine, jNextBool, 
  jHasNextLine, jCharAt, jSplit, io, util :: String
arrayList :: String
arrayList = String
"ArrayList"
jBool :: String
jBool = String
"boolean"
jBool' :: String
jBool' = String
"Boolean"
jInteger :: String
jInteger = String
"Integer"
jObject :: String
jObject = String
"Object"
jScanner :: String
jScanner = String
"Scanner"
jContains :: String
jContains = String
"contains"
jPrintWriter :: String
jPrintWriter = String
"PrintWriter"
jFile :: String
jFile = String
"File"
jFileWriter :: String
jFileWriter = String
"FileWriter"
jIOExc :: String
jIOExc = String
"IOException"
jFNFExc :: String
jFNFExc = String
"FileNotFoundException"
jArrays :: String
jArrays = String
"Arrays"
jSet :: String
jSet = String
"Set"
jAsList :: String
jAsList = String
jArrays String -> String -> String
`access` String
"asList"
jSetOf :: String
jSetOf = String
jSet String -> String -> String
`access` String
"of"
jStdIn :: String
jStdIn = String
"in"
jStdOut :: String
jStdOut = String
"out"
jPrintLn :: String
jPrintLn = String
"println"
jEquals :: String
jEquals = String
"equals"
jParseInt :: String
jParseInt = String
jInteger String -> String -> String
`access` String
"parseInt"
jParseDbl :: String
jParseDbl = String
CP.doubleRender String -> String -> String
`access` String
"parseDouble"
jParseFloat :: String
jParseFloat = String
CP.floatRender String -> String -> String
`access` String
"parseFloat"
jIndex :: String
jIndex = String
"indexOf"
jListAdd :: String
jListAdd = String
"add"
jListRemove :: String
jListRemove = String
"remove"
jListUnion :: String
jListUnion = String
"addAll"
jListAccess :: String
jListAccess = String
"get"
jListSet :: String
jListSet = String
"set"
jClose :: String
jClose = String
"close"
jNext :: String
jNext = String
"next"
jNextLine :: String
jNextLine = String
"nextLine"
jNextBool :: String
jNextBool = String
"nextBoolean"
jHasNextLine :: String
jHasNextLine = String
"hasNextLine"
jCharAt :: String
jCharAt = String
"charAt"
jSplit :: String
jSplit = String
"split"
io :: String
io = String
"io"
util :: String
util = String
"util"

javaImport, ioImport, utilImport :: String -> String
javaImport :: String -> String
javaImport = String -> String -> String
access String
"java"
ioImport :: String -> String
ioImport = String -> String
javaImport (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
access String
io
utilImport :: String -> String
utilImport = String -> String
javaImport (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
access String
util

jSystem :: String -> Doc
jSystem :: String -> Doc
jSystem = String -> Doc
text (String -> Doc) -> (String -> String) -> String -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
access String
"System"

jUnaryMath :: (Monad r) => String -> VSOp r
jUnaryMath :: forall (r :: * -> *). Monad r => String -> VSOp r
jUnaryMath = String -> VSOp r
forall (r :: * -> *). Monad r => String -> VSOp r
unOpPrec (String -> VSOp r) -> (String -> String) -> String -> VSOp r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
mathFunc

jListType :: (CommonRenderSym r) => VSType r -> VSType r
jListType :: forall (r :: * -> *). CommonRenderSym r => VSType r -> VSType r
jListType VSType r
t = do
  (ValueState -> ValueState) -> StateT ValueState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (String -> ValueState -> ValueState
addLangImportVS (String -> ValueState -> ValueState)
-> String -> ValueState -> ValueState
forall a b. (a -> b) -> a -> b
$ String -> String
utilImport String
arrayList) 
  VSType r
t VSType r -> (r (Type r) -> VSType r) -> VSType 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
>>= (CodeType -> VSType r
jListType' (CodeType -> VSType r)
-> (r (Type r) -> CodeType) -> r (Type r) -> VSType r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r (Type r) -> CodeType
forall (r :: * -> *). TypeElim r => r (Type r) -> CodeType
getType)
  where jListType' :: CodeType -> VSType r
jListType' CodeType
Integer = CodeType -> String -> Doc -> VSType r
forall (r :: * -> *).
RenderType r =>
CodeType -> String -> Doc -> VSType r
typeFromData (CodeType -> CodeType
List CodeType
Integer) 
          String
lstInt (String -> Doc
text String
lstInt)
        jListType' CodeType
Float = String -> VSType r -> VSType r
forall (r :: * -> *).
CommonRenderSym r =>
String -> VSType r -> VSType r
C.listType String
arrayList VSType r
forall (r :: * -> *). CommonRenderSym r => VSType r
CP.float
        jListType' CodeType
Double = String -> VSType r -> VSType r
forall (r :: * -> *).
CommonRenderSym r =>
String -> VSType r -> VSType r
C.listType String
arrayList VSType r
forall (r :: * -> *). CommonRenderSym r => VSType r
CP.double
        jListType' CodeType
Boolean = CodeType -> String -> Doc -> VSType r
forall (r :: * -> *).
RenderType r =>
CodeType -> String -> Doc -> VSType r
typeFromData (CodeType -> CodeType
List CodeType
Boolean) String
lstBool (String -> Doc
text String
lstBool)
        jListType' CodeType
_ = String -> VSType r -> VSType r
forall (r :: * -> *).
CommonRenderSym r =>
String -> VSType r -> VSType r
C.listType String
arrayList VSType r
t
        lstInt :: String
lstInt = String
arrayList String -> String -> String
`containing` String
jInteger
        lstBool :: String
lstBool = String
arrayList String -> String -> String
`containing` String
jBool'

jSetType :: (OORenderSym r) => VSType r -> VSType r
jSetType :: forall (r :: * -> *). OORenderSym r => VSType r -> VSType r
jSetType VSType r
t = do
  (ValueState -> ValueState) -> StateT ValueState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (String -> ValueState -> ValueState
addLangImportVS (String -> ValueState -> ValueState)
-> String -> ValueState -> ValueState
forall a b. (a -> b) -> a -> b
$ String -> String
utilImport String
"Set") 
  VSType r
t VSType r -> (r (Type r) -> VSType r) -> VSType 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
>>= (CodeType -> VSType r
jSetType' (CodeType -> VSType r)
-> (r (Type r) -> CodeType) -> r (Type r) -> VSType r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r (Type r) -> CodeType
forall (r :: * -> *). TypeElim r => r (Type r) -> CodeType
getType)
  where jSetType' :: CodeType -> VSType r
jSetType' CodeType
Integer = CodeType -> String -> Doc -> VSType r
forall (r :: * -> *).
RenderType r =>
CodeType -> String -> Doc -> VSType r
typeFromData (CodeType -> CodeType
Set CodeType
Integer) 
          String
stInt (String -> Doc
text String
stInt)
        jSetType' CodeType
Float = String -> VSType r -> VSType r
forall (r :: * -> *).
OORenderSym r =>
String -> VSType r -> VSType r
C.setType String
"Set" VSType r
forall (r :: * -> *). CommonRenderSym r => VSType r
CP.float
        jSetType' CodeType
Double = String -> VSType r -> VSType r
forall (r :: * -> *).
OORenderSym r =>
String -> VSType r -> VSType r
C.setType String
"Set" VSType r
forall (r :: * -> *). CommonRenderSym r => VSType r
CP.double
        jSetType' CodeType
Boolean = CodeType -> String -> Doc -> VSType r
forall (r :: * -> *).
RenderType r =>
CodeType -> String -> Doc -> VSType r
typeFromData (CodeType -> CodeType
Set CodeType
Boolean) String
stBool (String -> Doc
text String
stBool)
        jSetType' CodeType
_ = String -> VSType r -> VSType r
forall (r :: * -> *).
OORenderSym r =>
String -> VSType r -> VSType r
C.setType String
"Set" VSType r
t
        stInt :: String
stInt = String
"Set" String -> String -> String
`containing` String
jInteger
        stBool :: String
stBool = String
"Set" String -> String -> String
`containing` String
jBool'

jArrayType :: VSType JavaCode
jArrayType :: VSType JavaCode
jArrayType = VSType JavaCode -> VSType JavaCode
forall (r :: * -> *). TypeSym r => VSType r -> VSType r
arrayType (String -> VSType JavaCode
forall (r :: * -> *). OOTypeSym r => String -> VSType r
obj String
jObject)

jFileType :: (OORenderSym r) => VSType r
jFileType :: forall (r :: * -> *). OORenderSym r => VSType r
jFileType = do 
  r (Type r)
tpf <- String -> VSType r
forall (r :: * -> *). OOTypeSym r => String -> VSType r
obj String
jFile
  (ValueState -> ValueState) -> r (Type r) -> VSType r
forall s a. (s -> s) -> a -> State s a
modifyReturn (String -> ValueState -> ValueState
addLangImportVS (String -> ValueState -> ValueState)
-> String -> ValueState -> ValueState
forall a b. (a -> b) -> a -> b
$ String -> String
ioImport String
jFile) r (Type r)
tpf

jFileWriterType :: (OORenderSym r) => VSType r
jFileWriterType :: forall (r :: * -> *). OORenderSym r => VSType r
jFileWriterType = do 
  r (Type r)
tpf <- String -> VSType r
forall (r :: * -> *). OOTypeSym r => String -> VSType r
obj String
jFileWriter
  (ValueState -> ValueState) -> r (Type r) -> VSType r
forall s a. (s -> s) -> a -> State s a
modifyReturn (String -> ValueState -> ValueState
addLangImportVS (String -> ValueState -> ValueState)
-> String -> ValueState -> ValueState
forall a b. (a -> b) -> a -> b
$ String -> String
ioImport String
jFileWriter) r (Type r)
tpf

jAsListFunc :: VSType JavaCode -> [SValue JavaCode] -> SValue JavaCode
jAsListFunc :: VSType JavaCode -> [SValue JavaCode] -> SValue JavaCode
jAsListFunc VSType JavaCode
t = String -> VSType JavaCode -> [SValue JavaCode] -> SValue JavaCode
forall (r :: * -> *). ValueExpression r => PosCall r
funcApp String
jAsList (VSType JavaCode -> VSType JavaCode
forall (r :: * -> *). TypeSym r => VSType r -> VSType r
listType VSType JavaCode
t)

jEqualsFunc :: SValue JavaCode -> VSFunction JavaCode
jEqualsFunc :: SValue JavaCode -> VSFunction JavaCode
jEqualsFunc SValue JavaCode
v = String
-> VSType JavaCode -> [SValue JavaCode] -> VSFunction JavaCode
forall (r :: * -> *).
OOFunctionSym r =>
String -> VSType r -> [SValue r] -> VSFunction r
func String
jEquals VSType JavaCode
forall (r :: * -> *). TypeSym r => VSType r
bool [SValue JavaCode
v]

jParseIntFunc :: SValue JavaCode -> SValue JavaCode
jParseIntFunc :: SValue JavaCode -> SValue JavaCode
jParseIntFunc SValue JavaCode
v = String -> VSType JavaCode -> [SValue JavaCode] -> SValue JavaCode
forall (r :: * -> *). ValueExpression r => PosCall r
funcApp String
jParseInt VSType JavaCode
forall (r :: * -> *). TypeSym r => VSType r
int [SValue JavaCode
v]

jParseDblFunc :: SValue JavaCode -> SValue JavaCode
jParseDblFunc :: SValue JavaCode -> SValue JavaCode
jParseDblFunc SValue JavaCode
v = String -> VSType JavaCode -> [SValue JavaCode] -> SValue JavaCode
forall (r :: * -> *). ValueExpression r => PosCall r
funcApp String
jParseDbl VSType JavaCode
forall (r :: * -> *). TypeSym r => VSType r
double [SValue JavaCode
v]

jParseFloatFunc :: SValue JavaCode -> SValue JavaCode
jParseFloatFunc :: SValue JavaCode -> SValue JavaCode
jParseFloatFunc SValue JavaCode
v = String -> VSType JavaCode -> [SValue JavaCode] -> SValue JavaCode
forall (r :: * -> *). ValueExpression r => PosCall r
funcApp String
jParseFloat VSType JavaCode
forall (r :: * -> *). TypeSym r => VSType r
float [SValue JavaCode
v]

jListSetFunc :: SValue JavaCode -> SValue JavaCode -> SValue JavaCode ->
  VSFunction JavaCode
jListSetFunc :: SValue JavaCode
-> SValue JavaCode -> SValue JavaCode -> VSFunction JavaCode
jListSetFunc SValue JavaCode
v SValue JavaCode
i SValue JavaCode
toVal = String
-> VSType JavaCode -> [SValue JavaCode] -> VSFunction JavaCode
forall (r :: * -> *).
OOFunctionSym r =>
String -> VSType r -> [SValue r] -> VSFunction r
func String
jListSet ((JavaCode (Value JavaCode) -> JavaCode TypeData)
-> SValue JavaCode
-> StateT ValueState Identity (JavaCode TypeData)
forall a b s. (a -> b) -> State s a -> State s b
onStateValue JavaCode (Value JavaCode) -> JavaCode TypeData
JavaCode (Value JavaCode) -> JavaCode (Type JavaCode)
forall (r :: * -> *). ValueSym r => r (Value r) -> r (Type r)
valueType SValue JavaCode
v) [SValue JavaCode -> SValue JavaCode
forall (r :: * -> *). CommonRenderSym r => SValue r -> SValue r
intValue SValue JavaCode
i, SValue JavaCode
toVal]

jNextFunc :: VSFunction JavaCode
jNextFunc :: VSFunction JavaCode
jNextFunc = String
-> VSType JavaCode -> [SValue JavaCode] -> VSFunction JavaCode
forall (r :: * -> *).
OOFunctionSym r =>
String -> VSType r -> [SValue r] -> VSFunction r
func String
jNext VSType JavaCode
forall (r :: * -> *). TypeSym r => VSType r
string []

jNextLineFunc :: VSFunction JavaCode
jNextLineFunc :: VSFunction JavaCode
jNextLineFunc = String
-> VSType JavaCode -> [SValue JavaCode] -> VSFunction JavaCode
forall (r :: * -> *).
OOFunctionSym r =>
String -> VSType r -> [SValue r] -> VSFunction r
func String
jNextLine VSType JavaCode
forall (r :: * -> *). TypeSym r => VSType r
string []

jNextBoolFunc :: VSFunction JavaCode
jNextBoolFunc :: VSFunction JavaCode
jNextBoolFunc = String
-> VSType JavaCode -> [SValue JavaCode] -> VSFunction JavaCode
forall (r :: * -> *).
OOFunctionSym r =>
String -> VSType r -> [SValue r] -> VSFunction r
func String
jNextBool VSType JavaCode
forall (r :: * -> *). TypeSym r => VSType r
bool []

jHasNextLineFunc :: VSFunction JavaCode
jHasNextLineFunc :: VSFunction JavaCode
jHasNextLineFunc = String
-> VSType JavaCode -> [SValue JavaCode] -> VSFunction JavaCode
forall (r :: * -> *).
OOFunctionSym r =>
String -> VSType r -> [SValue r] -> VSFunction r
func String
jHasNextLine VSType JavaCode
forall (r :: * -> *). TypeSym r => VSType r
bool []

jCharAtFunc :: VSFunction JavaCode
jCharAtFunc :: VSFunction JavaCode
jCharAtFunc = String
-> VSType JavaCode -> [SValue JavaCode] -> VSFunction JavaCode
forall (r :: * -> *).
OOFunctionSym r =>
String -> VSType r -> [SValue r] -> VSFunction r
func String
jCharAt VSType JavaCode
forall (r :: * -> *). TypeSym r => VSType r
char [Integer -> SValue JavaCode
forall (r :: * -> *). Literal r => Integer -> SValue r
litInt Integer
0]

jSplitFunc :: (OORenderSym r) => Char -> VSFunction r
jSplitFunc :: forall (r :: * -> *). OORenderSym r => Char -> VSFunction r
jSplitFunc 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
jSplit (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]]

jEquality :: SValue JavaCode -> SValue JavaCode -> SValue JavaCode
jEquality :: SValue JavaCode -> SValue JavaCode -> SValue JavaCode
jEquality SValue JavaCode
v1 SValue JavaCode
v2 = VS (JavaCode ValData)
SValue JavaCode
v2 VS (JavaCode ValData)
-> (JavaCode ValData -> VS (JavaCode ValData))
-> VS (JavaCode 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 (JavaCode ValData)
CodeType -> SValue JavaCode
jEquality' (CodeType -> VS (JavaCode ValData))
-> (JavaCode ValData -> CodeType)
-> JavaCode ValData
-> VS (JavaCode ValData)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JavaCode (Type JavaCode) -> CodeType
forall (r :: * -> *). TypeElim r => r (Type r) -> CodeType
getType (JavaCode (Type JavaCode) -> CodeType)
-> (JavaCode ValData -> JavaCode (Type JavaCode))
-> JavaCode ValData
-> CodeType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JavaCode ValData -> JavaCode (Type JavaCode)
JavaCode (Value JavaCode) -> JavaCode (Type JavaCode)
forall (r :: * -> *). ValueSym r => r (Value r) -> r (Type r)
valueType
  where jEquality' :: CodeType -> SValue JavaCode
jEquality' CodeType
String = SValue JavaCode -> VSFunction JavaCode -> SValue JavaCode
forall (r :: * -> *).
OOFunctionSym r =>
SValue r -> VSFunction r -> SValue r
objAccess SValue JavaCode
v1 (SValue JavaCode -> VSFunction JavaCode
jEqualsFunc SValue JavaCode
v2)
        jEquality' CodeType
_ = VSBinOp JavaCode
-> VSType JavaCode
-> SValue JavaCode
-> SValue JavaCode
-> SValue JavaCode
forall (r :: * -> *).
CommonRenderSym r =>
VSBinOp r -> VSType r -> SValue r -> SValue r -> SValue r
typeBinExpr VSBinOp JavaCode
forall (r :: * -> *). BinaryOpSym r => VSBinOp r
equalOp VSType JavaCode
forall (r :: * -> *). TypeSym r => VSType r
bool SValue JavaCode
v1 SValue JavaCode
v2

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

jCast :: VSType JavaCode -> SValue JavaCode -> SValue JavaCode
jCast :: VSType JavaCode -> SValue JavaCode -> SValue JavaCode
jCast = StateT ValueState Identity (VS (JavaCode ValData))
-> VS (JavaCode ValData)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (StateT ValueState Identity (VS (JavaCode ValData))
 -> VS (JavaCode ValData))
-> (StateT ValueState Identity (JavaCode TypeData)
    -> VS (JavaCode ValData)
    -> StateT ValueState Identity (VS (JavaCode ValData)))
-> StateT ValueState Identity (JavaCode TypeData)
-> VS (JavaCode ValData)
-> VS (JavaCode ValData)
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: (JavaCode TypeData -> JavaCode ValData -> VS (JavaCode ValData))
-> StateT ValueState Identity (JavaCode TypeData)
-> VS (JavaCode ValData)
-> StateT ValueState Identity (VS (JavaCode ValData))
forall a b c s.
(a -> b -> c) -> State s a -> State s b -> State s c
on2StateValues (\JavaCode TypeData
t JavaCode ValData
v -> CodeType
-> CodeType
-> JavaCode TypeData
-> JavaCode ValData
-> VS (JavaCode ValData)
jCast' (JavaCode (Type JavaCode) -> CodeType
forall (r :: * -> *). TypeElim r => r (Type r) -> CodeType
getType JavaCode TypeData
JavaCode (Type JavaCode)
t) (JavaCode (Type JavaCode) -> CodeType
forall (r :: * -> *). TypeElim r => r (Type r) -> CodeType
getType (JavaCode (Type JavaCode) -> CodeType)
-> JavaCode (Type JavaCode) -> CodeType
forall a b. (a -> b) -> a -> b
$ JavaCode (Value JavaCode) -> JavaCode (Type JavaCode)
forall (r :: * -> *). ValueSym r => r (Value r) -> r (Type r)
valueType 
  JavaCode ValData
JavaCode (Value JavaCode)
v) JavaCode TypeData
t JavaCode ValData
v)
  where jCast' :: CodeType
-> CodeType
-> JavaCode TypeData
-> JavaCode ValData
-> SValue JavaCode
jCast' CodeType
Double CodeType
String JavaCode TypeData
_ JavaCode ValData
v = SValue JavaCode -> SValue JavaCode
jParseDblFunc (JavaCode ValData -> VS (JavaCode ValData)
forall a s. a -> State s a
toState JavaCode ValData
v)
        jCast' CodeType
Float CodeType
String JavaCode TypeData
_ JavaCode ValData
v = SValue JavaCode -> SValue JavaCode
jParseFloatFunc (JavaCode ValData -> VS (JavaCode ValData)
forall a s. a -> State s a
toState JavaCode ValData
v)
        jCast' CodeType
_ CodeType
_ JavaCode TypeData
t JavaCode ValData
v = VSType JavaCode -> Doc -> SValue JavaCode
forall (r :: * -> *).
CommonRenderSym r =>
VSType r -> Doc -> SValue r
mkStateVal (JavaCode TypeData -> StateT ValueState Identity (JavaCode TypeData)
forall a s. a -> State s a
toState JavaCode TypeData
t) (Doc -> Doc -> Doc
R.castObj (Doc -> Doc
R.cast (JavaCode (Type JavaCode) -> Doc
forall (r :: * -> *). InternalTypeElim r => r (Type r) -> Doc
RC.type' JavaCode TypeData
JavaCode (Type JavaCode)
t))
          (JavaCode (Value JavaCode) -> Doc
forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value JavaCode ValData
JavaCode (Value JavaCode)
v))

jConstDecDef :: (CommonRenderSym r) => SVariable r -> r (Scope r) -> SValue r
  -> MSStatement r
jConstDecDef :: forall (r :: * -> *).
CommonRenderSym r =>
SVariable r -> r (Scope r) -> SValue r -> MSStatement r
jConstDecDef SVariable r
v' r (Scope r)
scp SValue r
def' = do
  r (Variable r)
v <- LensLike'
  (Zoomed (StateT ValueState Identity) (r (Variable r)))
  MethodState
  ValueState
-> SVariable r -> StateT MethodState Identity (r (Variable 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 (Variable r)))
  MethodState
  ValueState
(ValueState -> Focusing Identity (r (Variable r)) ValueState)
-> MethodState -> Focusing Identity (r (Variable r)) MethodState
Lens' MethodState ValueState
lensMStoVS SVariable r
v'
  r (Value r)
def <- 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
def'
  (MethodState -> MethodState) -> StateT MethodState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((MethodState -> MethodState) -> StateT MethodState Identity ())
-> (MethodState -> MethodState) -> StateT MethodState Identity ()
forall a b. (a -> b) -> a -> b
$ String -> MethodState -> MethodState
useVarName (String -> MethodState -> MethodState)
-> String -> MethodState -> MethodState
forall a b. (a -> b) -> a -> b
$ r (Variable r) -> String
forall (r :: * -> *). VariableElim r => r (Variable r) -> String
variableName r (Variable r)
v
  (MethodState -> MethodState) -> StateT MethodState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((MethodState -> MethodState) -> StateT MethodState Identity ())
-> (MethodState -> MethodState) -> StateT MethodState Identity ()
forall a b. (a -> b) -> a -> b
$ String -> ScopeData -> MethodState -> MethodState
setVarScope (r (Variable r) -> String
forall (r :: * -> *). VariableElim r => r (Variable r) -> String
variableName r (Variable r)
v) (r (Scope r) -> ScopeData
forall (r :: * -> *). ScopeElim r => r (Scope r) -> ScopeData
scopeData r (Scope r)
scp)
  Doc -> MSStatement r
forall (r :: * -> *). CommonRenderSym r => Doc -> MSStatement r
mkStmt (Doc -> MSStatement r) -> Doc -> MSStatement r
forall a b. (a -> b) -> a -> b
$ Doc
jFinal Doc -> Doc -> Doc
<+> r (Type r) -> Doc
forall (r :: * -> *). InternalTypeElim r => r (Type r) -> Doc
RC.type' (r (Variable r) -> r (Type r)
forall (r :: * -> *).
VariableElim r =>
r (Variable r) -> r (Type r)
variableType r (Variable r)
v) Doc -> Doc -> Doc
<+> 
    r (Variable r) -> Doc
forall (r :: * -> *). InternalVarElim r => r (Variable r) -> Doc
RC.variable r (Variable r)
v 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)
def

jFuncDecDef :: (CommonRenderSym r) => SVariable r -> r (Scope r) ->
  [SVariable r] -> MSBody r -> MSStatement r
jFuncDecDef :: forall (r :: * -> *).
CommonRenderSym r =>
SVariable r
-> r (Scope r) -> [SVariable r] -> MSBody r -> MSStatement r
jFuncDecDef SVariable r
v r (Scope r)
scp [SVariable r]
ps MSBody r
bod = do
  r (Variable r)
vr <- LensLike'
  (Zoomed (StateT ValueState Identity) (r (Variable r)))
  MethodState
  ValueState
-> SVariable r -> StateT MethodState Identity (r (Variable 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 (Variable r)))
  MethodState
  ValueState
(ValueState -> Focusing Identity (r (Variable r)) ValueState)
-> MethodState -> Focusing Identity (r (Variable r)) MethodState
Lens' MethodState ValueState
lensMStoVS SVariable r
v
  (MethodState -> MethodState) -> StateT MethodState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((MethodState -> MethodState) -> StateT MethodState Identity ())
-> (MethodState -> MethodState) -> StateT MethodState Identity ()
forall a b. (a -> b) -> a -> b
$ String -> MethodState -> MethodState
useVarName (String -> MethodState -> MethodState)
-> String -> MethodState -> MethodState
forall a b. (a -> b) -> a -> b
$ r (Variable r) -> String
forall (r :: * -> *). VariableElim r => r (Variable r) -> String
variableName r (Variable r)
vr
  (MethodState -> MethodState) -> StateT MethodState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((MethodState -> MethodState) -> StateT MethodState Identity ())
-> (MethodState -> MethodState) -> StateT MethodState Identity ()
forall a b. (a -> b) -> a -> b
$ String -> ScopeData -> MethodState -> MethodState
setVarScope (r (Variable r) -> String
forall (r :: * -> *). VariableElim r => r (Variable r) -> String
variableName r (Variable r)
vr) (r (Scope r) -> ScopeData
forall (r :: * -> *). ScopeElim r => r (Scope r) -> ScopeData
scopeData r (Scope r)
scp)
  [r (Variable r)]
pms <- (SVariable r -> StateT MethodState Identity (r (Variable r)))
-> [SVariable r] -> StateT MethodState Identity [r (Variable r)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (LensLike'
  (Zoomed (StateT ValueState Identity) (r (Variable r)))
  MethodState
  ValueState
-> SVariable r -> StateT MethodState Identity (r (Variable 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 (Variable r)))
  MethodState
  ValueState
(ValueState -> Focusing Identity (r (Variable r)) ValueState)
-> MethodState -> Focusing Identity (r (Variable r)) MethodState
Lens' MethodState ValueState
lensMStoVS) [SVariable r]
ps
  r (Body r)
b <- MSBody r
bod
  Doc -> MSStatement r
forall (r :: * -> *). CommonRenderSym r => Doc -> MSStatement r
mkStmt (Doc -> MSStatement r) -> Doc -> MSStatement r
forall a b. (a -> b) -> a -> b
$ r (Type r) -> Doc
forall (r :: * -> *). InternalTypeElim r => r (Type r) -> Doc
RC.type' (r (Variable r) -> r (Type r)
forall (r :: * -> *).
VariableElim r =>
r (Variable r) -> r (Type r)
variableType r (Variable r)
vr) Doc -> Doc -> Doc
<+> r (Variable r) -> Doc
forall (r :: * -> *). InternalVarElim r => r (Variable r) -> Doc
RC.variable r (Variable r)
vr Doc -> Doc -> Doc
<+> Doc
equals Doc -> Doc -> Doc
<+>
    Doc -> Doc
parens ([r (Variable r)] -> Doc
forall (r :: * -> *). CommonRenderSym r => [r (Variable r)] -> Doc
variableList [r (Variable r)]
pms) Doc -> Doc -> Doc
<+> Doc
jLambdaSep Doc -> Doc -> Doc
<+> Doc
bodyStart Doc -> Doc -> Doc
$$ Doc -> Doc
indent (r (Body r) -> Doc
forall (r :: * -> *). BodyElim r => r (Body r) -> Doc
RC.body r (Body r)
b)
    Doc -> Doc -> Doc
$$ Doc
bodyEnd

jThrowDoc :: (CommonRenderSym r) => r (Value r) -> Doc
jThrowDoc :: forall (r :: * -> *). CommonRenderSym r => r (Value r) -> Doc
jThrowDoc r (Value r)
errMsg = Doc
throwLabel Doc -> Doc -> Doc
<+> Doc
new' 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)

jTryCatch :: (CommonRenderSym r) => r (Body r) -> r (Body r) -> Doc
jTryCatch :: forall (r :: * -> *).
CommonRenderSym r =>
r (Body r) -> r (Body r) -> Doc
jTryCatch r (Body r)
tb r (Body r)
cb = [Doc] -> Doc
vcat [
  Doc
tryLabel Doc -> Doc -> Doc
<+> Doc
lbrace,
  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)
tb,
  Doc
rbrace Doc -> Doc -> Doc
<+> Doc
catchLabel Doc -> Doc -> Doc
<+> Doc -> Doc
parens (Doc
exceptionObj' Doc -> Doc -> Doc
<+> String -> Doc
text String
"exc") Doc -> Doc -> Doc
<+> 
    Doc
lbrace,
  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)
cb,
  Doc
rbrace]

jAssert :: (CommonRenderSym r) => r (Value r) -> r (Value r) -> Doc
jAssert :: forall (r :: * -> *).
CommonRenderSym r =>
r (Value r) -> r (Value r) -> Doc
jAssert r (Value r)
condition r (Value r)
errorMessage = [Doc] -> Doc
vcat [
  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
colon Doc -> Doc -> Doc
<+> r (Value r) -> Doc
forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value r (Value r)
errorMessage
  ]

jOut :: (CommonRenderSym r) => Bool -> Maybe (SValue r) -> SValue r -> SValue r -> 
  MSStatement r
jOut :: forall (r :: * -> *).
CommonRenderSym r =>
Bool -> Maybe (SValue r) -> SValue r -> SValue r -> MSStatement r
jOut 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))
jOut' (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 jOut' :: CodeType -> StateT MethodState Identity (r (Statement r))
jOut' (List (Object String
_)) = 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
        jOut' (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
        jOut' 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

jDiscardInput :: SValue JavaCode -> MSStatement JavaCode
jDiscardInput :: SValue JavaCode -> MSStatement JavaCode
jDiscardInput SValue JavaCode
inFn = SValue JavaCode -> MSStatement JavaCode
forall (r :: * -> *). StatementSym r => SValue r -> MSStatement r
valStmt (SValue JavaCode -> MSStatement JavaCode)
-> SValue JavaCode -> MSStatement JavaCode
forall a b. (a -> b) -> a -> b
$ SValue JavaCode
inFn SValue JavaCode -> VSFunction JavaCode -> SValue JavaCode
forall (r :: * -> *).
OOFunctionSym r =>
SValue r -> VSFunction r -> SValue r
$. VSFunction JavaCode
jNextFunc

jInput :: SVariable JavaCode -> SValue JavaCode -> SValue JavaCode
jInput :: SVariable JavaCode -> SValue JavaCode -> SValue JavaCode
jInput SVariable JavaCode
vr SValue JavaCode
inFn = do
  JavaCode VarData
v <- State ValueState (JavaCode VarData)
SVariable JavaCode
vr
  let jInput' :: CodeType -> SValue JavaCode
jInput' CodeType
Integer = SValue JavaCode -> SValue JavaCode
jParseIntFunc (SValue JavaCode -> SValue JavaCode)
-> SValue JavaCode -> SValue JavaCode
forall a b. (a -> b) -> a -> b
$ SValue JavaCode
inFn SValue JavaCode -> VSFunction JavaCode -> SValue JavaCode
forall (r :: * -> *).
OOFunctionSym r =>
SValue r -> VSFunction r -> SValue r
$. VSFunction JavaCode
jNextLineFunc
      jInput' CodeType
Float = SValue JavaCode -> SValue JavaCode
jParseFloatFunc (SValue JavaCode -> SValue JavaCode)
-> SValue JavaCode -> SValue JavaCode
forall a b. (a -> b) -> a -> b
$ SValue JavaCode
inFn SValue JavaCode -> VSFunction JavaCode -> SValue JavaCode
forall (r :: * -> *).
OOFunctionSym r =>
SValue r -> VSFunction r -> SValue r
$. VSFunction JavaCode
jNextLineFunc
      jInput' CodeType
Double = SValue JavaCode -> SValue JavaCode
jParseDblFunc (SValue JavaCode -> SValue JavaCode)
-> SValue JavaCode -> SValue JavaCode
forall a b. (a -> b) -> a -> b
$ SValue JavaCode
inFn SValue JavaCode -> VSFunction JavaCode -> SValue JavaCode
forall (r :: * -> *).
OOFunctionSym r =>
SValue r -> VSFunction r -> SValue r
$. VSFunction JavaCode
jNextLineFunc
      jInput' CodeType
Boolean = SValue JavaCode
inFn SValue JavaCode -> VSFunction JavaCode -> SValue JavaCode
forall (r :: * -> *).
OOFunctionSym r =>
SValue r -> VSFunction r -> SValue r
$. VSFunction JavaCode
jNextBoolFunc
      jInput' CodeType
String = SValue JavaCode
inFn SValue JavaCode -> VSFunction JavaCode -> SValue JavaCode
forall (r :: * -> *).
OOFunctionSym r =>
SValue r -> VSFunction r -> SValue r
$. VSFunction JavaCode
jNextLineFunc
      jInput' CodeType
Char = (SValue JavaCode
inFn SValue JavaCode -> VSFunction JavaCode -> SValue JavaCode
forall (r :: * -> *).
OOFunctionSym r =>
SValue r -> VSFunction r -> SValue r
$. VSFunction JavaCode
jNextFunc) SValue JavaCode -> VSFunction JavaCode -> SValue JavaCode
forall (r :: * -> *).
OOFunctionSym r =>
SValue r -> VSFunction r -> SValue r
$. VSFunction JavaCode
jCharAtFunc
      jInput' CodeType
_ = String -> VS (JavaCode ValData)
forall a. HasCallStack => String -> a
error String
"Attempt to read value of unreadable type"
  CodeType -> SValue JavaCode
jInput' (JavaCode (Type JavaCode) -> CodeType
forall (r :: * -> *). TypeElim r => r (Type r) -> CodeType
getType (JavaCode (Type JavaCode) -> CodeType)
-> JavaCode (Type JavaCode) -> CodeType
forall a b. (a -> b) -> a -> b
$ JavaCode (Variable JavaCode) -> JavaCode (Type JavaCode)
forall (r :: * -> *).
VariableElim r =>
r (Variable r) -> r (Type r)
variableType JavaCode VarData
JavaCode (Variable JavaCode)
v)

jOpenFileR :: (OORenderSym r) => SValue r -> VSType r -> SValue r
jOpenFileR :: forall (r :: * -> *).
OORenderSym r =>
SValue r -> VSType r -> SValue r
jOpenFileR SValue r
n VSType r
t = PosCtorCall r
forall (r :: * -> *). OOValueExpression r => PosCtorCall r
newObj VSType r
t [PosCtorCall r
forall (r :: * -> *). OOValueExpression r => PosCtorCall r
newObj VSType r
forall (r :: * -> *). OORenderSym r => VSType r
jFileType [SValue r
n]]

jOpenFileWorA :: (OORenderSym r) => SValue r -> VSType r -> SValue r -> SValue r
jOpenFileWorA :: forall (r :: * -> *).
OORenderSym r =>
SValue r -> VSType r -> SValue r -> SValue r
jOpenFileWorA SValue r
n VSType r
t SValue r
wa = PosCtorCall r
forall (r :: * -> *). OOValueExpression r => PosCtorCall r
newObj VSType r
t [PosCtorCall r
forall (r :: * -> *). OOValueExpression r => PosCtorCall r
newObj VSType r
forall (r :: * -> *). OORenderSym r => VSType r
jFileWriterType [PosCtorCall r
forall (r :: * -> *). OOValueExpression r => PosCtorCall r
newObj VSType r
forall (r :: * -> *). OORenderSym r => VSType r
jFileType [SValue r
n], 
  SValue r
wa]]

jStringSplit :: (CommonRenderSym r) => SVariable r -> SValue r -> VS Doc
jStringSplit :: forall (r :: * -> *).
CommonRenderSym r =>
SVariable r -> SValue r -> StateT ValueState Identity Doc
jStringSplit = (r (Variable r) -> r (Value r) -> Doc)
-> StateT ValueState Identity (r (Variable r))
-> StateT ValueState Identity (r (Value r))
-> StateT ValueState Identity Doc
forall a b c s.
(a -> b -> c) -> State s a -> State s b -> State s c
on2StateValues (\r (Variable r)
vnew r (Value r)
s -> 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
<+> 
  Doc
new' Doc -> Doc -> Doc
<+> r (Type r) -> Doc
forall (r :: * -> *). InternalTypeElim r => r (Type r) -> Doc
RC.type' (r (Variable r) -> r (Type r)
forall (r :: * -> *).
VariableElim r =>
r (Variable r) -> r (Type r)
variableType r (Variable r)
vnew) Doc -> Doc -> Doc
<> Doc -> Doc
parens (r (Value r) -> Doc
forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value r (Value r)
s))

jMethod :: (OORenderSym r) => Label -> [String] -> r (Visibility r) -> r (Permanence r)
  -> r (Type r) -> [r (Parameter r)] -> r (Body r) -> Doc
jMethod :: forall (r :: * -> *).
OORenderSym r =>
String
-> [String]
-> r (Visibility r)
-> r (Permanence r)
-> r (Type r)
-> [r (Parameter r)]
-> r (Body r)
-> Doc
jMethod String
n [String]
es r (Visibility r)
s r (Permanence r)
p r (Type r)
t [r (Parameter r)]
ps r (Body r)
b = [Doc] -> Doc
vcat [
  r (Visibility r) -> Doc
forall (r :: * -> *). VisibilityElim r => r (Visibility r) -> Doc
RC.visibility r (Visibility r)
s Doc -> Doc -> Doc
<+> r (Permanence r) -> Doc
forall (r :: * -> *). PermElim r => r (Permanence r) -> Doc
RC.perm r (Permanence r)
p Doc -> Doc -> Doc
<+> r (Type r) -> Doc
forall (r :: * -> *). InternalTypeElim r => r (Type r) -> Doc
RC.type' r (Type r)
t 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
<+> [String] -> Doc -> Doc
forall a. [a] -> Doc -> Doc
emptyIfNull [String]
es (Doc
throwsLabel Doc -> Doc -> Doc
<+> 
    String -> Doc
text (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
listSep ([String] -> [String]
forall a. Ord a => [a] -> [a]
sort [String]
es))) Doc -> Doc -> Doc
<+> Doc
lbrace,
  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,
  Doc
rbrace]

outputs :: SVariable JavaCode
outputs :: SVariable JavaCode
outputs = String -> VSType JavaCode -> SVariable JavaCode
forall (r :: * -> *).
VariableSym r =>
String -> VSType r -> SVariable r
var String
"outputs" VSType JavaCode
jArrayType

jAssignFromArray :: Integer -> [SVariable JavaCode] -> [MSStatement JavaCode]
jAssignFromArray :: Integer -> [SVariable JavaCode] -> [MSStatement JavaCode]
jAssignFromArray Integer
_ [] = []
jAssignFromArray Integer
c (SVariable JavaCode
v:[SVariable JavaCode]
vs) = (SVariable JavaCode
v SVariable JavaCode -> SValue JavaCode -> MSStatement JavaCode
forall (r :: * -> *).
AssignStatement r =>
SVariable r -> SValue r -> MSStatement r
&= VSType JavaCode -> SValue JavaCode -> SValue JavaCode
forall (r :: * -> *).
RenderValue r =>
VSType r -> SValue r -> SValue r
cast ((JavaCode (Variable JavaCode) -> JavaCode TypeData)
-> SVariable JavaCode
-> StateT ValueState Identity (JavaCode TypeData)
forall a b s. (a -> b) -> State s a -> State s b
onStateValue JavaCode (Variable JavaCode) -> JavaCode TypeData
JavaCode (Variable JavaCode) -> JavaCode (Type JavaCode)
forall (r :: * -> *).
VariableElim r =>
r (Variable r) -> r (Type r)
variableType SVariable JavaCode
v)
  (SVariable JavaCode -> SValue JavaCode
forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
valueOf (SVariable JavaCode -> SValue JavaCode)
-> SVariable JavaCode -> SValue JavaCode
forall a b. (a -> b) -> a -> b
$ Integer -> SVariable JavaCode -> SVariable JavaCode
forall (r :: * -> *).
VariableSym r =>
Integer -> SVariable r -> SVariable r
arrayElem Integer
c SVariable JavaCode
outputs)) StateT MethodState Identity (JavaCode (Doc, Terminator))
-> [StateT MethodState Identity (JavaCode (Doc, Terminator))]
-> [StateT MethodState Identity (JavaCode (Doc, Terminator))]
forall a. a -> [a] -> [a]
: Integer -> [SVariable JavaCode] -> [MSStatement JavaCode]
jAssignFromArray (Integer
cInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
1) [SVariable JavaCode]
vs

jInOutCall :: (Label -> VSType JavaCode -> [SValue JavaCode] -> 
  SValue JavaCode) -> Label -> [SValue JavaCode] -> [SVariable JavaCode] -> 
  [SVariable JavaCode] -> MSStatement JavaCode
jInOutCall :: (String -> VSType JavaCode -> [SValue JavaCode] -> SValue JavaCode)
-> InOutCall JavaCode
jInOutCall String -> VSType JavaCode -> [SValue JavaCode] -> SValue JavaCode
f String
n [SValue JavaCode]
ins [] [] = SValue JavaCode -> MSStatement JavaCode
forall (r :: * -> *). StatementSym r => SValue r -> MSStatement r
valStmt (SValue JavaCode -> MSStatement JavaCode)
-> SValue JavaCode -> MSStatement JavaCode
forall a b. (a -> b) -> a -> b
$ String -> VSType JavaCode -> [SValue JavaCode] -> SValue JavaCode
f String
n VSType JavaCode
forall (r :: * -> *). TypeSym r => VSType r
void [SValue JavaCode]
ins
jInOutCall String -> VSType JavaCode -> [SValue JavaCode] -> SValue JavaCode
f String
n [SValue JavaCode]
ins [SVariable JavaCode
out] [] = SVariable JavaCode -> SValue JavaCode -> MSStatement JavaCode
forall (r :: * -> *).
AssignStatement r =>
SVariable r -> SValue r -> MSStatement r
assign SVariable JavaCode
out (SValue JavaCode -> MSStatement JavaCode)
-> SValue JavaCode -> MSStatement JavaCode
forall a b. (a -> b) -> a -> b
$ String -> VSType JavaCode -> [SValue JavaCode] -> SValue JavaCode
f String
n ((JavaCode (Variable JavaCode) -> JavaCode TypeData)
-> SVariable JavaCode
-> StateT ValueState Identity (JavaCode TypeData)
forall a b s. (a -> b) -> State s a -> State s b
onStateValue JavaCode (Variable JavaCode) -> JavaCode TypeData
JavaCode (Variable JavaCode) -> JavaCode (Type JavaCode)
forall (r :: * -> *).
VariableElim r =>
r (Variable r) -> r (Type r)
variableType SVariable JavaCode
out) 
  [SValue JavaCode]
ins
jInOutCall String -> VSType JavaCode -> [SValue JavaCode] -> SValue JavaCode
f String
n [SValue JavaCode]
ins [] [SVariable JavaCode
out] = SVariable JavaCode -> SValue JavaCode -> MSStatement JavaCode
forall (r :: * -> *).
AssignStatement r =>
SVariable r -> SValue r -> MSStatement r
assign SVariable JavaCode
out (SValue JavaCode -> MSStatement JavaCode)
-> SValue JavaCode -> MSStatement JavaCode
forall a b. (a -> b) -> a -> b
$ String -> VSType JavaCode -> [SValue JavaCode] -> SValue JavaCode
f String
n ((JavaCode (Variable JavaCode) -> JavaCode TypeData)
-> SVariable JavaCode
-> StateT ValueState Identity (JavaCode TypeData)
forall a b s. (a -> b) -> State s a -> State s b
onStateValue JavaCode (Variable JavaCode) -> JavaCode TypeData
JavaCode (Variable JavaCode) -> JavaCode (Type JavaCode)
forall (r :: * -> *).
VariableElim r =>
r (Variable r) -> r (Type r)
variableType SVariable JavaCode
out) 
  (SVariable JavaCode -> SValue JavaCode
forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
valueOf SVariable JavaCode
out VS (JavaCode ValData)
-> [VS (JavaCode ValData)] -> [VS (JavaCode ValData)]
forall a. a -> [a] -> [a]
: [VS (JavaCode ValData)]
[SValue JavaCode]
ins)
jInOutCall String -> VSType JavaCode -> [SValue JavaCode] -> SValue JavaCode
f String
n [SValue JavaCode]
ins [SVariable JavaCode]
outs [SVariable JavaCode]
both = [State ValueState (JavaCode VarData)] -> MSStatement JavaCode
fCall [State ValueState (JavaCode VarData)]
rets
  where rets :: [State ValueState (JavaCode VarData)]
rets = [State ValueState (JavaCode VarData)]
[SVariable JavaCode]
both [State ValueState (JavaCode VarData)]
-> [State ValueState (JavaCode VarData)]
-> [State ValueState (JavaCode VarData)]
forall a. [a] -> [a] -> [a]
++ [State ValueState (JavaCode VarData)]
[SVariable JavaCode]
outs
        fCall :: [State ValueState (JavaCode VarData)] -> MSStatement JavaCode
fCall [State ValueState (JavaCode VarData)
x] = SVariable JavaCode -> SValue JavaCode -> MSStatement JavaCode
forall (r :: * -> *).
AssignStatement r =>
SVariable r -> SValue r -> MSStatement r
assign State ValueState (JavaCode VarData)
SVariable JavaCode
x (SValue JavaCode -> MSStatement JavaCode)
-> SValue JavaCode -> MSStatement JavaCode
forall a b. (a -> b) -> a -> b
$ String -> VSType JavaCode -> [SValue JavaCode] -> SValue JavaCode
f String
n ((JavaCode VarData -> JavaCode TypeData)
-> State ValueState (JavaCode VarData)
-> StateT ValueState Identity (JavaCode TypeData)
forall a b s. (a -> b) -> State s a -> State s b
onStateValue JavaCode VarData -> JavaCode TypeData
JavaCode (Variable JavaCode) -> JavaCode (Type JavaCode)
forall (r :: * -> *).
VariableElim r =>
r (Variable r) -> r (Type r)
variableType State ValueState (JavaCode VarData)
x) 
          ((SVariable JavaCode -> VS (JavaCode ValData))
-> [SVariable JavaCode] -> [VS (JavaCode ValData)]
forall a b. (a -> b) -> [a] -> [b]
map SVariable JavaCode -> VS (JavaCode ValData)
SVariable JavaCode -> SValue JavaCode
forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
valueOf [SVariable JavaCode]
both [VS (JavaCode ValData)]
-> [VS (JavaCode ValData)] -> [VS (JavaCode ValData)]
forall a. [a] -> [a] -> [a]
++ [VS (JavaCode ValData)]
[SValue JavaCode]
ins)
        fCall [State ValueState (JavaCode VarData)]
xs = MS Bool
isOutputsDeclared MS Bool
-> (Bool
    -> StateT MethodState Identity (JavaCode (Doc, Terminator)))
-> StateT MethodState Identity (JavaCode (Doc, Terminator))
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
>>= (\Bool
odec -> (MethodState -> MethodState) -> StateT MethodState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify MethodState -> MethodState
setOutputsDeclared StateT MethodState Identity ()
-> StateT MethodState Identity (JavaCode (Doc, Terminator))
-> StateT MethodState Identity (JavaCode (Doc, Terminator))
forall a b.
StateT MethodState Identity a
-> StateT MethodState Identity b -> StateT MethodState Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
          [MSStatement JavaCode] -> MSStatement JavaCode
forall (r :: * -> *).
StatementSym r =>
[MSStatement r] -> MSStatement r
multi ((if Bool
odec then SVariable JavaCode -> SValue JavaCode -> MSStatement JavaCode
forall (r :: * -> *).
AssignStatement r =>
SVariable r -> SValue r -> MSStatement r
assign else (SVariable JavaCode
-> JavaCode (Scope JavaCode)
-> SValue JavaCode
-> MSStatement JavaCode
forall (r :: * -> *).
DeclStatement r =>
SVariable r -> r (Scope r) -> SValue r -> MSStatement r
`varDecDef` JavaCode (Scope JavaCode)
forall (r :: * -> *). ScopeSym r => r (Scope r)
local)) SVariable JavaCode
outputs 
          (String -> VSType JavaCode -> [SValue JavaCode] -> SValue JavaCode
f String
n VSType JavaCode
jArrayType ((SVariable JavaCode -> VS (JavaCode ValData))
-> [SVariable JavaCode] -> [VS (JavaCode ValData)]
forall a b. (a -> b) -> [a] -> [b]
map SVariable JavaCode -> VS (JavaCode ValData)
SVariable JavaCode -> SValue JavaCode
forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
valueOf [SVariable JavaCode]
both [VS (JavaCode ValData)]
-> [VS (JavaCode ValData)] -> [VS (JavaCode ValData)]
forall a. [a] -> [a] -> [a]
++ [VS (JavaCode ValData)]
[SValue JavaCode]
ins)) StateT MethodState Identity (JavaCode (Doc, Terminator))
-> [StateT MethodState Identity (JavaCode (Doc, Terminator))]
-> [StateT MethodState Identity (JavaCode (Doc, Terminator))]
forall a. a -> [a] -> [a]
: Integer -> [SVariable JavaCode] -> [MSStatement JavaCode]
jAssignFromArray Integer
0 [State ValueState (JavaCode VarData)]
[SVariable JavaCode]
xs))

jInOut :: (VSType JavaCode -> [MSParameter JavaCode] -> MSBody JavaCode -> 
    SMethod JavaCode) -> 
  [SVariable JavaCode] -> [SVariable JavaCode] -> [SVariable JavaCode] -> 
  MSBody JavaCode -> SMethod JavaCode
jInOut :: (VSType JavaCode
 -> [MSParameter JavaCode] -> MSBody JavaCode -> SMethod JavaCode)
-> InOutFunc JavaCode
jInOut VSType JavaCode
-> [MSParameter JavaCode] -> MSBody JavaCode -> SMethod JavaCode
f [SVariable JavaCode]
ins [] [] MSBody JavaCode
b = VSType JavaCode
-> [MSParameter JavaCode] -> MSBody JavaCode -> SMethod JavaCode
f VSType JavaCode
forall (r :: * -> *). TypeSym r => VSType r
void ((SVariable JavaCode -> State MethodState (JavaCode ParamData))
-> [SVariable JavaCode] -> [State MethodState (JavaCode ParamData)]
forall a b. (a -> b) -> [a] -> [b]
map SVariable JavaCode -> State MethodState (JavaCode ParamData)
SVariable JavaCode -> MSParameter JavaCode
forall (r :: * -> *).
ParameterSym r =>
SVariable r -> MSParameter r
param [SVariable JavaCode]
ins) MSBody JavaCode
b
jInOut VSType JavaCode
-> [MSParameter JavaCode] -> MSBody JavaCode -> SMethod JavaCode
f [SVariable JavaCode]
ins [SVariable JavaCode
v] [] MSBody JavaCode
b = VSType JavaCode
-> [MSParameter JavaCode] -> MSBody JavaCode -> SMethod JavaCode
f ((JavaCode (Variable JavaCode) -> JavaCode TypeData)
-> SVariable JavaCode
-> StateT ValueState Identity (JavaCode TypeData)
forall a b s. (a -> b) -> State s a -> State s b
onStateValue JavaCode (Variable JavaCode) -> JavaCode TypeData
JavaCode (Variable JavaCode) -> JavaCode (Type JavaCode)
forall (r :: * -> *).
VariableElim r =>
r (Variable r) -> r (Type r)
variableType SVariable JavaCode
v) ((SVariable JavaCode -> State MethodState (JavaCode ParamData))
-> [SVariable JavaCode] -> [State MethodState (JavaCode ParamData)]
forall a b. (a -> b) -> [a] -> [b]
map SVariable JavaCode -> State MethodState (JavaCode ParamData)
SVariable JavaCode -> MSParameter JavaCode
forall (r :: * -> *).
ParameterSym r =>
SVariable r -> MSParameter r
param [SVariable JavaCode]
ins) 
  ((JavaCode (Doc, Terminator)
 -> JavaCode Doc -> JavaCode (Doc, Terminator) -> JavaCode Doc)
-> StateT MethodState Identity (JavaCode (Doc, Terminator))
-> State MethodState (JavaCode Doc)
-> StateT MethodState Identity (JavaCode (Doc, Terminator))
-> State MethodState (JavaCode Doc)
forall a b c d s.
(a -> b -> c -> d)
-> State s a -> State s b -> State s c -> State s d
on3StateValues (((Doc, Terminator) -> Doc -> (Doc, Terminator) -> Doc)
-> JavaCode (Doc, Terminator)
-> JavaCode Doc
-> JavaCode (Doc, Terminator)
-> JavaCode Doc
forall (r :: * -> *) a b c d.
Applicative r =>
(a -> b -> c -> d) -> r a -> r b -> r c -> r d
on3CodeValues (Doc, Terminator) -> Doc -> (Doc, Terminator) -> Doc
surroundBody) (SVariable JavaCode
-> JavaCode (Scope JavaCode) -> MSStatement JavaCode
forall (r :: * -> *).
DeclStatement r =>
SVariable r -> r (Scope r) -> MSStatement r
varDec SVariable JavaCode
v JavaCode (Scope JavaCode)
forall (r :: * -> *). ScopeSym r => r (Scope r)
local) State MethodState (JavaCode Doc)
MSBody JavaCode
b (SValue JavaCode -> MSStatement JavaCode
forall (r :: * -> *).
ControlStatement r =>
SValue r -> MSStatement r
returnStmt (SValue JavaCode -> MSStatement JavaCode)
-> SValue JavaCode -> MSStatement JavaCode
forall a b. (a -> b) -> a -> b
$ 
  SVariable JavaCode -> SValue JavaCode
forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
valueOf SVariable JavaCode
v))
jInOut VSType JavaCode
-> [MSParameter JavaCode] -> MSBody JavaCode -> SMethod JavaCode
f [SVariable JavaCode]
ins [] [SVariable JavaCode
v] MSBody JavaCode
b = VSType JavaCode
-> [MSParameter JavaCode] -> MSBody JavaCode -> SMethod JavaCode
f ((JavaCode (Variable JavaCode) -> JavaCode TypeData)
-> SVariable JavaCode
-> StateT ValueState Identity (JavaCode TypeData)
forall a b s. (a -> b) -> State s a -> State s b
onStateValue JavaCode (Variable JavaCode) -> JavaCode TypeData
JavaCode (Variable JavaCode) -> JavaCode (Type JavaCode)
forall (r :: * -> *).
VariableElim r =>
r (Variable r) -> r (Type r)
variableType SVariable JavaCode
v) 
  ((State ValueState (JavaCode VarData) -> MSParameter JavaCode)
-> [State ValueState (JavaCode VarData)] -> [MSParameter JavaCode]
forall a b. (a -> b) -> [a] -> [b]
map State ValueState (JavaCode VarData) -> MSParameter JavaCode
SVariable JavaCode -> MSParameter JavaCode
forall (r :: * -> *).
ParameterSym r =>
SVariable r -> MSParameter r
param ([State ValueState (JavaCode VarData)] -> [MSParameter JavaCode])
-> [State ValueState (JavaCode VarData)] -> [MSParameter JavaCode]
forall a b. (a -> b) -> a -> b
$ State ValueState (JavaCode VarData)
SVariable JavaCode
v State ValueState (JavaCode VarData)
-> [State ValueState (JavaCode VarData)]
-> [State ValueState (JavaCode VarData)]
forall a. a -> [a] -> [a]
: [State ValueState (JavaCode VarData)]
[SVariable JavaCode]
ins) ((JavaCode Doc -> JavaCode (Doc, Terminator) -> JavaCode Doc)
-> State MethodState (JavaCode Doc)
-> StateT MethodState Identity (JavaCode (Doc, Terminator))
-> State MethodState (JavaCode Doc)
forall a b c s.
(a -> b -> c) -> State s a -> State s b -> State s c
on2StateValues ((Doc -> (Doc, Terminator) -> Doc)
-> JavaCode Doc -> JavaCode (Doc, Terminator) -> JavaCode Doc
forall (r :: * -> *) a b c.
Applicative r =>
(a -> b -> c) -> r a -> r b -> r c
on2CodeValues Doc -> (Doc, Terminator) -> Doc
appendToBody) State MethodState (JavaCode Doc)
MSBody JavaCode
b 
  (SValue JavaCode -> MSStatement JavaCode
forall (r :: * -> *).
ControlStatement r =>
SValue r -> MSStatement r
returnStmt (SValue JavaCode -> MSStatement JavaCode)
-> SValue JavaCode -> MSStatement JavaCode
forall a b. (a -> b) -> a -> b
$ SVariable JavaCode -> SValue JavaCode
forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
valueOf SVariable JavaCode
v))
jInOut VSType JavaCode
-> [MSParameter JavaCode] -> MSBody JavaCode -> SMethod JavaCode
f [SVariable JavaCode]
ins [SVariable JavaCode]
outs [SVariable JavaCode]
both MSBody JavaCode
b = VSType JavaCode
-> [MSParameter JavaCode] -> MSBody JavaCode -> SMethod JavaCode
f ([State ValueState (JavaCode VarData)]
-> StateT ValueState Identity (JavaCode TypeData)
returnTp [State ValueState (JavaCode VarData)]
rets)
  ((State ValueState (JavaCode VarData) -> MSParameter JavaCode)
-> [State ValueState (JavaCode VarData)] -> [MSParameter JavaCode]
forall a b. (a -> b) -> [a] -> [b]
map State ValueState (JavaCode VarData) -> MSParameter JavaCode
SVariable JavaCode -> MSParameter JavaCode
forall (r :: * -> *).
ParameterSym r =>
SVariable r -> MSParameter r
param ([State ValueState (JavaCode VarData)] -> [MSParameter JavaCode])
-> [State ValueState (JavaCode VarData)] -> [MSParameter JavaCode]
forall a b. (a -> b) -> a -> b
$ [State ValueState (JavaCode VarData)]
[SVariable JavaCode]
both [State ValueState (JavaCode VarData)]
-> [State ValueState (JavaCode VarData)]
-> [State ValueState (JavaCode VarData)]
forall a. [a] -> [a] -> [a]
++ [State ValueState (JavaCode VarData)]
[SVariable JavaCode]
ins) ((JavaCode (Doc, Terminator)
 -> JavaCode Doc -> JavaCode (Doc, Terminator) -> JavaCode Doc)
-> StateT MethodState Identity (JavaCode (Doc, Terminator))
-> State MethodState (JavaCode Doc)
-> StateT MethodState Identity (JavaCode (Doc, Terminator))
-> State MethodState (JavaCode Doc)
forall a b c d s.
(a -> b -> c -> d)
-> State s a -> State s b -> State s c -> State s d
on3StateValues (((Doc, Terminator) -> Doc -> (Doc, Terminator) -> Doc)
-> JavaCode (Doc, Terminator)
-> JavaCode Doc
-> JavaCode (Doc, Terminator)
-> JavaCode Doc
forall (r :: * -> *) a b c d.
Applicative r =>
(a -> b -> c -> d) -> r a -> r b -> r c -> r d
on3CodeValues (Doc, Terminator) -> Doc -> (Doc, Terminator) -> Doc
surroundBody) StateT MethodState Identity (JavaCode (Doc, Terminator))
MSStatement JavaCode
decls 
  State MethodState (JavaCode Doc)
MSBody JavaCode
b ([State ValueState (JavaCode VarData)] -> MSStatement JavaCode
returnSt [State ValueState (JavaCode VarData)]
rets))
  where returnTp :: [SVariable JavaCode] -> VSType JavaCode
returnTp [SVariable JavaCode
x] = (JavaCode (Variable JavaCode) -> JavaCode (Type JavaCode))
-> SVariable JavaCode -> VSType JavaCode
forall a b s. (a -> b) -> State s a -> State s b
onStateValue JavaCode (Variable JavaCode) -> JavaCode (Type JavaCode)
forall (r :: * -> *).
VariableElim r =>
r (Variable r) -> r (Type r)
variableType SVariable JavaCode
x
        returnTp [SVariable JavaCode]
_ = VSType JavaCode
jArrayType
        returnSt :: [State ValueState (JavaCode VarData)] -> MSStatement JavaCode
returnSt [State ValueState (JavaCode VarData)
x] = SValue JavaCode -> MSStatement JavaCode
forall (r :: * -> *).
ControlStatement r =>
SValue r -> MSStatement r
returnStmt (SValue JavaCode -> MSStatement JavaCode)
-> SValue JavaCode -> MSStatement JavaCode
forall a b. (a -> b) -> a -> b
$ SVariable JavaCode -> SValue JavaCode
forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
valueOf State ValueState (JavaCode VarData)
SVariable JavaCode
x
        returnSt [State ValueState (JavaCode VarData)]
_ = [MSStatement JavaCode] -> MSStatement JavaCode
forall (r :: * -> *).
StatementSym r =>
[MSStatement r] -> MSStatement r
multi (Integer
-> SVariable JavaCode
-> JavaCode (Scope JavaCode)
-> MSStatement JavaCode
forall (r :: * -> *).
DeclStatement r =>
Integer -> SVariable r -> r (Scope r) -> MSStatement r
arrayDec (Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ [State ValueState (JavaCode VarData)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [State ValueState (JavaCode VarData)]
rets) SVariable JavaCode
outputs JavaCode (Scope JavaCode)
forall (r :: * -> *). ScopeSym r => r (Scope r)
local
          StateT MethodState Identity (JavaCode (Doc, Terminator))
-> [StateT MethodState Identity (JavaCode (Doc, Terminator))]
-> [StateT MethodState Identity (JavaCode (Doc, Terminator))]
forall a. a -> [a] -> [a]
: Integer -> [SValue JavaCode] -> [MSStatement JavaCode]
assignArray Integer
0 ((State ValueState (JavaCode VarData) -> VS (JavaCode ValData))
-> [State ValueState (JavaCode VarData)] -> [VS (JavaCode ValData)]
forall a b. (a -> b) -> [a] -> [b]
map State ValueState (JavaCode VarData) -> VS (JavaCode ValData)
SVariable JavaCode -> SValue JavaCode
forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
valueOf [State ValueState (JavaCode VarData)]
rets)
          [StateT MethodState Identity (JavaCode (Doc, Terminator))]
-> [StateT MethodState Identity (JavaCode (Doc, Terminator))]
-> [StateT MethodState Identity (JavaCode (Doc, Terminator))]
forall a. [a] -> [a] -> [a]
++ [SValue JavaCode -> MSStatement JavaCode
forall (r :: * -> *).
ControlStatement r =>
SValue r -> MSStatement r
returnStmt (SVariable JavaCode -> SValue JavaCode
forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
valueOf SVariable JavaCode
outputs)])
        assignArray :: Integer -> [SValue JavaCode] -> [MSStatement JavaCode]
        assignArray :: Integer -> [SValue JavaCode] -> [MSStatement JavaCode]
assignArray Integer
_ [] = []
        assignArray Integer
c (SValue JavaCode
v:[SValue JavaCode]
vs) = (Integer -> SVariable JavaCode -> SVariable JavaCode
forall (r :: * -> *).
VariableSym r =>
Integer -> SVariable r -> SVariable r
arrayElem Integer
c SVariable JavaCode
outputs SVariable JavaCode -> SValue JavaCode -> MSStatement JavaCode
forall (r :: * -> *).
AssignStatement r =>
SVariable r -> SValue r -> MSStatement r
&= SValue JavaCode
v) StateT MethodState Identity (JavaCode (Doc, Terminator))
-> [StateT MethodState Identity (JavaCode (Doc, Terminator))]
-> [StateT MethodState Identity (JavaCode (Doc, Terminator))]
forall a. a -> [a] -> [a]
: Integer -> [SValue JavaCode] -> [MSStatement JavaCode]
assignArray (Integer
cInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
1) [SValue JavaCode]
vs
        decls :: MSStatement JavaCode
decls = [MSStatement JavaCode] -> MSStatement JavaCode
forall (r :: * -> *).
StatementSym r =>
[MSStatement r] -> MSStatement r
multi ([MSStatement JavaCode] -> MSStatement JavaCode)
-> [MSStatement JavaCode] -> MSStatement JavaCode
forall a b. (a -> b) -> a -> b
$ (SVariable JavaCode
 -> StateT MethodState Identity (JavaCode (Doc, Terminator)))
-> [SVariable JavaCode]
-> [StateT MethodState Identity (JavaCode (Doc, Terminator))]
forall a b. (a -> b) -> [a] -> [b]
map (SVariable JavaCode
-> JavaCode (Scope JavaCode) -> MSStatement JavaCode
forall (r :: * -> *).
DeclStatement r =>
SVariable r -> r (Scope r) -> MSStatement r
`varDec` JavaCode (Scope JavaCode)
forall (r :: * -> *). ScopeSym r => r (Scope r)
local) [SVariable JavaCode]
outs
        rets :: [State ValueState (JavaCode VarData)]
rets = [State ValueState (JavaCode VarData)]
[SVariable JavaCode]
both [State ValueState (JavaCode VarData)]
-> [State ValueState (JavaCode VarData)]
-> [State ValueState (JavaCode VarData)]
forall a. [a] -> [a] -> [a]
++ [State ValueState (JavaCode VarData)]
[SVariable JavaCode]
outs

jDocInOut :: (CommonRenderSym r) => ([SVariable r] -> [SVariable r] -> [SVariable r] -> 
    MSBody r -> SMethod r) -> 
  String -> [(String, SVariable r)] -> [(String, SVariable r)] -> 
  [(String, SVariable r)] -> MSBody r -> SMethod r
jDocInOut :: forall (r :: * -> *).
CommonRenderSym r =>
([SVariable r]
 -> [SVariable r] -> [SVariable r] -> MSBody r -> SMethod r)
-> String
-> [(String, SVariable r)]
-> [(String, SVariable r)]
-> [(String, SVariable r)]
-> MSBody r
-> SMethod r
jDocInOut [SVariable r]
-> [SVariable r] -> [SVariable r] -> MSBody r -> SMethod r
f String
desc [(String, SVariable r)]
is [] [] MSBody r
b = FuncDocRenderer
-> String -> [String] -> [String] -> SMethod r -> SMethod r
forall (r :: * -> *).
CommonRenderSym r =>
FuncDocRenderer
-> String -> [String] -> [String] -> SMethod r -> SMethod r
docFuncRepr FuncDocRenderer
functionDox String
desc (((String, SVariable r) -> String)
-> [(String, SVariable r)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, SVariable r) -> String
forall a b. (a, b) -> a
fst [(String, SVariable r)]
is) [] 
  ([SVariable r]
-> [SVariable r] -> [SVariable r] -> MSBody r -> SMethod r
f (((String, SVariable r) -> SVariable r)
-> [(String, SVariable r)] -> [SVariable r]
forall a b. (a -> b) -> [a] -> [b]
map (String, SVariable r) -> SVariable r
forall a b. (a, b) -> b
snd [(String, SVariable r)]
is) [] [] MSBody r
b)
jDocInOut [SVariable r]
-> [SVariable r] -> [SVariable r] -> MSBody r -> SMethod r
f String
desc [(String, SVariable r)]
is [(String, SVariable r)
o] [] MSBody r
b = FuncDocRenderer
-> String -> [String] -> [String] -> SMethod r -> SMethod r
forall (r :: * -> *).
CommonRenderSym r =>
FuncDocRenderer
-> String -> [String] -> [String] -> SMethod r -> SMethod r
docFuncRepr FuncDocRenderer
functionDox String
desc (((String, SVariable r) -> String)
-> [(String, SVariable r)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, SVariable r) -> String
forall a b. (a, b) -> a
fst [(String, SVariable r)]
is) 
  [(String, SVariable r) -> String
forall a b. (a, b) -> a
fst (String, SVariable r)
o] ([SVariable r]
-> [SVariable r] -> [SVariable r] -> MSBody r -> SMethod r
f (((String, SVariable r) -> SVariable r)
-> [(String, SVariable r)] -> [SVariable r]
forall a b. (a -> b) -> [a] -> [b]
map (String, SVariable r) -> SVariable r
forall a b. (a, b) -> b
snd [(String, SVariable r)]
is) [(String, SVariable r) -> SVariable r
forall a b. (a, b) -> b
snd (String, SVariable r)
o] [] MSBody r
b)
jDocInOut [SVariable r]
-> [SVariable r] -> [SVariable r] -> MSBody r -> SMethod r
f String
desc [(String, SVariable r)]
is [] [(String, SVariable r)
both] MSBody r
b = FuncDocRenderer
-> String -> [String] -> [String] -> SMethod r -> SMethod r
forall (r :: * -> *).
CommonRenderSym r =>
FuncDocRenderer
-> String -> [String] -> [String] -> SMethod r -> SMethod r
docFuncRepr FuncDocRenderer
functionDox String
desc (((String, SVariable r) -> String)
-> [(String, SVariable r)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, SVariable r) -> String
forall a b. (a, b) -> a
fst ((String, SVariable r)
both (String, SVariable r)
-> [(String, SVariable r)] -> [(String, SVariable r)]
forall a. a -> [a] -> [a]
: 
  [(String, SVariable r)]
is)) [(String, SVariable r) -> String
forall a b. (a, b) -> a
fst (String, SVariable r)
both] ([SVariable r]
-> [SVariable r] -> [SVariable r] -> MSBody r -> SMethod r
f (((String, SVariable r) -> SVariable r)
-> [(String, SVariable r)] -> [SVariable r]
forall a b. (a -> b) -> [a] -> [b]
map (String, SVariable r) -> SVariable r
forall a b. (a, b) -> b
snd [(String, SVariable r)]
is) [] [(String, SVariable r) -> SVariable r
forall a b. (a, b) -> b
snd (String, SVariable r)
both] MSBody r
b)
jDocInOut [SVariable r]
-> [SVariable r] -> [SVariable r] -> MSBody r -> SMethod r
f String
desc [(String, SVariable r)]
is [(String, SVariable r)]
os [(String, SVariable r)]
bs MSBody r
b = FuncDocRenderer
-> String -> [String] -> [String] -> SMethod r -> SMethod r
forall (r :: * -> *).
CommonRenderSym r =>
FuncDocRenderer
-> String -> [String] -> [String] -> SMethod r -> SMethod r
docFuncRepr  FuncDocRenderer
functionDox String
desc (((String, SVariable r) -> String)
-> [(String, SVariable r)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, SVariable r) -> String
forall a b. (a, b) -> a
fst ([(String, SVariable r)] -> [String])
-> [(String, SVariable r)] -> [String]
forall a b. (a -> b) -> a -> b
$ [(String, SVariable r)]
bs [(String, SVariable r)]
-> [(String, SVariable r)] -> [(String, SVariable r)]
forall a. [a] -> [a] -> [a]
++ [(String, SVariable r)]
is)
  [String]
rets ([SVariable r]
-> [SVariable r] -> [SVariable r] -> MSBody r -> SMethod r
f (((String, SVariable r) -> SVariable r)
-> [(String, SVariable r)] -> [SVariable r]
forall a b. (a -> b) -> [a] -> [b]
map (String, SVariable r) -> SVariable r
forall a b. (a, b) -> b
snd [(String, SVariable r)]
is) (((String, SVariable r) -> SVariable r)
-> [(String, SVariable r)] -> [SVariable r]
forall a b. (a -> b) -> [a] -> [b]
map (String, SVariable r) -> SVariable r
forall a b. (a, b) -> b
snd [(String, SVariable r)]
os) (((String, SVariable r) -> SVariable r)
-> [(String, SVariable r)] -> [SVariable r]
forall a b. (a -> b) -> [a] -> [b]
map (String, SVariable r) -> SVariable r
forall a b. (a, b) -> b
snd [(String, SVariable r)]
bs) MSBody r
b)
  where rets :: [String]
rets = String
"array containing the following values:" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: ((String, SVariable r) -> String)
-> [(String, SVariable r)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, SVariable r) -> String
forall a b. (a, b) -> a
fst [(String, SVariable r)]
bs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ 
          ((String, SVariable r) -> String)
-> [(String, SVariable r)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, SVariable r) -> String
forall a b. (a, b) -> a
fst [(String, SVariable r)]
os

jExtraClass :: (OORenderSym r) => Label -> Maybe Label ->
  [CSStateVar r] -> [SMethod r] -> [SMethod r] -> SClass r
jExtraClass :: forall (r :: * -> *).
OORenderSym r =>
String
-> Maybe String
-> [CSStateVar r]
-> [SMethod r]
-> [SMethod r]
-> SClass r
jExtraClass String
n = String
-> r (Visibility r)
-> r Doc
-> [CS (r (StateVar r))]
-> [MS (r (Method r))]
-> [MS (r (Method r))]
-> CS (r (Class r))
forall (r :: * -> *).
RenderClass r =>
String
-> r (Visibility r)
-> r Doc
-> [CSStateVar r]
-> [SMethod r]
-> [SMethod r]
-> SClass r
intClass String
n (VisibilityTag -> Doc -> r (Visibility r)
forall (r :: * -> *).
RenderVisibility r =>
VisibilityTag -> Doc -> r (Visibility r)
visibilityFromData VisibilityTag
Priv Doc
empty) (r Doc
 -> [CS (r (StateVar r))]
 -> [MS (r (Method r))]
 -> [MS (r (Method r))]
 -> CS (r (Class r)))
-> (Maybe String -> r Doc)
-> Maybe String
-> [CS (r (StateVar r))]
-> [MS (r (Method r))]
-> [MS (r (Method r))]
-> CS (r (Class r))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe String -> r Doc
forall (r :: * -> *). RenderClass r => Maybe String -> r Doc
inherit

addCallExcsCurrMod :: String -> VS ()
addCallExcsCurrMod :: String -> StateT ValueState Identity ()
addCallExcsCurrMod String
n = do
  String
cm <- LensLike'
  (Zoomed (StateT FileState Identity) String) ValueState FileState
-> StateT FileState Identity String
-> StateT ValueState Identity String
forall c.
LensLike'
  (Zoomed (StateT FileState Identity) c) ValueState FileState
-> StateT FileState 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 FileState Identity) String) ValueState FileState
(FileState -> Focusing Identity String FileState)
-> ValueState -> Focusing Identity String ValueState
Lens' ValueState FileState
lensVStoFS StateT FileState Identity String
getModuleName
  Map QualifiedName [ExceptionType]
mem <- VS (Map QualifiedName [ExceptionType])
getMethodExcMap
  (ValueState -> ValueState) -> StateT ValueState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((ValueState -> ValueState)
-> ([ExceptionType] -> ValueState -> ValueState)
-> Maybe [ExceptionType]
-> ValueState
-> ValueState
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ValueState -> ValueState
forall a. a -> a
id [ExceptionType] -> ValueState -> ValueState
addExceptions (QualifiedName
-> Map QualifiedName [ExceptionType] -> Maybe [ExceptionType]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (String -> String -> QualifiedName
qualName String
cm String
n) Map QualifiedName [ExceptionType]
mem))

addConstructorCallExcsCurrMod :: (CommonRenderSym r) => VSType r -> 
  (VSType r -> SValue r) -> SValue r
addConstructorCallExcsCurrMod :: forall (r :: * -> *).
CommonRenderSym r =>
VSType r -> (VSType r -> SValue r) -> SValue r
addConstructorCallExcsCurrMod VSType r
ot VSType r -> SValue r
f = do
  r (Type r)
t <- VSType r
ot
  String
cm <- LensLike'
  (Zoomed (StateT FileState Identity) String) ValueState FileState
-> StateT FileState Identity String
-> StateT ValueState Identity String
forall c.
LensLike'
  (Zoomed (StateT FileState Identity) c) ValueState FileState
-> StateT FileState 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 FileState Identity) String) ValueState FileState
(FileState -> Focusing Identity String FileState)
-> ValueState -> Focusing Identity String ValueState
Lens' ValueState FileState
lensVStoFS StateT FileState Identity String
getModuleName
  Map QualifiedName [ExceptionType]
mem <- VS (Map QualifiedName [ExceptionType])
getMethodExcMap
  let tp :: String
tp = r (Type r) -> String
forall (r :: * -> *). TypeElim r => r (Type r) -> String
getTypeString r (Type r)
t
  (ValueState -> ValueState) -> StateT ValueState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((ValueState -> ValueState)
-> ([ExceptionType] -> ValueState -> ValueState)
-> Maybe [ExceptionType]
-> ValueState
-> ValueState
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ValueState -> ValueState
forall a. a -> a
id [ExceptionType] -> ValueState -> ValueState
addExceptions (QualifiedName
-> Map QualifiedName [ExceptionType] -> Maybe [ExceptionType]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (String -> String -> QualifiedName
qualName String
cm String
tp) Map QualifiedName [ExceptionType]
mem))
  VSType r -> SValue r
f (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)