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

-- | The logic to render Swift code is contained in this module
module Drasil.GOOL.LanguageRenderer.SwiftRenderer (
  -- * Swift Code Configuration -- defines syntax of all Swift code
  SwiftCode(..), swiftName, swiftVersion
) where

import Utils.Drasil (indent)

import Drasil.GOOL.CodeType (CodeType(..))
import Drasil.GOOL.InterfaceCommon (SharedProg, Label, MSBody, MSBlock, VSType,
  SVariable, SValue, MSStatement, MSParameter, SMethod, BodySym(..), oneLiner,
  bodyStatements, BlockSym(..), TypeSym(..), TypeElim(..), VariableSym(..),
  VisibilitySym(..), VariableElim(..), ValueSym(..), Argument(..), Literal(..),
  litZero, MathConstant(..), VariableValue(..), CommandLineArgs(..),
  NumericExpression(..), BooleanExpression(..), Comparison(..),
  ValueExpression(..), funcApp, funcAppNamedArgs, extFuncApp, List(..), Set(..),
  listSlice, InternalList(..), ThunkSym(..), VectorType(..), VectorDecl(..),
  VectorThunk(..), VectorExpression(..), ThunkAssign(..), StatementSym(..),
  AssignStatement(..), (&=), DeclStatement(..), IOStatement(..),
  StringStatement(..), FunctionSym(..), FuncAppStatement(..),
  CommentStatement(..), ControlStatement(..), ScopeSym(..), ParameterSym(..),
  MethodSym(..), convScope)
import Drasil.GOOL.InterfaceGOOL (OOProg, ProgramSym(..), FileSym(..),
  ModuleSym(..), ClassSym(..), OOTypeSym(..), OOVariableSym(..),
  StateVarSym(..), PermanenceSym(..), OOValueSym, OOVariableValue,
  OOValueExpression(..), selfFuncApp, newObj, InternalValueExp(..),
  objMethodCall, objMethodCallNamedArgs, objMethodCallNoParams,
  OOFunctionSym(..), ($.), GetSet(..), OODeclStatement(..),
  OOFuncAppStatement(..), ObserverPattern(..), StrategyPattern(..),
  OOMethodSym(..), Initializers,
  convTypeOO)
import Drasil.GOOL.RendererClassesCommon (MSMthdType, 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, blockCmtStart, blockCmtEnd,
  docCmtStart, bodyStart, bodyEnd, commentStart, elseIfLabel, forLabel,
  inLabel, tryLabel, catchLabel, throwLabel, throwsLabel, importLabel, listSep',
  printLabel, listSep, piLabel, access, tuple, ClassDocRenderer, parameterList)
import qualified Drasil.GOOL.LanguageRenderer as R (sqrt, abs, log10, log, exp,
  sin, cos, tan, asin, acos, atan, floor, ceil, pow, class', multiStmt, body,
  classVar, func, listSetFunc, castObj, static, dynamic, break, continue,
  private, blockCmt, docCmt, addComments, commentedMod, commentedItem)
import Drasil.GOOL.LanguageRenderer.Constructors (mkStmtNoEnd, mkStateVal,
  mkVal, VSOp, unOpPrec, powerPrec, unExpr, unExpr', typeUnExpr, binExpr,
  binExpr', 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, call, funcAppMixedArgs, selfFuncAppMixedArgs, newObjMixedArgs,
  lambda, func, get, set, listAdd, listAppend, listAccess, listSet, getFunc,
  setFunc, listAppendFunc, stmt, loopStmt, emptyStmt, assign, subAssign,
  increment, objDecNew, print, returnStmt, valStmt, comment, throw, ifCond,
  tryCatch, construct, param, method, getMethod, setMethod, initStmts,
  function, docFunc, buildClass, implementingClass, docClass, commentedClass,
  modFromData, fileDoc, fileFromData, defaultOptSpace, local)
import qualified Drasil.GOOL.LanguageRenderer.CommonPseudoOO as CP (classVar,
  objVarSelf, intClass, buildModule, docMod', contains, bindingError, extFuncAppMixedArgs,
  notNull, listDecDef, destructorError, stateVarDef, constVar, litArray,
  listSetFunc, extraClass, listAccessFunc, doubleRender, double, openFileR,
  openFileW, self, multiAssign, multiReturn, listDec, funcDecDef,
  inOutCall, forLoopError, mainBody, inOutFunc, docInOutFunc', bool, float,
  stringRender', string', inherit, implements, functionDoc, intToIndex,
  indexToInt, forEach', global, setMethodCall)
import qualified Drasil.GOOL.LanguageRenderer.CLike as C (notOp, andOp, orOp,
  litTrue, litFalse, inlineIf, libFuncAppMixedArgs, libNewObjMixedArgs,
  listSize, varDecDef, setDecDef, extObjDecNew, switch, while)
import qualified Drasil.GOOL.LanguageRenderer.Macros as M (ifExists, decrement1,
  increment1, runStrategy, stringListVals, stringListLists, notifyObservers',
  makeSetterVal)
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, Binding(..), VarData(..), vard,
  CommonThunk, pureValue, vectorize, vectorize2, sumComponents, commonVecIndex,
  commonThunkElim, commonThunkDim, ScopeData)
import Drasil.GOOL.Helpers (hicat, emptyIfNull, toCode, toState, onCodeValue,
  onStateValue, on2CodeValues, on2StateValues, onCodeList, onStateList)
import Drasil.GOOL.State (MS, VS, lensGStoFS, lensFStoCS, lensFStoMS,
  lensCStoVS, lensMStoFS, lensMStoVS, lensVStoFS, revFiles, addLangImportVS,
  getLangImports, getLibImports, setFileType, getClassName, setModuleName,
  getModuleName, getCurrMain, getMethodExcMap, getMainDoc, setThrowUsed,
  getThrowUsed, setErrorDefined, getErrorDefined, incrementLine, incrementWord,
  getLineIndex, getWordIndex, resetIndices, useVarName, genLoopIndex,
  genVarNameIf, setVarScope, getVarScope)

import Prelude hiding (break,print,(<>),sin,cos,tan,floor)
import Control.Lens.Zoom (zoom)
import Control.Monad.State (modify)
import Data.Composition ((.:))
import Data.List (intercalate, sort)
import Data.Map (findWithDefault)
import Data.Maybe (fromMaybe, isNothing)
import Text.PrettyPrint.HughesPJ (Doc, text, (<>), (<+>), parens, empty, equals,
  vcat, lbrace, rbrace, braces, brackets, colon, space, doubleQuotes)
import qualified Text.PrettyPrint.HughesPJ as D (float)

swiftExt :: String
swiftExt :: String
swiftExt = String
"swift"

newtype SwiftCode a = SC {forall a. SwiftCode a -> a
unSC :: a} deriving SwiftCode a -> SwiftCode a -> Bool
(SwiftCode a -> SwiftCode a -> Bool)
-> (SwiftCode a -> SwiftCode a -> Bool) -> Eq (SwiftCode a)
forall a. Eq a => SwiftCode a -> SwiftCode a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => SwiftCode a -> SwiftCode a -> Bool
== :: SwiftCode a -> SwiftCode a -> Bool
$c/= :: forall a. Eq a => SwiftCode a -> SwiftCode a -> Bool
/= :: SwiftCode a -> SwiftCode a -> Bool
Eq

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

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

instance Monad SwiftCode where
  SC a
x >>= :: forall a b. SwiftCode a -> (a -> SwiftCode b) -> SwiftCode b
>>= a -> SwiftCode b
f = a -> SwiftCode b
f a
x

instance SharedProg SwiftCode
instance OOProg SwiftCode

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

instance CommonRenderSym SwiftCode
instance OORenderSym SwiftCode

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

  docMod :: String -> [String] -> String -> SFile SwiftCode -> SFile SwiftCode
docMod = String
-> String
-> [String]
-> String
-> SFile SwiftCode
-> SFile SwiftCode
forall (r :: * -> *).
OORenderSym r =>
String -> String -> [String] -> String -> SFile r -> SFile r
CP.docMod' String
swiftExt

instance RenderFile SwiftCode where
  top :: SwiftCode (Module SwiftCode) -> SwiftCode (Block SwiftCode)
top SwiftCode (Module SwiftCode)
_ = Doc -> SwiftCode Doc
forall (r :: * -> *) a. Monad r => a -> r a
toCode Doc
empty
  bottom :: SwiftCode (Block SwiftCode)
bottom = Doc -> SwiftCode Doc
forall (r :: * -> *) a. Monad r => a -> r a
toCode Doc
empty

  commentedMod :: SFile SwiftCode
-> FS (SwiftCode (BlockComment SwiftCode)) -> SFile SwiftCode
commentedMod = (SwiftCode FileData -> SwiftCode Doc -> SwiftCode FileData)
-> StateT FileState Identity (SwiftCode FileData)
-> State FileState (SwiftCode Doc)
-> StateT FileState Identity (SwiftCode FileData)
forall a b c s.
(a -> b -> c) -> State s a -> State s b -> State s c
on2StateValues ((FileData -> Doc -> FileData)
-> SwiftCode FileData -> SwiftCode Doc -> SwiftCode 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 SwiftCode -> SFile SwiftCode
fileFromData = (String
 -> SwiftCode (Module SwiftCode) -> SwiftCode (File SwiftCode))
-> String -> FSModule SwiftCode -> SFile SwiftCode
forall (r :: * -> *).
OORenderSym r =>
(String -> r (Module r) -> r (File r))
-> String -> FSModule r -> SFile r
G.fileFromData ((ModData -> FileData) -> SwiftCode ModData -> SwiftCode FileData
forall (r :: * -> *) a b. Functor r => (a -> b) -> r a -> r b
onCodeValue ((ModData -> FileData) -> SwiftCode ModData -> SwiftCode FileData)
-> (String -> ModData -> FileData)
-> String
-> SwiftCode ModData
-> SwiftCode FileData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ModData -> FileData
fileD)

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

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

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

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

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

  addComments :: String -> MSBody SwiftCode -> MSBody SwiftCode
addComments String
s = (SwiftCode Doc -> SwiftCode Doc)
-> State MethodState (SwiftCode Doc)
-> State MethodState (SwiftCode Doc)
forall a b s. (a -> b) -> State s a -> State s b
onStateValue ((Doc -> Doc) -> SwiftCode Doc -> SwiftCode 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 SwiftCode where
  multiBody :: [MSBody SwiftCode] -> MSBody SwiftCode
multiBody = [MSBody SwiftCode] -> State MethodState (SwiftCode Doc)
[MSBody SwiftCode] -> MSBody SwiftCode
forall (r :: * -> *).
(CommonRenderSym r, Monad r) =>
[MSBody r] -> MS (r Doc)
G.multiBody

instance BodyElim SwiftCode where
  body :: SwiftCode (Body SwiftCode) -> Doc
body = SwiftCode Doc -> Doc
SwiftCode (Body SwiftCode) -> Doc
forall a. SwiftCode a -> a
unSC

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

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

instance BlockElim SwiftCode where
  block :: SwiftCode (Block SwiftCode) -> Doc
block = SwiftCode Doc -> Doc
SwiftCode (Block SwiftCode) -> Doc
forall a. SwiftCode a -> a
unSC

instance TypeSym SwiftCode where
  type Type SwiftCode = TypeData
  bool :: VSType SwiftCode
bool = VSType SwiftCode
forall (r :: * -> *). CommonRenderSym r => VSType r
CP.bool
  int :: VSType SwiftCode
int = VSType SwiftCode
forall (r :: * -> *). CommonRenderSym r => VSType r
swiftIntType
  float :: VSType SwiftCode
float = VSType SwiftCode
forall (r :: * -> *). CommonRenderSym r => VSType r
CP.float
  double :: VSType SwiftCode
double = VSType SwiftCode
forall (r :: * -> *). CommonRenderSym r => VSType r
CP.double
  char :: VSType SwiftCode
char = VSType SwiftCode
forall (r :: * -> *). CommonRenderSym r => VSType r
swiftCharType
  string :: VSType SwiftCode
string = VSType SwiftCode
forall (r :: * -> *). CommonRenderSym r => VSType r
CP.string'
  infile :: VSType SwiftCode
infile = VSType SwiftCode
forall (r :: * -> *). CommonRenderSym r => VSType r
swiftFileType
  outfile :: VSType SwiftCode
outfile = VSType SwiftCode
forall (r :: * -> *). CommonRenderSym r => VSType r
swiftFileHdlType
  listType :: VSType SwiftCode -> VSType SwiftCode
listType = VSType SwiftCode -> VSType SwiftCode
forall (r :: * -> *). CommonRenderSym r => VSType r -> VSType r
swiftListType
  arrayType :: VSType SwiftCode -> VSType SwiftCode
arrayType = VSType SwiftCode -> VSType SwiftCode
forall (r :: * -> *). TypeSym r => VSType r -> VSType r
listType -- For now, treating arrays and lists the same, like we do for Python
  setType :: VSType SwiftCode -> VSType SwiftCode
setType = VSType SwiftCode -> VSType SwiftCode
forall (r :: * -> *). TypeSym r => VSType r -> VSType r
listType
  listInnerType :: VSType SwiftCode -> VSType SwiftCode
listInnerType = VSType SwiftCode -> VSType SwiftCode
forall (r :: * -> *). OORenderSym r => VSType r -> VSType r
G.listInnerType
  funcType :: [VSType SwiftCode] -> VSType SwiftCode -> VSType SwiftCode
funcType = [VSType SwiftCode] -> VSType SwiftCode -> VSType SwiftCode
forall (r :: * -> *).
CommonRenderSym r =>
[VSType r] -> VSType r -> VSType r
swiftFuncType
  void :: VSType SwiftCode
void = VSType SwiftCode
forall (r :: * -> *). CommonRenderSym r => VSType r
swiftVoidType

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

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

instance RenderType SwiftCode where
  multiType :: [VSType SwiftCode] -> VSType SwiftCode
multiType [VSType SwiftCode]
ts = do
    [SwiftCode TypeData]
typs <- [StateT ValueState Identity (SwiftCode TypeData)]
-> StateT ValueState Identity [SwiftCode TypeData]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [StateT ValueState Identity (SwiftCode TypeData)]
[VSType SwiftCode]
ts
    let mt :: String
mt = [String] -> String
tuple ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (SwiftCode TypeData -> String) -> [SwiftCode TypeData] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map SwiftCode TypeData -> String
SwiftCode (Type SwiftCode) -> String
forall (r :: * -> *). TypeElim r => r (Type r) -> String
getTypeString [SwiftCode TypeData]
typs
    CodeType -> String -> Doc -> VSType SwiftCode
forall (r :: * -> *).
RenderType r =>
CodeType -> String -> Doc -> VSType r
typeFromData CodeType
Void String
mt (String -> Doc
text String
mt)
  typeFromData :: CodeType -> String -> Doc -> VSType SwiftCode
typeFromData CodeType
t String
s Doc
d = SwiftCode (Type SwiftCode) -> VSType SwiftCode
forall a s. a -> State s a
toState (SwiftCode (Type SwiftCode) -> VSType SwiftCode)
-> SwiftCode (Type SwiftCode) -> VSType SwiftCode
forall a b. (a -> b) -> a -> b
$ TypeData -> SwiftCode TypeData
forall (r :: * -> *) a. Monad r => a -> r a
toCode (TypeData -> SwiftCode TypeData) -> TypeData -> SwiftCode TypeData
forall a b. (a -> b) -> a -> b
$ CodeType -> String -> Doc -> TypeData
td CodeType
t String
s Doc
d

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

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

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

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

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

instance ScopeElim SwiftCode where
  scopeData :: SwiftCode (Scope SwiftCode) -> ScopeData
scopeData = SwiftCode ScopeData -> ScopeData
SwiftCode (Scope SwiftCode) -> ScopeData
forall a. SwiftCode a -> a
unSC

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

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

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

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

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

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

instance OOValueSym SwiftCode

instance Argument SwiftCode where
  pointerArg :: SValue SwiftCode -> SValue SwiftCode
pointerArg = SValue SwiftCode -> SValue SwiftCode
forall (r :: * -> *). CommonRenderSym r => SValue r -> SValue r
swiftArgVal

instance Literal SwiftCode where
  litTrue :: SValue SwiftCode
litTrue = SValue SwiftCode
forall (r :: * -> *). CommonRenderSym r => SValue r
C.litTrue
  litFalse :: SValue SwiftCode
litFalse = SValue SwiftCode
forall (r :: * -> *). CommonRenderSym r => SValue r
C.litFalse
  litChar :: Char -> SValue SwiftCode
litChar = (Doc -> Doc) -> Char -> SValue SwiftCode
forall (r :: * -> *).
CommonRenderSym r =>
(Doc -> Doc) -> Char -> SValue r
G.litChar Doc -> Doc
doubleQuotes
  litDouble :: Double -> SValue SwiftCode
litDouble = Double -> SValue SwiftCode
forall (r :: * -> *). CommonRenderSym r => Double -> SValue r
G.litDouble
  litFloat :: Float -> SValue SwiftCode
litFloat = Float -> SValue SwiftCode
forall (r :: * -> *). CommonRenderSym r => Float -> SValue r
swiftLitFloat
  litInt :: Integer -> SValue SwiftCode
litInt = Integer -> SValue SwiftCode
forall (r :: * -> *). CommonRenderSym r => Integer -> SValue r
G.litInt
  litString :: String -> SValue SwiftCode
litString = String -> SValue SwiftCode
forall (r :: * -> *). CommonRenderSym r => String -> SValue r
G.litString
  litArray :: VSType SwiftCode -> [SValue SwiftCode] -> SValue SwiftCode
litArray = (Doc -> Doc)
-> VSType SwiftCode -> [SValue SwiftCode] -> SValue SwiftCode
forall (r :: * -> *).
CommonRenderSym r =>
(Doc -> Doc) -> VSType r -> [SValue r] -> SValue r
CP.litArray Doc -> Doc
brackets
  litSet :: VSType SwiftCode -> [SValue SwiftCode] -> SValue SwiftCode
litSet = VSType SwiftCode -> [SValue SwiftCode] -> SValue SwiftCode
forall (r :: * -> *).
Literal r =>
VSType r -> [SValue r] -> SValue r
litArray
  litList :: VSType SwiftCode -> [SValue SwiftCode] -> SValue SwiftCode
litList = VSType SwiftCode -> [SValue SwiftCode] -> SValue SwiftCode
forall (r :: * -> *).
Literal r =>
VSType r -> [SValue r] -> SValue r
litArray

instance MathConstant SwiftCode where
  pi :: SValue SwiftCode
pi = VSType SwiftCode -> Doc -> SValue SwiftCode
forall (r :: * -> *).
CommonRenderSym r =>
VSType r -> Doc -> SValue r
mkStateVal VSType SwiftCode
forall (r :: * -> *). TypeSym r => VSType r
double Doc
swiftPi

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

instance OOVariableValue SwiftCode

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

instance NumericExpression SwiftCode where
  #~ :: SValue SwiftCode -> SValue SwiftCode
(#~) = VSUnOp SwiftCode -> SValue SwiftCode -> SValue SwiftCode
forall (r :: * -> *).
CommonRenderSym r =>
VSUnOp r -> SValue r -> SValue r
unExpr' VSUnOp SwiftCode
forall (r :: * -> *). UnaryOpSym r => VSUnOp r
negateOp
  #/^ :: SValue SwiftCode -> SValue SwiftCode
(#/^) = VSUnOp SwiftCode -> SValue SwiftCode -> SValue SwiftCode
forall (r :: * -> *).
CommonRenderSym r =>
VSUnOp r -> SValue r -> SValue r
unExpr VSUnOp SwiftCode
forall (r :: * -> *). UnaryOpSym r => VSUnOp r
sqrtOp
  #| :: SValue SwiftCode -> SValue SwiftCode
(#|) = VSUnOp SwiftCode -> SValue SwiftCode -> SValue SwiftCode
forall (r :: * -> *).
CommonRenderSym r =>
VSUnOp r -> SValue r -> SValue r
unExpr VSUnOp SwiftCode
forall (r :: * -> *). UnaryOpSym r => VSUnOp r
absOp
  #+ :: SValue SwiftCode -> SValue SwiftCode -> SValue SwiftCode
(#+) = (SValue SwiftCode -> SValue SwiftCode -> SValue SwiftCode)
-> SValue SwiftCode -> SValue SwiftCode -> SValue SwiftCode
forall (r :: * -> *).
CommonRenderSym r =>
(SValue r -> SValue r -> SValue r)
-> SValue r -> SValue r -> SValue r
swiftNumBinExpr (VSBinOp SwiftCode
-> SValue SwiftCode -> SValue SwiftCode -> SValue SwiftCode
forall (r :: * -> *).
CommonRenderSym r =>
VSBinOp r -> SValue r -> SValue r -> SValue r
binExpr VSBinOp SwiftCode
forall (r :: * -> *). BinaryOpSym r => VSBinOp r
plusOp)
  #- :: SValue SwiftCode -> SValue SwiftCode -> SValue SwiftCode
(#-) = (SValue SwiftCode -> SValue SwiftCode -> SValue SwiftCode)
-> SValue SwiftCode -> SValue SwiftCode -> SValue SwiftCode
forall (r :: * -> *).
CommonRenderSym r =>
(SValue r -> SValue r -> SValue r)
-> SValue r -> SValue r -> SValue r
swiftNumBinExpr (VSBinOp SwiftCode
-> SValue SwiftCode -> SValue SwiftCode -> SValue SwiftCode
forall (r :: * -> *).
CommonRenderSym r =>
VSBinOp r -> SValue r -> SValue r -> SValue r
binExpr VSBinOp SwiftCode
forall (r :: * -> *). BinaryOpSym r => VSBinOp r
minusOp)
  #* :: SValue SwiftCode -> SValue SwiftCode -> SValue SwiftCode
(#*) = (SValue SwiftCode -> SValue SwiftCode -> SValue SwiftCode)
-> SValue SwiftCode -> SValue SwiftCode -> SValue SwiftCode
forall (r :: * -> *).
CommonRenderSym r =>
(SValue r -> SValue r -> SValue r)
-> SValue r -> SValue r -> SValue r
swiftNumBinExpr (VSBinOp SwiftCode
-> SValue SwiftCode -> SValue SwiftCode -> SValue SwiftCode
forall (r :: * -> *).
CommonRenderSym r =>
VSBinOp r -> SValue r -> SValue r -> SValue r
binExpr VSBinOp SwiftCode
forall (r :: * -> *). BinaryOpSym r => VSBinOp r
multOp)
  #/ :: SValue SwiftCode -> SValue SwiftCode -> SValue SwiftCode
(#/) = (SValue SwiftCode -> SValue SwiftCode -> SValue SwiftCode)
-> SValue SwiftCode -> SValue SwiftCode -> SValue SwiftCode
forall (r :: * -> *).
CommonRenderSym r =>
(SValue r -> SValue r -> SValue r)
-> SValue r -> SValue r -> SValue r
swiftNumBinExpr (VSBinOp SwiftCode
-> SValue SwiftCode -> SValue SwiftCode -> SValue SwiftCode
forall (r :: * -> *).
CommonRenderSym r =>
VSBinOp r -> SValue r -> SValue r -> SValue r
binExpr VSBinOp SwiftCode
forall (r :: * -> *). BinaryOpSym r => VSBinOp r
divideOp)
  #% :: SValue SwiftCode -> SValue SwiftCode -> SValue SwiftCode
(#%) = VSBinOp SwiftCode
-> SValue SwiftCode -> SValue SwiftCode -> SValue SwiftCode
forall (r :: * -> *).
CommonRenderSym r =>
VSBinOp r -> SValue r -> SValue r -> SValue r
binExpr VSBinOp SwiftCode
forall (r :: * -> *). BinaryOpSym r => VSBinOp r
moduloOp
  #^ :: SValue SwiftCode -> SValue SwiftCode -> SValue SwiftCode
(#^) SValue SwiftCode
v1' SValue SwiftCode
v2' = do
    SwiftCode ValData
v1 <- StateT ValueState Identity (SwiftCode ValData)
SValue SwiftCode
v1'
    SwiftCode ValData
v2 <- StateT ValueState Identity (SwiftCode ValData)
SValue SwiftCode
v2'
    let swiftPower :: CodeType
-> CodeType
-> StateT ValueState Identity (r (Value r))
-> StateT ValueState Identity (r (Value r))
-> StateT ValueState Identity (r (Value r))
swiftPower CodeType
Integer CodeType
Integer StateT ValueState Identity (r (Value r))
b StateT ValueState Identity (r (Value r))
e = VSType r
-> StateT ValueState Identity (r (Value r))
-> StateT ValueState Identity (r (Value r))
forall (r :: * -> *).
RenderValue r =>
VSType r -> SValue r -> SValue r
cast VSType r
forall (r :: * -> *). TypeSym r => VSType r
int (StateT ValueState Identity (r (Value r))
 -> StateT ValueState Identity (r (Value r)))
-> StateT ValueState Identity (r (Value r))
-> StateT ValueState Identity (r (Value r))
forall a b. (a -> b) -> a -> b
$ VSBinOp r
-> StateT ValueState Identity (r (Value r))
-> StateT ValueState Identity (r (Value r))
-> StateT ValueState Identity (r (Value r))
forall (r :: * -> *).
CommonRenderSym r =>
VSBinOp r -> SValue r -> SValue r -> SValue r
binExpr' VSBinOp r
forall (r :: * -> *). BinaryOpSym r => VSBinOp r
powerOp
          (VSType r
-> StateT ValueState Identity (r (Value r))
-> StateT ValueState Identity (r (Value r))
forall (r :: * -> *).
RenderValue r =>
VSType r -> SValue r -> SValue r
cast VSType r
forall (r :: * -> *). TypeSym r => VSType r
double StateT ValueState Identity (r (Value r))
b) (VSType r
-> StateT ValueState Identity (r (Value r))
-> StateT ValueState Identity (r (Value r))
forall (r :: * -> *).
RenderValue r =>
VSType r -> SValue r -> SValue r
cast VSType r
forall (r :: * -> *). TypeSym r => VSType r
double StateT ValueState Identity (r (Value r))
e)
        swiftPower CodeType
_ CodeType
_ StateT ValueState Identity (r (Value r))
b StateT ValueState Identity (r (Value r))
e = VSBinOp r
-> StateT ValueState Identity (r (Value r))
-> StateT ValueState Identity (r (Value r))
-> StateT ValueState Identity (r (Value r))
forall (r :: * -> *).
CommonRenderSym r =>
VSBinOp r -> SValue r -> SValue r -> SValue r
binExpr' VSBinOp r
forall (r :: * -> *). BinaryOpSym r => VSBinOp r
powerOp StateT ValueState Identity (r (Value r))
b StateT ValueState Identity (r (Value r))
e
    CodeType
-> CodeType
-> SValue SwiftCode
-> SValue SwiftCode
-> SValue SwiftCode
forall {r :: * -> *}.
CommonRenderSym r =>
CodeType
-> CodeType
-> StateT ValueState Identity (r (Value r))
-> StateT ValueState Identity (r (Value r))
-> StateT ValueState Identity (r (Value r))
swiftPower (SwiftCode (Type SwiftCode) -> CodeType
forall (r :: * -> *). TypeElim r => r (Type r) -> CodeType
getType (SwiftCode (Type SwiftCode) -> CodeType)
-> SwiftCode (Type SwiftCode) -> CodeType
forall a b. (a -> b) -> a -> b
$ SwiftCode (Value SwiftCode) -> SwiftCode (Type SwiftCode)
forall (r :: * -> *). ValueSym r => r (Value r) -> r (Type r)
valueType SwiftCode ValData
SwiftCode (Value SwiftCode)
v1) (SwiftCode (Type SwiftCode) -> CodeType
forall (r :: * -> *). TypeElim r => r (Type r) -> CodeType
getType (SwiftCode (Type SwiftCode) -> CodeType)
-> SwiftCode (Type SwiftCode) -> CodeType
forall a b. (a -> b) -> a -> b
$ SwiftCode (Value SwiftCode) -> SwiftCode (Type SwiftCode)
forall (r :: * -> *). ValueSym r => r (Value r) -> r (Type r)
valueType SwiftCode ValData
SwiftCode (Value SwiftCode)
v2) (SwiftCode ValData -> StateT ValueState Identity (SwiftCode ValData)
forall a. a -> StateT ValueState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SwiftCode ValData
v1)
      (SwiftCode ValData -> StateT ValueState Identity (SwiftCode ValData)
forall a. a -> StateT ValueState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SwiftCode ValData
v2)

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

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

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

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

  funcAppMixedArgs :: MixedCall SwiftCode
funcAppMixedArgs = MixedCall SwiftCode
forall (r :: * -> *). CommonRenderSym r => MixedCall r
G.funcAppMixedArgs
  extFuncAppMixedArgs :: String -> MixedCall SwiftCode
extFuncAppMixedArgs = String -> MixedCall SwiftCode
forall (r :: * -> *). CommonRenderSym r => String -> MixedCall r
CP.extFuncAppMixedArgs
  libFuncAppMixedArgs :: String -> MixedCall SwiftCode
libFuncAppMixedArgs = String -> MixedCall SwiftCode
forall (r :: * -> *). CommonRenderSym r => String -> MixedCall r
C.libFuncAppMixedArgs

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

  notNull :: SValue SwiftCode -> SValue SwiftCode
notNull = String -> SValue SwiftCode -> SValue SwiftCode
forall (r :: * -> *).
CommonRenderSym r =>
String -> SValue r -> SValue r
CP.notNull String
swiftNil

instance OOValueExpression SwiftCode where
  selfFuncAppMixedArgs :: MixedCall SwiftCode
selfFuncAppMixedArgs = Doc -> SVariable SwiftCode -> MixedCall SwiftCode
forall (r :: * -> *).
CommonRenderSym r =>
Doc -> SVariable r -> MixedCall r
G.selfFuncAppMixedArgs Doc
dot SVariable SwiftCode
forall (r :: * -> *). OOVariableSym r => SVariable r
self
  newObjMixedArgs :: MixedCtorCall SwiftCode
newObjMixedArgs = MixedCall SwiftCode
forall (r :: * -> *). CommonRenderSym r => MixedCall r
G.newObjMixedArgs String
""
  extNewObjMixedArgs :: MixedCall SwiftCode
extNewObjMixedArgs String
m VSType SwiftCode
tp [SValue SwiftCode]
vs NamedArgs SwiftCode
ns = do
    SwiftCode TypeData
t <- StateT ValueState Identity (SwiftCode TypeData)
VSType SwiftCode
tp
    Maybe String -> Maybe Doc -> MixedCall SwiftCode
forall (r :: * -> *).
RenderValue r =>
Maybe String -> Maybe Doc -> MixedCall r
call (String -> Maybe String
forall a. a -> Maybe a
Just String
m) Maybe Doc
forall a. Maybe a
Nothing (SwiftCode (Type SwiftCode) -> String
forall (r :: * -> *). TypeElim r => r (Type r) -> String
getTypeString SwiftCode TypeData
SwiftCode (Type SwiftCode)
t) (SwiftCode TypeData
-> StateT ValueState Identity (SwiftCode TypeData)
forall a. a -> StateT ValueState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SwiftCode TypeData
t) [SValue SwiftCode]
vs NamedArgs SwiftCode
ns
  libNewObjMixedArgs :: MixedCall SwiftCode
libNewObjMixedArgs = MixedCall SwiftCode
forall (r :: * -> *). OORenderSym r => String -> MixedCtorCall r
C.libNewObjMixedArgs

instance RenderValue SwiftCode where
  inputFunc :: SValue SwiftCode
inputFunc = VSType SwiftCode -> Doc -> SValue SwiftCode
forall (r :: * -> *).
CommonRenderSym r =>
VSType r -> Doc -> SValue r
mkStateVal VSType SwiftCode
forall (r :: * -> *). TypeSym r => VSType r
string Doc
empty
  printFunc :: SValue SwiftCode
printFunc = VSType SwiftCode -> Doc -> SValue SwiftCode
forall (r :: * -> *).
CommonRenderSym r =>
VSType r -> Doc -> SValue r
mkStateVal VSType SwiftCode
forall (r :: * -> *). TypeSym r => VSType r
void Doc
empty
  printLnFunc :: SValue SwiftCode
printLnFunc = VSType SwiftCode -> Doc -> SValue SwiftCode
forall (r :: * -> *).
CommonRenderSym r =>
VSType r -> Doc -> SValue r
mkStateVal VSType SwiftCode
forall (r :: * -> *). TypeSym r => VSType r
void Doc
empty
  printFileFunc :: SValue SwiftCode -> SValue SwiftCode
printFileFunc SValue SwiftCode
_ = VSType SwiftCode -> Doc -> SValue SwiftCode
forall (r :: * -> *).
CommonRenderSym r =>
VSType r -> Doc -> SValue r
mkStateVal VSType SwiftCode
forall (r :: * -> *). TypeSym r => VSType r
void Doc
empty
  printFileLnFunc :: SValue SwiftCode -> SValue SwiftCode
printFileLnFunc SValue SwiftCode
_ = VSType SwiftCode -> Doc -> SValue SwiftCode
forall (r :: * -> *).
CommonRenderSym r =>
VSType r -> Doc -> SValue r
mkStateVal VSType SwiftCode
forall (r :: * -> *). TypeSym r => VSType r
void Doc
empty

  cast :: VSType SwiftCode -> SValue SwiftCode -> SValue SwiftCode
cast = VSType SwiftCode -> SValue SwiftCode -> SValue SwiftCode
forall (r :: * -> *).
CommonRenderSym r =>
VSType r -> SValue r -> SValue r
swiftCast

  call :: Maybe String -> Maybe Doc -> MixedCall SwiftCode
call Maybe String
l Maybe Doc
o String
n VSType SwiftCode
t [SValue SwiftCode]
as NamedArgs SwiftCode
ns = do
    String
mn <- 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
        -- If function being called throws exceptions, need to wrap call in try
    let f :: StateT ValueState Identity (SwiftCode ValData)
-> StateT ValueState Identity (SwiftCode ValData)
f = if [ExceptionType] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([ExceptionType] -> Bool) -> [ExceptionType] -> Bool
forall a b. (a -> b) -> a -> b
$ [ExceptionType]
-> QualifiedName
-> Map QualifiedName [ExceptionType]
-> [ExceptionType]
forall k a. Ord k => a -> k -> Map k a -> a
findWithDefault [] (QualifiedName
-> (String -> QualifiedName) -> Maybe String -> QualifiedName
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> String -> QualifiedName
qualName String
mn String
n) (String -> String -> QualifiedName
`qualName` String
n)
          Maybe String
l) Map QualifiedName [ExceptionType]
mem then StateT ValueState Identity (SwiftCode ValData)
-> StateT ValueState Identity (SwiftCode ValData)
forall a. a -> a
id else StateT ValueState Identity (SwiftCode ValData)
-> StateT ValueState Identity (SwiftCode ValData)
SValue SwiftCode -> SValue SwiftCode
forall (r :: * -> *). CommonRenderSym r => SValue r -> SValue r
swiftTryVal
    StateT ValueState Identity (SwiftCode ValData)
-> StateT ValueState Identity (SwiftCode ValData)
f (StateT ValueState Identity (SwiftCode ValData)
 -> StateT ValueState Identity (SwiftCode ValData))
-> StateT ValueState Identity (SwiftCode ValData)
-> StateT ValueState Identity (SwiftCode ValData)
forall a b. (a -> b) -> a -> b
$ Doc -> Maybe String -> Maybe Doc -> MixedCall SwiftCode
forall (r :: * -> *).
CommonRenderSym r =>
Doc -> Maybe String -> Maybe Doc -> MixedCall r
G.call Doc
swiftNamedArgSep Maybe String
forall a. Maybe a
Nothing Maybe Doc
o String
n VSType SwiftCode
t [SValue SwiftCode]
as NamedArgs SwiftCode
ns

  valFromData :: Maybe Int
-> Maybe Integer -> VSType SwiftCode -> Doc -> SValue SwiftCode
valFromData Maybe Int
p Maybe Integer
i VSType SwiftCode
t' Doc
d = do
    SwiftCode TypeData
t <- StateT ValueState Identity (SwiftCode TypeData)
VSType SwiftCode
t'
    SwiftCode ValData -> StateT ValueState Identity (SwiftCode ValData)
forall a. a -> StateT ValueState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SwiftCode ValData
 -> StateT ValueState Identity (SwiftCode ValData))
-> SwiftCode ValData
-> StateT ValueState Identity (SwiftCode ValData)
forall a b. (a -> b) -> a -> b
$ (TypeData -> Doc -> ValData)
-> SwiftCode TypeData -> SwiftCode Doc -> SwiftCode 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) SwiftCode TypeData
t (Doc -> SwiftCode Doc
forall (r :: * -> *) a. Monad r => a -> r a
toCode Doc
d)

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

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

instance FunctionSym SwiftCode where
  type Function SwiftCode = FuncData

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

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

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

instance Set SwiftCode where
  contains :: SValue SwiftCode -> SValue SwiftCode -> SValue SwiftCode
contains = String -> SValue SwiftCode -> SValue SwiftCode -> SValue SwiftCode
forall (r :: * -> *).
OORenderSym r =>
String -> SValue r -> SValue r -> SValue r
CP.contains String
swiftContains
  setAdd :: SValue SwiftCode -> SValue SwiftCode -> SValue SwiftCode
setAdd = String -> SValue SwiftCode -> SValue SwiftCode -> SValue SwiftCode
forall (r :: * -> *).
OORenderSym r =>
String -> SValue r -> SValue r -> SValue r
CP.setMethodCall String
swiftListAdd
  setRemove :: SValue SwiftCode -> SValue SwiftCode -> SValue SwiftCode
setRemove = String -> SValue SwiftCode -> SValue SwiftCode -> SValue SwiftCode
forall (r :: * -> *).
OORenderSym r =>
String -> SValue r -> SValue r -> SValue r
CP.setMethodCall String
swiftListRemove
  setUnion :: SValue SwiftCode -> SValue SwiftCode -> SValue SwiftCode
setUnion = String -> SValue SwiftCode -> SValue SwiftCode -> SValue SwiftCode
forall (r :: * -> *).
OORenderSym r =>
String -> SValue r -> SValue r -> SValue r
CP.setMethodCall String
swiftUnion

instance InternalList SwiftCode where
  listSlice' :: Maybe (SValue SwiftCode)
-> Maybe (SValue SwiftCode)
-> Maybe (SValue SwiftCode)
-> SVariable SwiftCode
-> SValue SwiftCode
-> MSBlock SwiftCode
listSlice' Maybe (SValue SwiftCode)
b Maybe (SValue SwiftCode)
e Maybe (SValue SwiftCode)
s SVariable SwiftCode
vn SValue SwiftCode
vo = SVariable SwiftCode
-> SValue SwiftCode
-> Maybe (SValue SwiftCode)
-> Maybe (SValue SwiftCode)
-> SValue SwiftCode
-> MSBlock SwiftCode
forall (r :: * -> *).
OORenderSym r =>
SVariable r
-> SValue r
-> Maybe (SValue r)
-> Maybe (SValue r)
-> SValue r
-> MSBlock r
swiftListSlice SVariable SwiftCode
vn SValue SwiftCode
vo Maybe (SValue SwiftCode)
b Maybe (SValue SwiftCode)
e (StateT ValueState Identity (SwiftCode ValData)
-> Maybe (StateT ValueState Identity (SwiftCode ValData))
-> StateT ValueState Identity (SwiftCode ValData)
forall a. a -> Maybe a -> a
fromMaybe (Integer -> SValue SwiftCode
forall (r :: * -> *). Literal r => Integer -> SValue r
litInt Integer
1) Maybe (StateT ValueState Identity (SwiftCode ValData))
Maybe (SValue SwiftCode)
s)

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

instance InternalListFunc SwiftCode where
  listSizeFunc :: SValue SwiftCode -> VSFunction SwiftCode
listSizeFunc SValue SwiftCode
_ = Doc -> VSType SwiftCode -> VSFunction SwiftCode
forall (r :: * -> *).
RenderFunction r =>
Doc -> VSType r -> VSFunction r
funcFromData (Doc -> Doc
R.func Doc
swiftListSize) VSType SwiftCode
forall (r :: * -> *). TypeSym r => VSType r
int
  listAddFunc :: SValue SwiftCode
-> SValue SwiftCode -> SValue SwiftCode -> VSFunction SwiftCode
listAddFunc SValue SwiftCode
_ SValue SwiftCode
i SValue SwiftCode
v = do
    SwiftCode ValData
f <- SValue SwiftCode -> SValue SwiftCode -> SValue SwiftCode
forall (r :: * -> *).
CommonRenderSym r =>
SValue r -> SValue r -> SValue r
swiftListAddFunc SValue SwiftCode
i SValue SwiftCode
v
    Doc -> VSType SwiftCode -> VSFunction SwiftCode
forall (r :: * -> *).
RenderFunction r =>
Doc -> VSType r -> VSFunction r
funcFromData (Doc -> Doc
R.func (SwiftCode (Value SwiftCode) -> Doc
forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value SwiftCode ValData
SwiftCode (Value SwiftCode)
f)) (SwiftCode (Type SwiftCode) -> VSType SwiftCode
forall a. a -> StateT ValueState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SwiftCode (Type SwiftCode) -> VSType SwiftCode)
-> SwiftCode (Type SwiftCode) -> VSType SwiftCode
forall a b. (a -> b) -> a -> b
$ SwiftCode (Value SwiftCode) -> SwiftCode (Type SwiftCode)
forall (r :: * -> *). ValueSym r => r (Value r) -> r (Type r)
valueType SwiftCode ValData
SwiftCode (Value SwiftCode)
f)
  listAppendFunc :: SValue SwiftCode -> SValue SwiftCode -> VSFunction SwiftCode
listAppendFunc SValue SwiftCode
_ = String -> SValue SwiftCode -> VSFunction SwiftCode
forall (r :: * -> *).
OORenderSym r =>
String -> SValue r -> VSFunction r
G.listAppendFunc String
swiftListAppend
  listAccessFunc :: VSType SwiftCode -> SValue SwiftCode -> VSFunction SwiftCode
listAccessFunc = VSType SwiftCode -> SValue SwiftCode -> VSFunction SwiftCode
forall (r :: * -> *).
CommonRenderSym r =>
VSType r -> SValue r -> VSFunction r
CP.listAccessFunc
  listSetFunc :: SValue SwiftCode
-> SValue SwiftCode -> SValue SwiftCode -> VSFunction SwiftCode
listSetFunc = (Doc -> Doc -> Doc)
-> SValue SwiftCode
-> SValue SwiftCode
-> SValue SwiftCode
-> VSFunction SwiftCode
forall (r :: * -> *).
CommonRenderSym r =>
(Doc -> Doc -> Doc)
-> SValue r -> SValue r -> SValue r -> VSFunction r
CP.listSetFunc Doc -> Doc -> Doc
R.listSetFunc

instance ThunkSym SwiftCode where
  type Thunk SwiftCode = CommonThunk VS

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

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

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

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

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

instance RenderFunction SwiftCode where
  funcFromData :: Doc -> VSType SwiftCode -> VSFunction SwiftCode
funcFromData Doc
d = (SwiftCode TypeData -> SwiftCode FuncData)
-> StateT ValueState Identity (SwiftCode TypeData)
-> StateT ValueState Identity (SwiftCode FuncData)
forall a b s. (a -> b) -> State s a -> State s b
onStateValue ((TypeData -> FuncData) -> SwiftCode TypeData -> SwiftCode FuncData
forall (r :: * -> *) a b. Functor r => (a -> b) -> r a -> r b
onCodeValue (TypeData -> Doc -> FuncData
`fd` Doc
d))

instance FunctionElim SwiftCode where
  functionType :: SwiftCode (Function SwiftCode) -> SwiftCode (Type SwiftCode)
functionType = (FuncData -> TypeData) -> SwiftCode FuncData -> SwiftCode TypeData
forall (r :: * -> *) a b. Functor r => (a -> b) -> r a -> r b
onCodeValue FuncData -> TypeData
fType
  function :: SwiftCode (Function SwiftCode) -> Doc
function = FuncData -> Doc
funcDoc (FuncData -> Doc)
-> (SwiftCode FuncData -> FuncData) -> SwiftCode FuncData -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SwiftCode FuncData -> FuncData
forall a. SwiftCode a -> a
unSC

instance InternalAssignStmt SwiftCode where
  multiAssign :: [SVariable SwiftCode]
-> [SValue SwiftCode] -> MSStatement SwiftCode
multiAssign = (Doc -> Doc)
-> [SVariable SwiftCode]
-> [SValue SwiftCode]
-> MSStatement SwiftCode
forall (r :: * -> *).
CommonRenderSym r =>
(Doc -> Doc) -> [SVariable r] -> [SValue r] -> MSStatement r
CP.multiAssign Doc -> Doc
parens

instance InternalIOStmt SwiftCode where
  printSt :: Bool
-> Maybe (SValue SwiftCode)
-> SValue SwiftCode
-> SValue SwiftCode
-> MSStatement SwiftCode
printSt = Bool
-> Maybe (SValue SwiftCode)
-> SValue SwiftCode
-> SValue SwiftCode
-> MSStatement SwiftCode
swiftPrint

instance InternalControlStmt SwiftCode where
  multiReturn :: [SValue SwiftCode] -> MSStatement SwiftCode
multiReturn = (Doc -> Doc) -> [SValue SwiftCode] -> MSStatement SwiftCode
forall (r :: * -> *).
CommonRenderSym r =>
(Doc -> Doc) -> [SValue r] -> MSStatement r
CP.multiReturn Doc -> Doc
parens

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

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

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

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

instance DeclStatement SwiftCode where
  varDec :: SVariable SwiftCode
-> SwiftCode (Scope SwiftCode) -> MSStatement SwiftCode
varDec = Doc
-> SVariable SwiftCode
-> SwiftCode (Scope SwiftCode)
-> MSStatement SwiftCode
swiftVarDec Doc
swiftVar
  varDecDef :: SVariable SwiftCode
-> SwiftCode (Scope SwiftCode)
-> SValue SwiftCode
-> MSStatement SwiftCode
varDecDef = Terminator
-> SVariable SwiftCode
-> SwiftCode (Scope SwiftCode)
-> SValue SwiftCode
-> MSStatement SwiftCode
forall (r :: * -> *).
CommonRenderSym r =>
Terminator
-> SVariable r -> r (Scope r) -> SValue r -> MSStatement r
C.varDecDef Terminator
Empty
  setDecDef :: SVariable SwiftCode
-> SwiftCode (Scope SwiftCode)
-> SValue SwiftCode
-> MSStatement SwiftCode
setDecDef = Terminator
-> SVariable SwiftCode
-> SwiftCode (Scope SwiftCode)
-> SValue SwiftCode
-> MSStatement SwiftCode
forall (r :: * -> *).
CommonRenderSym r =>
Terminator
-> SVariable r -> r (Scope r) -> SValue r -> MSStatement r
C.setDecDef Terminator
Empty
  setDec :: SVariable SwiftCode
-> SwiftCode (Scope SwiftCode) -> MSStatement SwiftCode
setDec = Doc
-> SVariable SwiftCode
-> SwiftCode (Scope SwiftCode)
-> MSStatement SwiftCode
swiftSetDec Doc
swiftConst
  listDec :: Integer
-> SVariable SwiftCode
-> SwiftCode (Scope SwiftCode)
-> MSStatement SwiftCode
listDec Integer
_ = SVariable SwiftCode
-> SwiftCode (Scope SwiftCode) -> MSStatement SwiftCode
forall (r :: * -> *).
CommonRenderSym r =>
SVariable r -> r (Scope r) -> MSStatement r
CP.listDec
  listDecDef :: SVariable SwiftCode
-> SwiftCode (Scope SwiftCode)
-> [SValue SwiftCode]
-> MSStatement SwiftCode
listDecDef = SVariable SwiftCode
-> SwiftCode (Scope SwiftCode)
-> [SValue SwiftCode]
-> MSStatement SwiftCode
forall (r :: * -> *).
CommonRenderSym r =>
SVariable r -> r (Scope r) -> [SValue r] -> MSStatement r
CP.listDecDef
  arrayDec :: Integer
-> SVariable SwiftCode
-> SwiftCode (Scope SwiftCode)
-> MSStatement SwiftCode
arrayDec = Integer
-> SVariable SwiftCode
-> SwiftCode (Scope SwiftCode)
-> MSStatement SwiftCode
forall (r :: * -> *).
DeclStatement r =>
Integer -> SVariable r -> r (Scope r) -> MSStatement r
listDec
  arrayDecDef :: SVariable SwiftCode
-> SwiftCode (Scope SwiftCode)
-> [SValue SwiftCode]
-> MSStatement SwiftCode
arrayDecDef = SVariable SwiftCode
-> SwiftCode (Scope SwiftCode)
-> [SValue SwiftCode]
-> MSStatement SwiftCode
forall (r :: * -> *).
DeclStatement r =>
SVariable r -> r (Scope r) -> [SValue r] -> MSStatement r
listDecDef
  constDecDef :: SVariable SwiftCode
-> SwiftCode (Scope SwiftCode)
-> SValue SwiftCode
-> MSStatement SwiftCode
constDecDef SVariable SwiftCode
vr SwiftCode (Scope SwiftCode)
scp SValue SwiftCode
vl' = do
    SwiftCode (Doc, Terminator)
vdec <- Doc
-> SVariable SwiftCode
-> SwiftCode (Scope SwiftCode)
-> MSStatement SwiftCode
swiftVarDec Doc
swiftConst SVariable SwiftCode
vr SwiftCode (Scope SwiftCode)
scp
    SwiftCode ValData
vl <- LensLike'
  (Zoomed (StateT ValueState Identity) (SwiftCode ValData))
  MethodState
  ValueState
-> StateT ValueState Identity (SwiftCode ValData)
-> StateT MethodState Identity (SwiftCode 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) (SwiftCode ValData))
  MethodState
  ValueState
(ValueState -> Focusing Identity (SwiftCode ValData) ValueState)
-> MethodState -> Focusing Identity (SwiftCode ValData) MethodState
Lens' MethodState ValueState
lensMStoVS StateT ValueState Identity (SwiftCode ValData)
SValue SwiftCode
vl'
    Doc -> MSStatement SwiftCode
forall (r :: * -> *). CommonRenderSym r => Doc -> MSStatement r
mkStmtNoEnd (Doc -> MSStatement SwiftCode) -> Doc -> MSStatement SwiftCode
forall a b. (a -> b) -> a -> b
$ SwiftCode (Statement SwiftCode) -> Doc
forall (r :: * -> *). StatementElim r => r (Statement r) -> Doc
RC.statement SwiftCode (Doc, Terminator)
SwiftCode (Statement SwiftCode)
vdec Doc -> Doc -> Doc
<+> Doc
equals Doc -> Doc -> Doc
<+> SwiftCode (Value SwiftCode) -> Doc
forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value SwiftCode ValData
SwiftCode (Value SwiftCode)
vl
  funcDecDef :: SVariable SwiftCode
-> SwiftCode (Scope SwiftCode)
-> [SVariable SwiftCode]
-> MSBody SwiftCode
-> MSStatement SwiftCode
funcDecDef = SVariable SwiftCode
-> SwiftCode (Scope SwiftCode)
-> [SVariable SwiftCode]
-> MSBody SwiftCode
-> MSStatement SwiftCode
forall (r :: * -> *).
OORenderSym r =>
SVariable r
-> r (Scope r) -> [SVariable r] -> MSBody r -> MSStatement r
CP.funcDecDef

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

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

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

  getInput :: SVariable SwiftCode -> MSStatement SwiftCode
getInput SVariable SwiftCode
v = SVariable SwiftCode
v SVariable SwiftCode -> SValue SwiftCode -> MSStatement SwiftCode
forall (r :: * -> *).
AssignStatement r =>
SVariable r -> SValue r -> MSStatement r
&= SVariable SwiftCode -> SValue SwiftCode -> SValue SwiftCode
swiftInput SVariable SwiftCode
v SValue SwiftCode
forall (r :: * -> *). CommonRenderSym r => SValue r
swiftReadLineFunc
  discardInput :: MSStatement SwiftCode
discardInput = SValue SwiftCode -> MSStatement SwiftCode
forall (r :: * -> *). StatementSym r => SValue r -> MSStatement r
valStmt SValue SwiftCode
forall (r :: * -> *). CommonRenderSym r => SValue r
swiftReadLineFunc
  getFileInput :: SValue SwiftCode -> SVariable SwiftCode -> MSStatement SwiftCode
getFileInput SValue SwiftCode
_ SVariable SwiftCode
v = do
    Integer
wi <- MS Integer
getWordIndex
    Integer
li <- MS Integer
getLineIndex
    (MethodState -> MethodState) -> StateT MethodState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify MethodState -> MethodState
incrementWord
    SVariable SwiftCode
v SVariable SwiftCode -> SValue SwiftCode -> MSStatement SwiftCode
forall (r :: * -> *).
AssignStatement r =>
SVariable r -> SValue r -> MSStatement r
&= SVariable SwiftCode -> SValue SwiftCode -> SValue SwiftCode
swiftInput SVariable SwiftCode
v
      (SValue SwiftCode -> SValue SwiftCode -> SValue SwiftCode
forall (r :: * -> *). List r => SValue r -> SValue r -> SValue r
listAccess (SValue SwiftCode -> SValue SwiftCode -> SValue SwiftCode
forall (r :: * -> *). List r => SValue r -> SValue r -> SValue r
listAccess SValue SwiftCode
swiftContentsVal (Integer -> SValue SwiftCode
forall (r :: * -> *). Literal r => Integer -> SValue r
litInt Integer
li)) (Integer -> SValue SwiftCode
forall (r :: * -> *). Literal r => Integer -> SValue r
litInt Integer
wi))
  discardFileInput :: SValue SwiftCode -> MSStatement SwiftCode
discardFileInput SValue SwiftCode
_ = (MethodState -> MethodState) -> StateT MethodState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify MethodState -> MethodState
incrementWord StateT MethodState Identity ()
-> StateT MethodState Identity (SwiftCode (Doc, Terminator))
-> StateT MethodState Identity (SwiftCode (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
>> StateT MethodState Identity (SwiftCode (Doc, Terminator))
MSStatement SwiftCode
forall (r :: * -> *). StatementSym r => MSStatement r
emptyStmt

  openFileR :: SVariable SwiftCode -> SValue SwiftCode -> MSStatement SwiftCode
openFileR SVariable SwiftCode
v SValue SwiftCode
pth = do
    SwiftCode VarData
v' <- LensLike'
  (Zoomed (StateT ValueState Identity) (SwiftCode VarData))
  MethodState
  ValueState
-> StateT ValueState Identity (SwiftCode VarData)
-> StateT MethodState Identity (SwiftCode 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) (SwiftCode VarData))
  MethodState
  ValueState
(ValueState -> Focusing Identity (SwiftCode VarData) ValueState)
-> MethodState -> Focusing Identity (SwiftCode VarData) MethodState
Lens' MethodState ValueState
lensMStoVS StateT ValueState Identity (SwiftCode VarData)
SVariable SwiftCode
v
    ScopeData
scpData <- String -> MS ScopeData
getVarScope (String -> MS ScopeData) -> String -> MS ScopeData
forall a b. (a -> b) -> a -> b
$ SwiftCode (Variable SwiftCode) -> String
forall (r :: * -> *). VariableElim r => r (Variable r) -> String
variableName SwiftCode VarData
SwiftCode (Variable SwiftCode)
v'
    let scp :: SwiftCode (Scope SwiftCode)
scp = ScopeData -> SwiftCode (Scope SwiftCode)
forall (r :: * -> *). ScopeSym r => ScopeData -> r (Scope r)
convScope ScopeData
scpData
    [MSStatement SwiftCode] -> MSStatement SwiftCode
forall (r :: * -> *).
StatementSym r =>
[MSStatement r] -> MSStatement r
multi [(SValue SwiftCode -> VSType SwiftCode -> SValue SwiftCode)
-> SVariable SwiftCode -> SValue SwiftCode -> MSStatement SwiftCode
forall (r :: * -> *).
CommonRenderSym r =>
(SValue r -> VSType r -> SValue r)
-> SVariable r -> SValue r -> MSStatement r
CP.openFileR SValue SwiftCode -> VSType SwiftCode -> SValue SwiftCode
forall (r :: * -> *).
OORenderSym r =>
SValue r -> VSType r -> SValue r
swiftOpenFile SVariable SwiftCode
v SValue SwiftCode
pth,
      SVariable SwiftCode
-> SwiftCode (Scope SwiftCode) -> MSStatement SwiftCode
forall (r :: * -> *).
DeclStatement r =>
SVariable r -> r (Scope r) -> MSStatement r
varDec SVariable SwiftCode
swiftContentsVar SwiftCode (Scope SwiftCode)
scp, SVariable SwiftCode -> SValue SwiftCode -> MSStatement SwiftCode
forall (r :: * -> *).
OORenderSym r =>
SVariable r -> SValue r -> MSStatement r
swiftReadFile SVariable SwiftCode
swiftContentsVar (SVariable SwiftCode -> SValue SwiftCode
forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
valueOf SVariable SwiftCode
v)]
  openFileW :: SVariable SwiftCode -> SValue SwiftCode -> MSStatement SwiftCode
openFileW = Bool
-> SVariable SwiftCode -> SValue SwiftCode -> MSStatement SwiftCode
forall (r :: * -> *).
OORenderSym r =>
Bool -> SVariable r -> SValue r -> MSStatement r
swiftOpenFileWA Bool
False
  openFileA :: SVariable SwiftCode -> SValue SwiftCode -> MSStatement SwiftCode
openFileA = Bool
-> SVariable SwiftCode -> SValue SwiftCode -> MSStatement SwiftCode
forall (r :: * -> *).
OORenderSym r =>
Bool -> SVariable r -> SValue r -> MSStatement r
swiftOpenFileWA Bool
True
  closeFile :: SValue SwiftCode -> MSStatement SwiftCode
closeFile = SValue SwiftCode -> MSStatement SwiftCode
forall (r :: * -> *). OORenderSym r => SValue r -> MSStatement r
swiftCloseFile

  getFileInputLine :: SValue SwiftCode -> SVariable SwiftCode -> MSStatement SwiftCode
getFileInputLine SValue SwiftCode
_ SVariable SwiftCode
v = do
    SwiftCode VarData
v' <- LensLike'
  (Zoomed (StateT ValueState Identity) (SwiftCode VarData))
  MethodState
  ValueState
-> StateT ValueState Identity (SwiftCode VarData)
-> StateT MethodState Identity (SwiftCode 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) (SwiftCode VarData))
  MethodState
  ValueState
(ValueState -> Focusing Identity (SwiftCode VarData) ValueState)
-> MethodState -> Focusing Identity (SwiftCode VarData) MethodState
Lens' MethodState ValueState
lensMStoVS StateT ValueState Identity (SwiftCode VarData)
SVariable SwiftCode
v
    ScopeData
scpData <- String -> MS ScopeData
getVarScope (String -> MS ScopeData) -> String -> MS ScopeData
forall a b. (a -> b) -> a -> b
$ SwiftCode (Variable SwiftCode) -> String
forall (r :: * -> *). VariableElim r => r (Variable r) -> String
variableName SwiftCode VarData
SwiftCode (Variable SwiftCode)
v'
    let scp :: SwiftCode (Scope SwiftCode)
scp = ScopeData -> SwiftCode (Scope SwiftCode)
forall (r :: * -> *). ScopeSym r => ScopeData -> r (Scope r)
convScope ScopeData
scpData
    Integer
wi <- MS Integer
getWordIndex
    Integer
li <- MS Integer
getLineIndex
    (MethodState -> MethodState) -> StateT MethodState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify MethodState -> MethodState
incrementLine
    SwiftCode Doc
slc <- SVariable SwiftCode
-> SValue SwiftCode
-> Maybe (SValue SwiftCode)
-> Maybe (SValue SwiftCode)
-> Maybe (SValue SwiftCode)
-> MSBlock SwiftCode
forall (r :: * -> *).
InternalList r =>
SVariable r
-> SValue r
-> Maybe (SValue r)
-> Maybe (SValue r)
-> Maybe (SValue r)
-> MSBlock r
listSlice SVariable SwiftCode
swiftLineVar (SValue SwiftCode -> SValue SwiftCode -> SValue SwiftCode
forall (r :: * -> *). List r => SValue r -> SValue r -> SValue r
listAccess SValue SwiftCode
swiftContentsVal (Integer -> SValue SwiftCode
forall (r :: * -> *). Literal r => Integer -> SValue r
litInt Integer
li))
      (SValue SwiftCode -> Maybe (SValue SwiftCode)
forall a. a -> Maybe a
Just (SValue SwiftCode -> Maybe (SValue SwiftCode))
-> SValue SwiftCode -> Maybe (SValue SwiftCode)
forall a b. (a -> b) -> a -> b
$ Integer -> SValue SwiftCode
forall (r :: * -> *). Literal r => Integer -> SValue r
litInt Integer
wi) Maybe (StateT ValueState Identity (SwiftCode ValData))
Maybe (SValue SwiftCode)
forall a. Maybe a
Nothing Maybe (StateT ValueState Identity (SwiftCode ValData))
Maybe (SValue SwiftCode)
forall a. Maybe a
Nothing
    [MSStatement SwiftCode] -> MSStatement SwiftCode
forall (r :: * -> *).
StatementSym r =>
[MSStatement r] -> MSStatement r
multi [SVariable SwiftCode
-> SwiftCode (Scope SwiftCode) -> MSStatement SwiftCode
forall (r :: * -> *).
DeclStatement r =>
SVariable r -> r (Scope r) -> MSStatement r
varDec SVariable SwiftCode
swiftLineVar SwiftCode (Scope SwiftCode)
scp, Doc -> MSStatement SwiftCode
forall (r :: * -> *). CommonRenderSym r => Doc -> MSStatement r
mkStmtNoEnd (Doc -> MSStatement SwiftCode) -> Doc -> MSStatement SwiftCode
forall a b. (a -> b) -> a -> b
$ SwiftCode (Block SwiftCode) -> Doc
forall (r :: * -> *). BlockElim r => r (Block r) -> Doc
RC.block SwiftCode Doc
SwiftCode (Block SwiftCode)
slc,
      SVariable SwiftCode
v SVariable SwiftCode -> SValue SwiftCode -> MSStatement SwiftCode
forall (r :: * -> *).
AssignStatement r =>
SVariable r -> SValue r -> MSStatement r
&= Char -> SValue SwiftCode -> SValue SwiftCode
forall (r :: * -> *). OORenderSym r => Char -> SValue r -> SValue r
swiftJoinedFunc Char
' ' SValue SwiftCode
swiftLineVal]
  discardFileLine :: SValue SwiftCode -> MSStatement SwiftCode
discardFileLine SValue SwiftCode
_ = (MethodState -> MethodState) -> StateT MethodState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify MethodState -> MethodState
incrementLine StateT MethodState Identity ()
-> StateT MethodState Identity (SwiftCode (Doc, Terminator))
-> StateT MethodState Identity (SwiftCode (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
>> StateT MethodState Identity (SwiftCode (Doc, Terminator))
MSStatement SwiftCode
forall (r :: * -> *). StatementSym r => MSStatement r
emptyStmt
  getFileInputAll :: SValue SwiftCode -> SVariable SwiftCode -> MSStatement SwiftCode
getFileInputAll SValue SwiftCode
_ SVariable SwiftCode
v = do
    Integer
li <- MS Integer
getLineIndex
    let l :: SVariable SwiftCode
l = String -> VSType SwiftCode -> SVariable SwiftCode
forall (r :: * -> *).
VariableSym r =>
String -> VSType r -> SVariable r
var String
"l" (VSType SwiftCode -> VSType SwiftCode
forall (r :: * -> *). TypeSym r => VSType r -> VSType r
listType VSType SwiftCode
forall (r :: * -> *). TypeSym r => VSType r
string)
    SwiftCode Doc
slc <- SVariable SwiftCode
-> SValue SwiftCode
-> Maybe (SValue SwiftCode)
-> Maybe (SValue SwiftCode)
-> Maybe (SValue SwiftCode)
-> MSBlock SwiftCode
forall (r :: * -> *).
InternalList r =>
SVariable r
-> SValue r
-> Maybe (SValue r)
-> Maybe (SValue r)
-> Maybe (SValue r)
-> MSBlock r
listSlice SVariable SwiftCode
swiftContentsVar SValue SwiftCode
swiftContentsVal
      (SValue SwiftCode -> Maybe (SValue SwiftCode)
forall a. a -> Maybe a
Just (SValue SwiftCode -> Maybe (SValue SwiftCode))
-> SValue SwiftCode -> Maybe (SValue SwiftCode)
forall a b. (a -> b) -> a -> b
$ Integer -> SValue SwiftCode
forall (r :: * -> *). Literal r => Integer -> SValue r
litInt (Integer
liInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
1)) Maybe (StateT ValueState Identity (SwiftCode ValData))
Maybe (SValue SwiftCode)
forall a. Maybe a
Nothing Maybe (StateT ValueState Identity (SwiftCode ValData))
Maybe (SValue SwiftCode)
forall a. Maybe a
Nothing
    [MSStatement SwiftCode] -> MSStatement SwiftCode
forall (r :: * -> *).
StatementSym r =>
[MSStatement r] -> MSStatement r
multi [Doc -> MSStatement SwiftCode
forall (r :: * -> *). CommonRenderSym r => Doc -> MSStatement r
mkStmtNoEnd (Doc -> MSStatement SwiftCode) -> Doc -> MSStatement SwiftCode
forall a b. (a -> b) -> a -> b
$ SwiftCode (Block SwiftCode) -> Doc
forall (r :: * -> *). BlockElim r => r (Block r) -> Doc
RC.block SwiftCode Doc
SwiftCode (Block SwiftCode)
slc,
      SVariable SwiftCode
v SVariable SwiftCode -> SValue SwiftCode -> MSStatement SwiftCode
forall (r :: * -> *).
AssignStatement r =>
SVariable r -> SValue r -> MSStatement r
&= SValue SwiftCode -> SValue SwiftCode -> SValue SwiftCode
forall (r :: * -> *).
OORenderSym r =>
SValue r -> SValue r -> SValue r
swiftMapFunc SValue SwiftCode
swiftContentsVal
        ([SVariable SwiftCode] -> SValue SwiftCode -> SValue SwiftCode
forall (r :: * -> *).
ValueExpression r =>
[SVariable r] -> SValue r -> SValue r
lambda [SVariable SwiftCode
l] (Char -> SValue SwiftCode -> SValue SwiftCode
forall (r :: * -> *). OORenderSym r => Char -> SValue r -> SValue r
swiftJoinedFunc Char
' ' (SVariable SwiftCode -> SValue SwiftCode
forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
valueOf SVariable SwiftCode
l)))]

instance StringStatement SwiftCode where
  stringSplit :: Char
-> SVariable SwiftCode -> SValue SwiftCode -> MSStatement SwiftCode
stringSplit Char
d SVariable SwiftCode
vnew SValue SwiftCode
s = SVariable SwiftCode
vnew SVariable SwiftCode -> SValue SwiftCode -> MSStatement SwiftCode
forall (r :: * -> *).
AssignStatement r =>
SVariable r -> SValue r -> MSStatement r
&= Char -> SValue SwiftCode -> SValue SwiftCode
forall (r :: * -> *). OORenderSym r => Char -> SValue r -> SValue r
swiftSplitFunc Char
d SValue SwiftCode
s

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

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

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

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

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

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

  throw :: String -> MSStatement SwiftCode
throw String
msg = do
    (MethodState -> MethodState) -> StateT MethodState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify MethodState -> MethodState
setThrowUsed
    (SwiftCode (Value SwiftCode) -> Doc)
-> Terminator -> String -> MSStatement SwiftCode
forall (r :: * -> *).
CommonRenderSym r =>
(r (Value r) -> Doc) -> Terminator -> String -> MSStatement r
G.throw SwiftCode (Value SwiftCode) -> Doc
forall (r :: * -> *). CommonRenderSym r => r (Value r) -> Doc
swiftThrowDoc Terminator
Empty String
msg

  ifCond :: [(SValue SwiftCode, MSBody SwiftCode)]
-> MSBody SwiftCode -> MSStatement SwiftCode
ifCond = (Doc -> Doc)
-> Doc
-> OptionalSpace
-> Doc
-> Doc
-> Doc
-> [(SValue SwiftCode, MSBody SwiftCode)]
-> MSBody SwiftCode
-> MSStatement SwiftCode
forall (r :: * -> *).
CommonRenderSym r =>
(Doc -> Doc)
-> Doc
-> OptionalSpace
-> Doc
-> Doc
-> Doc
-> [(SValue r, MSBody r)]
-> MSBody r
-> MSStatement r
G.ifCond Doc -> Doc
forall a. a -> a
id Doc
bodyStart OptionalSpace
G.defaultOptSpace Doc
elseIfLabel Doc
bodyEnd Doc
empty
  switch :: SValue SwiftCode
-> [(SValue SwiftCode, MSBody SwiftCode)]
-> MSBody SwiftCode
-> MSStatement SwiftCode
switch = (Doc -> Doc)
-> MSStatement SwiftCode
-> SValue SwiftCode
-> [(SValue SwiftCode, MSBody SwiftCode)]
-> MSBody SwiftCode
-> MSStatement SwiftCode
forall (r :: * -> *).
CommonRenderSym r =>
(Doc -> Doc)
-> MSStatement r
-> SValue r
-> [(SValue r, MSBody r)]
-> MSBody r
-> MSStatement r
C.switch (Doc
space <>) MSStatement SwiftCode
forall (r :: * -> *). StatementSym r => MSStatement r
emptyStmt

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

  for :: MSStatement SwiftCode
-> SValue SwiftCode
-> MSStatement SwiftCode
-> MSBody SwiftCode
-> MSStatement SwiftCode
for MSStatement SwiftCode
_ SValue SwiftCode
_ MSStatement SwiftCode
_ MSBody SwiftCode
_ = String -> MSStatement SwiftCode
forall a. HasCallStack => String -> a
error (String -> MSStatement SwiftCode)
-> String -> MSStatement SwiftCode
forall a b. (a -> b) -> a -> b
$ String -> String
CP.forLoopError String
swiftName
  forRange :: SVariable SwiftCode
-> SValue SwiftCode
-> SValue SwiftCode
-> SValue SwiftCode
-> MSBody SwiftCode
-> MSStatement SwiftCode
forRange SVariable SwiftCode
i SValue SwiftCode
initv SValue SwiftCode
finalv SValue SwiftCode
stepv = SVariable SwiftCode
-> SValue SwiftCode -> MSBody SwiftCode -> MSStatement SwiftCode
forall (r :: * -> *).
ControlStatement r =>
SVariable r -> SValue r -> MSBody r -> MSStatement r
forEach SVariable SwiftCode
i (SValue SwiftCode
-> SValue SwiftCode -> SValue SwiftCode -> SValue SwiftCode
forall (r :: * -> *).
CommonRenderSym r =>
SValue r -> SValue r -> SValue r -> SValue r
swiftStrideFunc SValue SwiftCode
initv SValue SwiftCode
finalv SValue SwiftCode
stepv)
  forEach :: SVariable SwiftCode
-> SValue SwiftCode -> MSBody SwiftCode -> MSStatement SwiftCode
forEach = (SwiftCode (Variable SwiftCode)
 -> SwiftCode (Value SwiftCode)
 -> SwiftCode (Body SwiftCode)
 -> Doc)
-> SVariable SwiftCode
-> SValue SwiftCode
-> MSBody SwiftCode
-> MSStatement SwiftCode
forall (r :: * -> *).
CommonRenderSym r =>
(r (Variable r) -> r (Value r) -> r (Body r) -> Doc)
-> SVariable r -> SValue r -> MSBody r -> MSStatement r
CP.forEach' SwiftCode (Variable SwiftCode)
-> SwiftCode (Value SwiftCode) -> SwiftCode (Body SwiftCode) -> Doc
forall (r :: * -> *).
CommonRenderSym r =>
r (Variable r) -> r (Value r) -> r (Body r) -> Doc
swiftForEach
  while :: SValue SwiftCode -> MSBody SwiftCode -> MSStatement SwiftCode
while = (Doc -> Doc)
-> Doc
-> Doc
-> SValue SwiftCode
-> MSBody SwiftCode
-> MSStatement SwiftCode
forall (r :: * -> *).
CommonRenderSym r =>
(Doc -> Doc) -> Doc -> Doc -> SValue r -> MSBody r -> MSStatement r
C.while Doc -> Doc
forall a. a -> a
id Doc
bodyStart Doc
bodyEnd

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

  assert :: SValue SwiftCode -> SValue SwiftCode -> MSStatement SwiftCode
assert SValue SwiftCode
condition SValue SwiftCode
errorMessage = do
    SwiftCode ValData
cond <- LensLike'
  (Zoomed (StateT ValueState Identity) (SwiftCode ValData))
  MethodState
  ValueState
-> StateT ValueState Identity (SwiftCode ValData)
-> StateT MethodState Identity (SwiftCode 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) (SwiftCode ValData))
  MethodState
  ValueState
(ValueState -> Focusing Identity (SwiftCode ValData) ValueState)
-> MethodState -> Focusing Identity (SwiftCode ValData) MethodState
Lens' MethodState ValueState
lensMStoVS StateT ValueState Identity (SwiftCode ValData)
SValue SwiftCode
condition
    SwiftCode ValData
errMsg <- LensLike'
  (Zoomed (StateT ValueState Identity) (SwiftCode ValData))
  MethodState
  ValueState
-> StateT ValueState Identity (SwiftCode ValData)
-> StateT MethodState Identity (SwiftCode 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) (SwiftCode ValData))
  MethodState
  ValueState
(ValueState -> Focusing Identity (SwiftCode ValData) ValueState)
-> MethodState -> Focusing Identity (SwiftCode ValData) MethodState
Lens' MethodState ValueState
lensMStoVS StateT ValueState Identity (SwiftCode ValData)
SValue SwiftCode
errorMessage
    Doc -> MSStatement SwiftCode
forall (r :: * -> *). CommonRenderSym r => Doc -> MSStatement r
mkStmtNoEnd (SwiftCode (Value SwiftCode) -> SwiftCode (Value SwiftCode) -> Doc
forall (r :: * -> *).
CommonRenderSym r =>
r (Value r) -> r (Value r) -> Doc
swiftAssert SwiftCode ValData
SwiftCode (Value SwiftCode)
cond SwiftCode ValData
SwiftCode (Value SwiftCode)
errMsg)

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

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

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

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

instance VisibilityElim SwiftCode where
  visibility :: SwiftCode (Visibility SwiftCode) -> Doc
visibility = SwiftCode Doc -> Doc
SwiftCode (Visibility SwiftCode) -> Doc
forall a. SwiftCode a -> a
unSC

instance MethodTypeSym SwiftCode where
  type MethodType SwiftCode = TypeData
  mType :: VSType SwiftCode -> MSMthdType SwiftCode
mType = LensLike'
  (Zoomed (StateT ValueState Identity) (SwiftCode TypeData))
  MethodState
  ValueState
-> StateT ValueState Identity (SwiftCode TypeData)
-> StateT MethodState Identity (SwiftCode 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) (SwiftCode TypeData))
  MethodState
  ValueState
(ValueState -> Focusing Identity (SwiftCode TypeData) ValueState)
-> MethodState
-> Focusing Identity (SwiftCode TypeData) MethodState
Lens' MethodState ValueState
lensMStoVS

instance OOMethodTypeSym SwiftCode where
  construct :: String -> MSMthdType SwiftCode
construct = String -> MS (SwiftCode (Type SwiftCode))
String -> MSMthdType SwiftCode
forall (r :: * -> *).
CommonRenderSym r =>
String -> MS (r (Type r))
G.construct

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

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

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

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

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

  docInOutFunc :: String
-> SwiftCode (Visibility SwiftCode) -> DocInOutFunc SwiftCode
docInOutFunc String
n SwiftCode (Visibility SwiftCode)
s = FuncDocRenderer -> InOutFunc SwiftCode -> DocInOutFunc SwiftCode
forall (r :: * -> *).
CommonRenderSym r =>
FuncDocRenderer
-> ([SVariable r]
    -> [SVariable r] -> [SVariable r] -> MSBody r -> SMethod r)
-> String
-> [(String, SVariable r)]
-> [(String, SVariable r)]
-> [(String, SVariable r)]
-> MSBody r
-> SMethod r
CP.docInOutFunc' FuncDocRenderer
CP.functionDoc (String -> SwiftCode (Visibility SwiftCode) -> InOutFunc SwiftCode
forall (r :: * -> *).
MethodSym r =>
String -> r (Visibility r) -> InOutFunc r
inOutFunc String
n SwiftCode (Visibility SwiftCode)
s)

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

  inOutMethod :: String
-> SwiftCode (Visibility SwiftCode)
-> SwiftCode (Permanence SwiftCode)
-> InOutFunc SwiftCode
inOutMethod String
n SwiftCode (Visibility SwiftCode)
s SwiftCode (Permanence SwiftCode)
p = (VSType SwiftCode
 -> [MSParameter SwiftCode]
 -> MSBody SwiftCode
 -> SMethod SwiftCode)
-> InOutFunc SwiftCode
forall (r :: * -> *).
CommonRenderSym r =>
(VSType r -> [MSParameter r] -> MSBody r -> SMethod r)
-> [SVariable r]
-> [SVariable r]
-> [SVariable r]
-> MSBody r
-> SMethod r
CP.inOutFunc (String
-> SwiftCode (Visibility SwiftCode)
-> SwiftCode (Permanence SwiftCode)
-> VSType SwiftCode
-> [MSParameter SwiftCode]
-> MSBody SwiftCode
-> SMethod SwiftCode
forall (r :: * -> *).
OOMethodSym r =>
String
-> r (Visibility r)
-> r (Permanence r)
-> VSType r
-> [MSParameter r]
-> MSBody r
-> SMethod r
method String
n SwiftCode (Visibility SwiftCode)
s SwiftCode (Permanence SwiftCode)
p)
  docInOutMethod :: String
-> SwiftCode (Visibility SwiftCode)
-> SwiftCode (Permanence SwiftCode)
-> DocInOutFunc SwiftCode
docInOutMethod String
n SwiftCode (Visibility SwiftCode)
s SwiftCode (Permanence SwiftCode)
p = FuncDocRenderer -> InOutFunc SwiftCode -> DocInOutFunc SwiftCode
forall (r :: * -> *).
CommonRenderSym r =>
FuncDocRenderer
-> ([SVariable r]
    -> [SVariable r] -> [SVariable r] -> MSBody r -> SMethod r)
-> String
-> [(String, SVariable r)]
-> [(String, SVariable r)]
-> [(String, SVariable r)]
-> MSBody r
-> SMethod r
CP.docInOutFunc' FuncDocRenderer
CP.functionDoc (String
-> SwiftCode (Visibility SwiftCode)
-> SwiftCode (Permanence SwiftCode)
-> InOutFunc SwiftCode
forall (r :: * -> *).
OOMethodSym r =>
String -> r (Visibility r) -> r (Permanence r) -> InOutFunc r
inOutMethod String
n SwiftCode (Visibility SwiftCode)
s SwiftCode (Permanence SwiftCode)
p)

instance RenderMethod SwiftCode where
  commentedFunc :: MS (SwiftCode (BlockComment SwiftCode))
-> SMethod SwiftCode -> SMethod SwiftCode
commentedFunc MS (SwiftCode (BlockComment SwiftCode))
cmt SMethod SwiftCode
m = (SwiftCode MethodData
 -> SwiftCode (Doc -> Doc) -> SwiftCode MethodData)
-> State MethodState (SwiftCode MethodData)
-> State MethodState (SwiftCode (Doc -> Doc))
-> State MethodState (SwiftCode MethodData)
forall a b c s.
(a -> b -> c) -> State s a -> State s b -> State s c
on2StateValues ((MethodData -> (Doc -> Doc) -> MethodData)
-> SwiftCode MethodData
-> SwiftCode (Doc -> Doc)
-> SwiftCode MethodData
forall (r :: * -> *) a b c.
Applicative r =>
(a -> b -> c) -> r a -> r b -> r c
on2CodeValues MethodData -> (Doc -> Doc) -> MethodData
updateMthd) State MethodState (SwiftCode MethodData)
SMethod SwiftCode
m
    ((SwiftCode Doc -> SwiftCode (Doc -> Doc))
-> State MethodState (SwiftCode Doc)
-> State MethodState (SwiftCode (Doc -> Doc))
forall a b s. (a -> b) -> State s a -> State s b
onStateValue ((Doc -> Doc -> Doc) -> SwiftCode Doc -> SwiftCode (Doc -> Doc)
forall (r :: * -> *) a b. Functor r => (a -> b) -> r a -> r b
onCodeValue Doc -> Doc -> Doc
R.commentedItem) State MethodState (SwiftCode Doc)
MS (SwiftCode (BlockComment SwiftCode))
cmt)

  mthdFromData :: VisibilityTag -> Doc -> SMethod SwiftCode
mthdFromData VisibilityTag
_ Doc
d = SwiftCode (Method SwiftCode) -> SMethod SwiftCode
forall a s. a -> State s a
toState (SwiftCode (Method SwiftCode) -> SMethod SwiftCode)
-> SwiftCode (Method SwiftCode) -> SMethod SwiftCode
forall a b. (a -> b) -> a -> b
$ MethodData -> SwiftCode MethodData
forall (r :: * -> *) a. Monad r => a -> r a
toCode (MethodData -> SwiftCode MethodData)
-> MethodData -> SwiftCode MethodData
forall a b. (a -> b) -> a -> b
$ Doc -> MethodData
mthd Doc
d

instance OORenderMethod SwiftCode where
  intMethod :: Bool
-> String
-> SwiftCode (Visibility SwiftCode)
-> SwiftCode (Permanence SwiftCode)
-> MSMthdType SwiftCode
-> [MSParameter SwiftCode]
-> MSBody SwiftCode
-> SMethod SwiftCode
intMethod Bool
_ = String
-> SwiftCode (Visibility SwiftCode)
-> SwiftCode (Permanence SwiftCode)
-> MSMthdType SwiftCode
-> [MSParameter SwiftCode]
-> MSBody SwiftCode
-> SMethod SwiftCode
swiftMethod
  intFunc :: Bool
-> String
-> SwiftCode (Visibility SwiftCode)
-> SwiftCode (Permanence SwiftCode)
-> MSMthdType SwiftCode
-> [MSParameter SwiftCode]
-> MSBody SwiftCode
-> SMethod SwiftCode
intFunc Bool
_ String
n SwiftCode (Visibility SwiftCode)
s SwiftCode (Permanence SwiftCode)
_ = String
-> SwiftCode (Visibility SwiftCode)
-> SwiftCode (Permanence SwiftCode)
-> MSMthdType SwiftCode
-> [MSParameter SwiftCode]
-> MSBody SwiftCode
-> SMethod SwiftCode
swiftMethod String
n SwiftCode (Visibility SwiftCode)
s SwiftCode (Permanence SwiftCode)
forall (r :: * -> *). PermanenceSym r => r (Permanence r)
dynamic
  destructor :: [CSStateVar SwiftCode] -> SMethod SwiftCode
destructor [CSStateVar SwiftCode]
_ = String -> SMethod SwiftCode
forall a. HasCallStack => String -> a
error (String -> SMethod SwiftCode) -> String -> SMethod SwiftCode
forall a b. (a -> b) -> a -> b
$ String -> String
CP.destructorError String
swiftName

instance MethodElim SwiftCode where
  method :: SwiftCode (Method SwiftCode) -> Doc
method = MethodData -> Doc
mthdDoc (MethodData -> Doc)
-> (SwiftCode MethodData -> MethodData)
-> SwiftCode MethodData
-> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SwiftCode MethodData -> MethodData
forall a. SwiftCode a -> a
unSC

instance StateVarSym SwiftCode where
  type StateVar SwiftCode = Doc
  stateVar :: SwiftCode (Visibility SwiftCode)
-> SwiftCode (Permanence SwiftCode)
-> SVariable SwiftCode
-> CSStateVar SwiftCode
stateVar SwiftCode (Visibility SwiftCode)
s SwiftCode (Permanence SwiftCode)
p SVariable SwiftCode
vr = do
    SwiftCode VarData
v <- LensLike'
  (Zoomed (StateT ValueState Identity) (SwiftCode VarData))
  ClassState
  ValueState
-> StateT ValueState Identity (SwiftCode VarData)
-> StateT ClassState Identity (SwiftCode VarData)
forall c.
LensLike'
  (Zoomed (StateT ValueState Identity) c) ClassState ValueState
-> StateT ValueState Identity c -> StateT ClassState 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) (SwiftCode VarData))
  ClassState
  ValueState
(ValueState -> Focusing Identity (SwiftCode VarData) ValueState)
-> ClassState -> Focusing Identity (SwiftCode VarData) ClassState
Lens' ClassState ValueState
lensCStoVS StateT ValueState Identity (SwiftCode VarData)
SVariable SwiftCode
vr
    SwiftCode (Visibility SwiftCode)
-> SwiftCode (Permanence SwiftCode)
-> SVariable SwiftCode
-> SValue SwiftCode
-> CSStateVar SwiftCode
forall (r :: * -> *).
StateVarSym r =>
r (Visibility r)
-> r (Permanence r) -> SVariable r -> SValue r -> CSStateVar r
stateVarDef SwiftCode (Visibility SwiftCode)
s SwiftCode (Permanence SwiftCode)
p SVariable SwiftCode
vr (CodeType -> SValue SwiftCode
forall (r :: * -> *). OORenderSym r => CodeType -> SValue r
typeDfltVal (CodeType -> SValue SwiftCode) -> CodeType -> SValue SwiftCode
forall a b. (a -> b) -> a -> b
$ SwiftCode (Type SwiftCode) -> CodeType
forall (r :: * -> *). TypeElim r => r (Type r) -> CodeType
getType (SwiftCode (Type SwiftCode) -> CodeType)
-> SwiftCode (Type SwiftCode) -> CodeType
forall a b. (a -> b) -> a -> b
$ SwiftCode (Variable SwiftCode) -> SwiftCode (Type SwiftCode)
forall (r :: * -> *).
VariableElim r =>
r (Variable r) -> r (Type r)
variableType SwiftCode VarData
SwiftCode (Variable SwiftCode)
v)
  stateVarDef :: SwiftCode (Visibility SwiftCode)
-> SwiftCode (Permanence SwiftCode)
-> SVariable SwiftCode
-> SValue SwiftCode
-> CSStateVar SwiftCode
stateVarDef = SwiftCode (Visibility SwiftCode)
-> SwiftCode (Permanence SwiftCode)
-> SVariable SwiftCode
-> SValue SwiftCode
-> StateT ClassState Identity (SwiftCode Doc)
SwiftCode (Visibility SwiftCode)
-> SwiftCode (Permanence SwiftCode)
-> SVariable SwiftCode
-> SValue SwiftCode
-> CSStateVar SwiftCode
forall (r :: * -> *).
(OORenderSym r, Monad r) =>
r (Visibility r)
-> r (Permanence r) -> SVariable r -> SValue r -> CS (r Doc)
CP.stateVarDef
  constVar :: SwiftCode (Visibility SwiftCode)
-> SVariable SwiftCode -> SValue SwiftCode -> CSStateVar SwiftCode
constVar = Doc
-> SwiftCode (Visibility SwiftCode)
-> SVariable SwiftCode
-> SValue SwiftCode
-> StateT ClassState Identity (SwiftCode Doc)
forall (r :: * -> *).
(CommonRenderSym r, Monad r) =>
Doc -> r (Visibility r) -> SVariable r -> SValue r -> CS (r Doc)
CP.constVar (SwiftCode (Permanence SwiftCode) -> Doc
forall (r :: * -> *). PermElim r => r (Permanence r) -> Doc
RC.perm (SwiftCode (Permanence SwiftCode)
forall (r :: * -> *). PermanenceSym r => r (Permanence r)
static :: SwiftCode (Permanence SwiftCode)))

instance StateVarElim SwiftCode where
  stateVar :: SwiftCode (StateVar SwiftCode) -> Doc
stateVar = SwiftCode Doc -> Doc
SwiftCode (StateVar SwiftCode) -> Doc
forall a. SwiftCode a -> a
unSC

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

  docClass :: String -> SClass SwiftCode -> SClass SwiftCode
docClass = ClassDocRenderer -> String -> SClass SwiftCode -> SClass SwiftCode
forall (r :: * -> *).
OORenderSym r =>
ClassDocRenderer -> String -> SClass r -> SClass r
G.docClass ClassDocRenderer
swiftClassDoc

instance RenderClass SwiftCode where
  intClass :: String
-> SwiftCode (Visibility SwiftCode)
-> SwiftCode Doc
-> [CSStateVar SwiftCode]
-> [SMethod SwiftCode]
-> [SMethod SwiftCode]
-> SClass SwiftCode
intClass = (String -> Doc -> Doc -> Doc -> Doc -> Doc)
-> String
-> SwiftCode (Visibility SwiftCode)
-> SwiftCode Doc
-> [CSStateVar SwiftCode]
-> [SMethod SwiftCode]
-> [SMethod SwiftCode]
-> StateT ClassState Identity (SwiftCode 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 -> SwiftCode Doc
inherit = Maybe String -> SwiftCode Doc
forall (r :: * -> *). Monad r => Maybe String -> r Doc
CP.inherit
  implements :: [String] -> SwiftCode Doc
implements = [String] -> SwiftCode Doc
forall (r :: * -> *). Monad r => [String] -> r Doc
CP.implements

  commentedClass :: CS (SwiftCode (BlockComment SwiftCode))
-> SClass SwiftCode -> SClass SwiftCode
commentedClass = CS (SwiftCode (BlockComment SwiftCode))
-> SClass SwiftCode -> StateT ClassState Identity (SwiftCode Doc)
CS (SwiftCode (BlockComment SwiftCode))
-> SClass SwiftCode -> SClass SwiftCode
forall (r :: * -> *).
(OORenderSym r, Monad r) =>
CS (r (BlockComment r)) -> SClass r -> CS (r Doc)
G.commentedClass

instance ClassElim SwiftCode where
  class' :: SwiftCode (Class SwiftCode) -> Doc
class' = SwiftCode Doc -> Doc
SwiftCode (Class SwiftCode) -> Doc
forall a. SwiftCode a -> a
unSC

instance ModuleSym SwiftCode where
  type Module SwiftCode = ModData
  buildModule :: String
-> [String]
-> [SMethod SwiftCode]
-> [SClass SwiftCode]
-> FSModule SwiftCode
buildModule String
n [String]
is [SMethod SwiftCode]
fs [SClass SwiftCode]
cs = do
    (FileState -> FileState) -> StateT FileState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (String -> FileState -> FileState
setModuleName String
n) -- This needs to be set before the functions/
                             -- classes are evaluated. CP.buildModule will 
                             -- reset it to the proper name.
    [SwiftCode MethodData]
fns <- (State MethodState (SwiftCode MethodData)
 -> StateT FileState Identity (SwiftCode MethodData))
-> [State MethodState (SwiftCode MethodData)]
-> StateT FileState Identity [SwiftCode MethodData]
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 MethodState Identity) (SwiftCode MethodData))
  FileState
  MethodState
-> State MethodState (SwiftCode MethodData)
-> StateT FileState Identity (SwiftCode MethodData)
forall c.
LensLike'
  (Zoomed (StateT MethodState Identity) c) FileState MethodState
-> StateT MethodState Identity c -> StateT FileState 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) (SwiftCode MethodData))
  FileState
  MethodState
(MethodState
 -> Focusing Identity (SwiftCode MethodData) MethodState)
-> FileState -> Focusing Identity (SwiftCode MethodData) FileState
Lens' FileState MethodState
lensFStoMS) [State MethodState (SwiftCode MethodData)]
[SMethod SwiftCode]
fs
    [SwiftCode Doc]
cls <- (StateT ClassState Identity (SwiftCode Doc)
 -> State FileState (SwiftCode Doc))
-> [StateT ClassState Identity (SwiftCode Doc)]
-> StateT FileState Identity [SwiftCode Doc]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (LensLike'
  (Zoomed (StateT ClassState Identity) (SwiftCode Doc))
  FileState
  ClassState
-> StateT ClassState Identity (SwiftCode Doc)
-> State FileState (SwiftCode Doc)
forall c.
LensLike'
  (Zoomed (StateT ClassState Identity) c) FileState ClassState
-> StateT ClassState Identity c -> StateT FileState 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 ClassState Identity) (SwiftCode Doc))
  FileState
  ClassState
(ClassState -> Focusing Identity (SwiftCode Doc) ClassState)
-> FileState -> Focusing Identity (SwiftCode Doc) FileState
Lens' FileState ClassState
lensFStoCS) [StateT ClassState Identity (SwiftCode Doc)]
[SClass SwiftCode]
cs
    Bool
mn <- FS Bool
getCurrMain
    let modName :: String
modName = if Bool
mn then String
swiftMain else String
n
    String
-> FS Doc
-> FS Doc
-> FS Doc
-> [SMethod SwiftCode]
-> [SClass SwiftCode]
-> FSModule SwiftCode
forall (r :: * -> *).
OORenderSym r =>
String
-> FS Doc
-> FS Doc
-> FS Doc
-> [SMethod r]
-> [SClass r]
-> FSModule r
CP.buildModule String
modName (do
      [String]
lis <- FS [String]
getLangImports
      [String]
libis <- FS [String]
getLibImports
      Doc -> FS Doc
forall a. a -> StateT FileState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc -> FS Doc) -> Doc -> FS Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (SwiftCode (Import SwiftCode) -> Doc
forall (r :: * -> *). ImportElim r => r (Import r) -> Doc
RC.import' (SwiftCode (Import SwiftCode) -> Doc)
-> (String -> SwiftCode (Import SwiftCode)) -> String -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
          (String -> SwiftCode (Import SwiftCode)
forall (r :: * -> *). ImportSym r => String -> r (Import r)
langImport :: Label -> SwiftCode (Import SwiftCode)))
          ([String] -> [String]
forall a. Ord a => [a] -> [a]
sort ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [String]
lis [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
is [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
libis))
      (LensLike'
  (Zoomed (StateT MethodState Identity) Doc) FileState MethodState
-> StateT MethodState Identity Doc -> FS Doc
forall c.
LensLike'
  (Zoomed (StateT MethodState Identity) c) FileState MethodState
-> StateT MethodState Identity c -> StateT FileState 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) Doc) FileState MethodState
(MethodState -> Focusing Identity Doc MethodState)
-> FileState -> Focusing Identity Doc FileState
Lens' FileState MethodState
lensFStoMS StateT MethodState Identity Doc
swiftStringError) FS Doc
getMainDoc
        ((SwiftCode MethodData -> State MethodState (SwiftCode MethodData))
-> [SwiftCode MethodData]
-> [State MethodState (SwiftCode MethodData)]
forall a b. (a -> b) -> [a] -> [b]
map SwiftCode MethodData -> State MethodState (SwiftCode MethodData)
forall a. a -> StateT MethodState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [SwiftCode MethodData]
fns) ((SwiftCode Doc -> StateT ClassState Identity (SwiftCode Doc))
-> [SwiftCode Doc] -> [StateT ClassState Identity (SwiftCode Doc)]
forall a b. (a -> b) -> [a] -> [b]
map SwiftCode Doc -> StateT ClassState Identity (SwiftCode Doc)
forall a. a -> StateT ClassState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [SwiftCode Doc]
cls)

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

instance ModuleElim SwiftCode where
  module' :: SwiftCode (Module SwiftCode) -> Doc
module' = ModData -> Doc
modDoc (ModData -> Doc)
-> (SwiftCode ModData -> ModData) -> SwiftCode ModData -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SwiftCode ModData -> ModData
forall a. SwiftCode a -> a
unSC

instance BlockCommentSym SwiftCode where
  type BlockComment SwiftCode = Doc
  blockComment :: [String] -> SwiftCode (BlockComment SwiftCode)
blockComment [String]
lns = Doc -> SwiftCode Doc
forall (r :: * -> *) a. Monad r => a -> r a
toCode (Doc -> SwiftCode Doc) -> Doc -> SwiftCode 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 (SwiftCode (BlockComment SwiftCode))
docComment = ([String] -> SwiftCode Doc)
-> StateT a Identity [String] -> State a (SwiftCode Doc)
forall a b s. (a -> b) -> State s a -> State s b
onStateValue (\[String]
lns -> Doc -> SwiftCode Doc
forall (r :: * -> *) a. Monad r => a -> r a
toCode (Doc -> SwiftCode Doc) -> Doc -> SwiftCode Doc
forall a b. (a -> b) -> a -> b
$ [String] -> Doc -> Doc -> Doc
R.docCmt [String]
lns Doc
docCmtStart
    Doc
blockCmtEnd)

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

addMathImport :: VS a -> VS a
addMathImport :: forall a. VS a -> VS a
addMathImport = StateT ValueState Identity ()
-> StateT ValueState Identity a -> StateT ValueState Identity a
forall a b.
StateT ValueState Identity a
-> StateT ValueState Identity b -> StateT ValueState Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
(>>) (StateT ValueState Identity ()
 -> StateT ValueState Identity a -> StateT ValueState Identity a)
-> StateT ValueState Identity ()
-> StateT ValueState Identity a
-> StateT ValueState Identity a
forall a b. (a -> b) -> a -> b
$ (ValueState -> ValueState) -> StateT ValueState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (String -> ValueState -> ValueState
addLangImportVS String
swiftMath)

addFoundationImport :: VS a -> VS a
addFoundationImport :: forall a. VS a -> VS a
addFoundationImport = StateT ValueState Identity ()
-> StateT ValueState Identity a -> StateT ValueState Identity a
forall a b.
StateT ValueState Identity a
-> StateT ValueState Identity b -> StateT ValueState Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
(>>) (StateT ValueState Identity ()
 -> StateT ValueState Identity a -> StateT ValueState Identity a)
-> StateT ValueState Identity ()
-> StateT ValueState Identity a
-> StateT ValueState Identity a
forall a b. (a -> b) -> a -> b
$ (ValueState -> ValueState) -> StateT ValueState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (String -> ValueState -> ValueState
addLangImportVS String
swiftFoundation)

swiftName, swiftVersion :: String
swiftName :: String
swiftName = String
"Swift"
swiftVersion :: String
swiftVersion = String
"5.2.4"

swiftUnwrapVal :: (CommonRenderSym r) => SValue r -> SValue r
swiftUnwrapVal :: forall (r :: * -> *). CommonRenderSym r => SValue r -> SValue r
swiftUnwrapVal SValue r
v' = do
  r (Value r)
v <- SValue r
v'
  r (Type r) -> Doc -> SValue r
forall (r :: * -> *).
CommonRenderSym r =>
r (Type r) -> Doc -> SValue r
mkVal (r (Value r) -> r (Type r)
forall (r :: * -> *). ValueSym r => r (Value r) -> r (Type r)
valueType r (Value r)
v) (r (Value r) -> Doc
forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value r (Value r)
v Doc -> Doc -> Doc
<> Doc
swiftUnwrap')

swiftTryVal :: (CommonRenderSym r) => SValue r -> SValue r
swiftTryVal :: forall (r :: * -> *). CommonRenderSym r => SValue r -> SValue r
swiftTryVal SValue r
v' = do
  r (Value r)
v <- SValue r
v'
  r (Type r) -> Doc -> SValue r
forall (r :: * -> *).
CommonRenderSym r =>
r (Type r) -> Doc -> SValue r
mkVal (r (Value r) -> r (Type r)
forall (r :: * -> *). ValueSym r => r (Value r) -> r (Type r)
valueType r (Value r)
v) (Doc
tryLabel Doc -> Doc -> Doc
<+> r (Value r) -> Doc
forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value r (Value r)
v)

swiftArgVal :: (CommonRenderSym r) => SValue r -> SValue r
swiftArgVal :: forall (r :: * -> *). CommonRenderSym r => SValue r -> SValue r
swiftArgVal SValue r
v' = do
  r (Value r)
v <- SValue r
v'
  r (Type r) -> Doc -> SValue r
forall (r :: * -> *).
CommonRenderSym r =>
r (Type r) -> Doc -> SValue r
mkVal (r (Value r) -> r (Type r)
forall (r :: * -> *). ValueSym r => r (Value r) -> r (Type r)
valueType r (Value r)
v) (Doc
swiftInOutArg Doc -> Doc -> Doc
<> r (Value r) -> Doc
forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value r (Value r)
v)

-- Putting "gool" in these names to avoid name conflicts
-- The `local` is a hack, but Swift doesn't care about scope
-- and I don't want to change the IOStatement API just for this
swiftContentsVar, swiftLineVar :: SVariable SwiftCode
swiftContentsVar :: SVariable SwiftCode
swiftContentsVar = String -> VSType SwiftCode -> SVariable SwiftCode
forall (r :: * -> *).
VariableSym r =>
String -> VSType r -> SVariable r
var String
"goolContents" (VSType SwiftCode -> VSType SwiftCode
forall (r :: * -> *). TypeSym r => VSType r -> VSType r
listType (VSType SwiftCode -> VSType SwiftCode)
-> VSType SwiftCode -> VSType SwiftCode
forall a b. (a -> b) -> a -> b
$ VSType SwiftCode -> VSType SwiftCode
forall (r :: * -> *). TypeSym r => VSType r -> VSType r
listType VSType SwiftCode
forall (r :: * -> *). TypeSym r => VSType r
string)
swiftLineVar :: SVariable SwiftCode
swiftLineVar = String -> VSType SwiftCode -> SVariable SwiftCode
forall (r :: * -> *).
VariableSym r =>
String -> VSType r -> SVariable r
var String
"goolLine" (VSType SwiftCode -> VSType SwiftCode
forall (r :: * -> *). TypeSym r => VSType r -> VSType r
listType VSType SwiftCode
forall (r :: * -> *). TypeSym r => VSType r
string)

swiftContentsVal, swiftLineVal :: SValue SwiftCode
swiftContentsVal :: SValue SwiftCode
swiftContentsVal = SVariable SwiftCode -> SValue SwiftCode
forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
valueOf SVariable SwiftCode
swiftContentsVar
swiftLineVal :: SValue SwiftCode
swiftLineVal = SVariable SwiftCode -> SValue SwiftCode
forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
valueOf SVariable SwiftCode
swiftLineVar

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

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

swiftFileType :: (CommonRenderSym r) => VSType r
swiftFileType :: forall (r :: * -> *). CommonRenderSym r => VSType r
swiftFileType = VS (r (Type r)) -> VS (r (Type r))
forall a. VS a -> VS a
addFoundationImport (VS (r (Type r)) -> VS (r (Type r)))
-> VS (r (Type r)) -> VS (r (Type r))
forall a b. (a -> b) -> a -> b
$ CodeType -> String -> Doc -> VS (r (Type r))
forall (r :: * -> *).
RenderType r =>
CodeType -> String -> Doc -> VSType r
typeFromData CodeType
InFile String
swiftURL
  (String -> Doc
text String
swiftURL)

swiftFileHdlType :: (CommonRenderSym r) => VSType r
swiftFileHdlType :: forall (r :: * -> *). CommonRenderSym r => VSType r
swiftFileHdlType = VS (r (Type r)) -> VS (r (Type r))
forall a. VS a -> VS a
addFoundationImport (VS (r (Type r)) -> VS (r (Type r)))
-> VS (r (Type r)) -> VS (r (Type r))
forall a b. (a -> b) -> a -> b
$ CodeType -> String -> Doc -> VS (r (Type r))
forall (r :: * -> *).
RenderType r =>
CodeType -> String -> Doc -> VSType r
typeFromData CodeType
OutFile String
swiftFileHdl
  (String -> Doc
text String
swiftFileHdl)

swiftListType :: (CommonRenderSym r) => VSType r -> VSType r
swiftListType :: forall (r :: * -> *). CommonRenderSym r => VSType r -> VSType r
swiftListType VSType r
t' = do
  r (Type r)
t <- VSType r
t'
  CodeType -> String -> Doc -> VSType r
forall (r :: * -> *).
RenderType r =>
CodeType -> String -> Doc -> VSType r
typeFromData (CodeType -> CodeType
List (CodeType -> CodeType) -> CodeType -> CodeType
forall a b. (a -> b) -> a -> b
$ r (Type r) -> CodeType
forall (r :: * -> *). TypeElim r => r (Type r) -> CodeType
getType r (Type r)
t) (String
"[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ r (Type r) -> String
forall (r :: * -> *). TypeElim r => r (Type r) -> String
getTypeString r (Type r)
t String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]")
    (Doc -> Doc
brackets (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ r (Type r) -> Doc
forall (r :: * -> *). InternalTypeElim r => r (Type r) -> Doc
RC.type' r (Type r)
t)


swiftFuncType :: (CommonRenderSym r) => [VSType r] -> VSType r -> VSType r
swiftFuncType :: forall (r :: * -> *).
CommonRenderSym r =>
[VSType r] -> VSType r -> VSType r
swiftFuncType [VSType r]
ps VSType r
r = do
  [r (Type r)]
pts <- [VSType r] -> StateT ValueState Identity [r (Type r)]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [VSType r]
ps
  r (Type r)
rt <- VSType r
r
  CodeType -> String -> Doc -> VSType r
forall (r :: * -> *).
RenderType r =>
CodeType -> String -> Doc -> VSType r
typeFromData ([CodeType] -> CodeType -> CodeType
Func ((r (Type r) -> CodeType) -> [r (Type r)] -> [CodeType]
forall a b. (a -> b) -> [a] -> [b]
map r (Type r) -> CodeType
forall (r :: * -> *). TypeElim r => r (Type r) -> CodeType
getType [r (Type r)]
pts) (r (Type r) -> CodeType
forall (r :: * -> *). TypeElim r => r (Type r) -> CodeType
getType r (Type r)
rt))
    (String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
listSep ((r (Type r) -> String) -> [r (Type r)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map r (Type r) -> String
forall (r :: * -> *). TypeElim r => r (Type r) -> String
getTypeString [r (Type r)]
pts) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++
      String
swiftRetType String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ r (Type r) -> String
forall (r :: * -> *). TypeElim r => r (Type r) -> String
getTypeString r (Type r)
rt)
    (Doc -> Doc
parens (Doc -> [Doc] -> Doc
hicat Doc
listSep' ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (r (Type r) -> Doc) -> [r (Type r)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map r (Type r) -> Doc
forall (r :: * -> *). InternalTypeElim r => r (Type r) -> Doc
RC.type' [r (Type r)]
pts) Doc -> Doc -> Doc
<+> Doc
swiftRetType' Doc -> Doc -> Doc
<+>
      r (Type r) -> Doc
forall (r :: * -> *). InternalTypeElim r => r (Type r) -> Doc
RC.type' r (Type r)
rt)

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

swiftPi, swiftListSize, swiftFirst, swiftDesc, swiftUTF8, swiftVar, swiftConst,
  swiftDo, swiftFunc, swiftCtorName, swiftExtension, swiftInOut, swiftError,
  swiftDocDir, swiftUserMask, swiftInOutArg, swiftNamedArgSep, swiftTypeSpec,
  swiftConforms, swiftNoLabel, swiftRetType', swiftUnwrap' :: Doc
swiftPi :: Doc
swiftPi = String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ String
CP.doubleRender String -> String -> String
`access` String
piLabel
swiftListSize :: Doc
swiftListSize = String -> Doc
text String
"count"
swiftFirst :: Doc
swiftFirst = String -> Doc
text String
"first"
swiftDesc :: Doc
swiftDesc = String -> Doc
text String
"description"
swiftUTF8 :: Doc
swiftUTF8 = String -> Doc
text String
"utf8"
swiftVar :: Doc
swiftVar = String -> Doc
text String
"var"
swiftConst :: Doc
swiftConst = String -> Doc
text String
"let"
swiftDo :: Doc
swiftDo = String -> Doc
text String
"do"
swiftFunc :: Doc
swiftFunc = String -> Doc
text String
"func"
swiftCtorName :: Doc
swiftCtorName = String -> Doc
text String
"init"
swiftExtension :: Doc
swiftExtension = String -> Doc
text String
"extension"
swiftInOut :: Doc
swiftInOut = String -> Doc
text String
"inout"
swiftError :: Doc
swiftError = String -> Doc
text String
"Error"
swiftDocDir :: Doc
swiftDocDir = String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ String
"" String -> String -> String
`access` String
"documentDirectory"
swiftUserMask :: Doc
swiftUserMask = String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ String
"" String -> String -> String
`access` String
"userDomainMask"
swiftNamedArgSep :: Doc
swiftNamedArgSep = Doc
colon Doc -> Doc -> Doc
<> Doc
space
swiftInOutArg :: Doc
swiftInOutArg = String -> Doc
text String
"&"
swiftTypeSpec :: Doc
swiftTypeSpec = Doc
colon
swiftConforms :: Doc
swiftConforms = Doc
colon
swiftNoLabel :: Doc
swiftNoLabel = String -> Doc
text String
"_"
swiftRetType' :: Doc
swiftRetType' = String -> Doc
text String
swiftRetType
swiftUnwrap' :: Doc
swiftUnwrap' = String -> Doc
text String
swiftUnwrap

swiftMain, swiftFoundation, swiftMath, swiftNil, swiftInt, swiftChar,
  swiftURL, swiftFileHdl, swiftRetType, swiftVoid, swiftCommLine,
  swiftSearchDir, swiftPathMask, swiftArgs, swiftWrite, swiftIndex,
  swiftStride, swiftMap, swiftListAdd, swiftListRemove, swiftListAppend, swiftReadLine,
  swiftSeekEnd, swiftClose, swiftJoined, swiftAppendPath, swiftUrls, swiftSplit,
  swiftData, swiftEncoding, swiftOf, swiftFrom, swiftTo, swiftBy, swiftAt,
  swiftTerm, swiftFor, swiftIn, swiftContentsOf, swiftWriteTo, swiftSep,
  swiftSepBy, swiftUnwrap, swiftContains, swiftSet, swiftUnion :: String
swiftMain :: String
swiftMain = String
"main"
swiftFoundation :: String
swiftFoundation = String
"Foundation"
swiftMath :: String
swiftMath = String
swiftFoundation
swiftNil :: String
swiftNil = String
"nil"
swiftInt :: String
swiftInt = String
"Int"
swiftChar :: String
swiftChar = String
"Character"
swiftURL :: String
swiftURL = String
"URL"
swiftFileHdl :: String
swiftFileHdl = String
"FileHandle"
swiftRetType :: String
swiftRetType = String
"->"
swiftVoid :: String
swiftVoid = String
"Void"
swiftCommLine :: String
swiftCommLine = String
"CommandLine"
swiftSearchDir :: String
swiftSearchDir = String
"SearchPathDirectory"
swiftPathMask :: String
swiftPathMask = String
"SearchPathDomainMask"
swiftArgs :: String
swiftArgs = String
"arguments"
swiftWrite :: String
swiftWrite = String
"write"
swiftIndex :: String
swiftIndex = String
"firstIndex"
swiftStride :: String
swiftStride = String
"stride"
swiftMap :: String
swiftMap = String
"map"
swiftListAdd :: String
swiftListAdd = String
"insert"
swiftListRemove :: String
swiftListRemove = String
"remove"
swiftListAppend :: String
swiftListAppend = String
"append"
swiftReadLine :: String
swiftReadLine = String
"readLine"
swiftSeekEnd :: String
swiftSeekEnd = String
"seekToEnd"
swiftClose :: String
swiftClose = String
"close"
swiftJoined :: String
swiftJoined = String
"joined"
swiftAppendPath :: String
swiftAppendPath = String
"appendingPathComponent"
swiftUrls :: String
swiftUrls = String
"FileManager" String -> String -> String
`access` String
"default" String -> String -> String
`access` String
"urls"
swiftSplit :: String
swiftSplit = String
"components"
swiftData :: String
swiftData = String
"Data"
swiftEncoding :: String
swiftEncoding = String
"Encoding"
swiftOf :: String
swiftOf = String
"of"
swiftFrom :: String
swiftFrom = String
"from"
swiftTo :: String
swiftTo = String
"to"
swiftBy :: String
swiftBy = String
"by"
swiftAt :: String
swiftAt = String
"at"
swiftTerm :: String
swiftTerm = String
"terminator"
swiftFor :: String
swiftFor = String
"for"
swiftIn :: String
swiftIn = String
"in"
swiftContentsOf :: String
swiftContentsOf = String
"contentsOf"
swiftWriteTo :: String
swiftWriteTo = String
"forWritingTo"
swiftSep :: String
swiftSep = String
"separator"
swiftSepBy :: String
swiftSepBy = String
"separatedBy"
swiftUnwrap :: String
swiftUnwrap = String
"!"
swiftContains :: String
swiftContains = String
"contains"
swiftSet :: String
swiftSet = String
"Set"
swiftUnion :: String
swiftUnion = String
"union"

swiftUnaryMath :: (Monad r) => String -> VSOp r
swiftUnaryMath :: forall (r :: * -> *). Monad r => String -> VSOp r
swiftUnaryMath = VS (r OpData) -> VS (r OpData)
forall a. VS a -> VS a
addMathImport (VS (r OpData) -> VS (r OpData))
-> (String -> VS (r OpData)) -> String -> VS (r OpData)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> VS (r OpData)
forall (r :: * -> *). Monad r => String -> VSOp r
unOpPrec

swiftNumBinExpr :: (CommonRenderSym r) => (SValue r -> SValue r -> SValue r) ->
  SValue r -> SValue r -> SValue r
swiftNumBinExpr :: forall (r :: * -> *).
CommonRenderSym r =>
(SValue r -> SValue r -> SValue r)
-> SValue r -> SValue r -> SValue r
swiftNumBinExpr SValue r -> SValue r -> SValue r
f SValue r
v1' SValue r
v2' = do
  r (Value r)
v1 <- SValue r
v1'
  r (Value r)
v2 <- SValue r
v2'
  let exprT :: CodeType -> CodeType -> SValue r
exprT CodeType
t1 CodeType
t2 = if CodeType
t1 CodeType -> CodeType -> Bool
forall a. Eq a => a -> a -> Bool
== CodeType
t2 then SValue r -> SValue r -> SValue r
f (r (Value r) -> SValue r
forall a. a -> StateT ValueState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure r (Value r)
v1) (r (Value r) -> SValue r
forall a. a -> StateT ValueState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure r (Value r)
v2) else CodeType -> CodeType -> SValue r
exprT' CodeType
t1 CodeType
t2
      exprT' :: CodeType -> CodeType -> SValue r
exprT' CodeType
Double CodeType
_ = SValue r -> SValue r -> SValue r
f (r (Value r) -> SValue r
forall a. a -> StateT ValueState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure r (Value r)
v1) (VSType r -> SValue r -> SValue r
forall (r :: * -> *).
RenderValue r =>
VSType r -> SValue r -> SValue r
cast VSType r
forall (r :: * -> *). TypeSym r => VSType r
double (SValue r -> SValue r) -> SValue r -> SValue r
forall a b. (a -> b) -> a -> b
$ r (Value r) -> SValue r
forall a. a -> StateT ValueState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure r (Value r)
v2)
      exprT' CodeType
_ CodeType
Double = SValue r -> SValue r -> SValue r
f (VSType r -> SValue r -> SValue r
forall (r :: * -> *).
RenderValue r =>
VSType r -> SValue r -> SValue r
cast VSType r
forall (r :: * -> *). TypeSym r => VSType r
double (SValue r -> SValue r) -> SValue r -> SValue r
forall a b. (a -> b) -> a -> b
$ r (Value r) -> SValue r
forall a. a -> StateT ValueState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure r (Value r)
v1) (r (Value r) -> SValue r
forall a. a -> StateT ValueState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure r (Value r)
v2)
      exprT' CodeType
Float CodeType
_  = SValue r -> SValue r -> SValue r
f (r (Value r) -> SValue r
forall a. a -> StateT ValueState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure r (Value r)
v1) (VSType r -> SValue r -> SValue r
forall (r :: * -> *).
RenderValue r =>
VSType r -> SValue r -> SValue r
cast VSType r
forall (r :: * -> *). TypeSym r => VSType r
float (SValue r -> SValue r) -> SValue r -> SValue r
forall a b. (a -> b) -> a -> b
$ r (Value r) -> SValue r
forall a. a -> StateT ValueState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure r (Value r)
v2)
      exprT' CodeType
_ CodeType
Float  = SValue r -> SValue r -> SValue r
f (VSType r -> SValue r -> SValue r
forall (r :: * -> *).
RenderValue r =>
VSType r -> SValue r -> SValue r
cast VSType r
forall (r :: * -> *). TypeSym r => VSType r
float (SValue r -> SValue r) -> SValue r -> SValue r
forall a b. (a -> b) -> a -> b
$ r (Value r) -> SValue r
forall a. a -> StateT ValueState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure r (Value r)
v1) (r (Value r) -> SValue r
forall a. a -> StateT ValueState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure r (Value r)
v2)
      exprT' CodeType
_ CodeType
_      = SValue r -> SValue r -> SValue r
f (r (Value r) -> SValue r
forall a. a -> StateT ValueState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure r (Value r)
v1) (r (Value r) -> SValue r
forall a. a -> StateT ValueState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure r (Value r)
v2)
  CodeType -> CodeType -> SValue r
exprT (r (Type r) -> CodeType
forall (r :: * -> *). TypeElim r => r (Type r) -> CodeType
getType (r (Type r) -> CodeType) -> r (Type r) -> CodeType
forall a b. (a -> b) -> a -> b
$ r (Value r) -> r (Type r)
forall (r :: * -> *). ValueSym r => r (Value r) -> r (Type r)
valueType r (Value r)
v1) (r (Type r) -> CodeType
forall (r :: * -> *). TypeElim r => r (Type r) -> CodeType
getType (r (Type r) -> CodeType) -> r (Type r) -> CodeType
forall a b. (a -> b) -> a -> b
$ r (Value r) -> r (Type r)
forall (r :: * -> *). ValueSym r => r (Value r) -> r (Type r)
valueType r (Value r)
v2)

swiftLitFloat :: (CommonRenderSym r) => Float -> SValue r
swiftLitFloat :: forall (r :: * -> *). CommonRenderSym r => Float -> SValue r
swiftLitFloat = VSType r -> Doc -> VS (r (Value r))
forall (r :: * -> *).
CommonRenderSym r =>
VSType r -> Doc -> SValue r
mkStateVal VSType r
forall (r :: * -> *). TypeSym r => VSType r
float (Doc -> VS (r (Value r)))
-> (Float -> Doc) -> Float -> VS (r (Value r))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Doc
D.float

swiftLambda :: (CommonRenderSym r) => [r (Variable r)] -> r (Value r) -> Doc
swiftLambda :: forall (r :: * -> *).
CommonRenderSym r =>
[r (Variable r)] -> r (Value r) -> Doc
swiftLambda [r (Variable r)]
ps r (Value r)
ex = Doc -> Doc
braces (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> Doc
parens (Doc -> [Doc] -> Doc
hicat Doc
listSep'
  ((Doc -> Doc -> Doc) -> [Doc] -> [Doc] -> [Doc]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Doc
n Doc
t -> Doc
n Doc -> Doc -> Doc
<> Doc
swiftTypeSpec Doc -> Doc -> Doc
<+> Doc
t)
    ((r (Variable r) -> Doc) -> [r (Variable r)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map r (Variable r) -> Doc
forall (r :: * -> *). InternalVarElim r => r (Variable r) -> Doc
RC.variable [r (Variable r)]
ps)
    ((r (Variable r) -> Doc) -> [r (Variable r)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (r (Type r) -> Doc
forall (r :: * -> *). InternalTypeElim r => r (Type r) -> Doc
RC.type' (r (Type r) -> Doc)
-> (r (Variable r) -> r (Type r)) -> r (Variable r) -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r (Variable r) -> r (Type r)
forall (r :: * -> *).
VariableElim r =>
r (Variable r) -> r (Type r)
variableType) [r (Variable r)]
ps)))
  Doc -> Doc -> Doc
<+> Doc
swiftRetType' Doc -> Doc -> Doc
<+> r (Type r) -> Doc
forall (r :: * -> *). InternalTypeElim r => r (Type r) -> Doc
RC.type' (r (Value r) -> r (Type r)
forall (r :: * -> *). ValueSym r => r (Value r) -> r (Type r)
valueType r (Value r)
ex) Doc -> Doc -> Doc
<+> Doc
inLabel Doc -> Doc -> Doc
<+> r (Value r) -> Doc
forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value r (Value r)
ex

swiftReadableTypes :: [CodeType]
swiftReadableTypes :: [CodeType]
swiftReadableTypes = [CodeType
Integer, CodeType
Double, CodeType
Float, CodeType
Boolean, CodeType
Char]

swiftCast :: (CommonRenderSym r) => VSType r -> SValue r -> SValue r
swiftCast :: forall (r :: * -> *).
CommonRenderSym r =>
VSType r -> SValue r -> SValue r
swiftCast VSType r
t' SValue r
v' = do
  r (Type r)
t <- VSType r
t'
  r (Value r)
v <- SValue r
v'
  let unwrap :: SValue r -> SValue r
unwrap = if r (Type r) -> CodeType
forall (r :: * -> *). TypeElim r => r (Type r) -> CodeType
getType r (Type r)
t CodeType -> [CodeType] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CodeType]
swiftReadableTypes Bool -> Bool -> Bool
&&
        r (Type r) -> CodeType
forall (r :: * -> *). TypeElim r => r (Type r) -> CodeType
getType (r (Value r) -> r (Type r)
forall (r :: * -> *). ValueSym r => r (Value r) -> r (Type r)
valueType r (Value r)
v) CodeType -> CodeType -> Bool
forall a. Eq a => a -> a -> Bool
== CodeType
String then SValue r -> SValue r
forall (r :: * -> *). CommonRenderSym r => SValue r -> SValue r
swiftUnwrapVal else SValue r -> SValue r
forall a. a -> a
id
  SValue r -> SValue r
unwrap (SValue r -> SValue r) -> SValue r -> SValue r
forall a b. (a -> b) -> a -> b
$ VSType r -> Doc -> SValue r
forall (r :: * -> *).
CommonRenderSym r =>
VSType r -> Doc -> SValue r
mkStateVal (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) (Doc -> Doc -> Doc
R.castObj (r (Type r) -> Doc
forall (r :: * -> *). InternalTypeElim r => r (Type r) -> Doc
RC.type' r (Type r)
t) (r (Value r) -> Doc
forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value r (Value r)
v))

swiftIndexFunc :: (OORenderSym r) => SValue r -> SValue r -> SValue r
swiftIndexFunc :: forall (r :: * -> *).
OORenderSym r =>
SValue r -> SValue r -> SValue r
swiftIndexFunc SValue r
l SValue r
v' = do
  r (Value r)
v <- SValue r
v'
  let t :: StateT ValueState Identity (r (Type r))
t = r (Type r) -> StateT ValueState Identity (r (Type r))
forall a. a -> StateT ValueState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (r (Type r) -> StateT ValueState Identity (r (Type r)))
-> r (Type r) -> StateT ValueState Identity (r (Type r))
forall a b. (a -> b) -> a -> b
$ r (Value r) -> r (Type r)
forall (r :: * -> *). ValueSym r => r (Value r) -> r (Type r)
valueType r (Value r)
v
      ofArg :: SVariable r
ofArg = String -> StateT ValueState Identity (r (Type r)) -> SVariable r
forall (r :: * -> *).
VariableSym r =>
String -> VSType r -> SVariable r
var String
swiftOf StateT ValueState Identity (r (Type r))
t
  StateT ValueState Identity (r (Type r))
-> SValue r -> String -> NamedArgs r -> SValue r
forall (r :: * -> *).
InternalValueExp r =>
VSType r -> SValue r -> String -> NamedArgs r -> SValue r
objMethodCallNamedArgs StateT ValueState Identity (r (Type r))
forall (r :: * -> *). TypeSym r => VSType r
int SValue r
l String
swiftIndex [(SVariable r
ofArg, r (Value r) -> SValue r
forall a. a -> StateT ValueState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure r (Value r)
v)]

swiftStrideFunc :: (CommonRenderSym r) => SValue r -> SValue r -> SValue r
  -> SValue r
swiftStrideFunc :: forall (r :: * -> *).
CommonRenderSym r =>
SValue r -> SValue r -> SValue r -> SValue r
swiftStrideFunc SValue r
beg SValue r
end SValue r
step = let t :: VSType r
t = VSType r -> VSType r
forall (r :: * -> *). TypeSym r => VSType r -> VSType r
listType VSType r
forall (r :: * -> *). TypeSym r => VSType r
int
                                   fromArg :: SVariable r
fromArg = String -> VSType r -> SVariable r
forall (r :: * -> *).
VariableSym r =>
String -> VSType r -> SVariable r
var String
swiftFrom VSType r
forall (r :: * -> *). TypeSym r => VSType r
int
                                   toArg :: SVariable r
toArg = String -> VSType r -> SVariable r
forall (r :: * -> *).
VariableSym r =>
String -> VSType r -> SVariable r
var String
swiftTo VSType r
forall (r :: * -> *). TypeSym r => VSType r
int
                                   byArg :: SVariable r
byArg = String -> VSType r -> SVariable r
forall (r :: * -> *).
VariableSym r =>
String -> VSType r -> SVariable r
var String
swiftBy VSType r
forall (r :: * -> *). TypeSym r => VSType r
int
  in VSType r -> SValue r -> SValue r
forall (r :: * -> *).
RenderValue r =>
VSType r -> SValue r -> SValue r
cast VSType r
t (String -> VSType r -> NamedArgs r -> SValue r
forall (r :: * -> *).
ValueExpression r =>
String -> VSType r -> NamedArgs r -> SValue r
funcAppNamedArgs String
swiftStride VSType r
t
    [(SVariable r
fromArg, SValue r
beg), (SVariable r
toArg, SValue r
end), (SVariable r
byArg, SValue r
step)])

swiftMapFunc :: (OORenderSym r) => SValue r -> SValue r -> SValue r
swiftMapFunc :: forall (r :: * -> *).
OORenderSym r =>
SValue r -> SValue r -> SValue r
swiftMapFunc SValue r
lst SValue r
f = VSType r -> SValue r -> String -> [SValue r] -> SValue r
forall (r :: * -> *).
InternalValueExp r =>
VSType r -> SValue r -> String -> [SValue r] -> SValue r
objMethodCall ((r (Value r) -> r (Type r)) -> SValue r -> VSType r
forall a b s. (a -> b) -> State s a -> State s b
onStateValue r (Value r) -> r (Type r)
forall (r :: * -> *). ValueSym r => r (Value r) -> r (Type r)
valueType SValue r
lst) SValue r
lst String
swiftMap [SValue r
f]

swiftListAddFunc :: (CommonRenderSym r) => SValue r -> SValue r -> SValue r
swiftListAddFunc :: forall (r :: * -> *).
CommonRenderSym r =>
SValue r -> SValue r -> SValue r
swiftListAddFunc SValue r
i SValue r
v = let atArg :: SVariable r
atArg = String -> VSType r -> SVariable r
forall (r :: * -> *).
VariableSym r =>
String -> VSType r -> SVariable r
var String
swiftAt VSType r
forall (r :: * -> *). TypeSym r => VSType r
int
  in MixedCall r
forall (r :: * -> *). ValueExpression r => MixedCall r
funcAppMixedArgs String
swiftListAdd (VSType r -> VSType r
forall (r :: * -> *). TypeSym r => VSType r -> VSType r
listType (VSType r -> VSType r) -> VSType r -> VSType r
forall a b. (a -> b) -> a -> b
$ (r (Value r) -> r (Type r)) -> SValue r -> VSType r
forall a b s. (a -> b) -> State s a -> State s b
onStateValue r (Value r) -> r (Type r)
forall (r :: * -> *). ValueSym r => r (Value r) -> r (Type r)
valueType SValue r
v)
    [SValue r
v] [(SVariable r
atArg, SValue r
i)]

swiftWriteFunc :: (OORenderSym r) => SValue r -> SValue r -> SValue r
swiftWriteFunc :: forall (r :: * -> *).
OORenderSym r =>
SValue r -> SValue r -> SValue r
swiftWriteFunc SValue r
v SValue r
f = let contentsArg :: SVariable r
contentsArg = String -> VSType r -> SVariable r
forall (r :: * -> *).
VariableSym r =>
String -> VSType r -> SVariable r
var String
swiftContentsOf (String -> VSType r
forall (r :: * -> *). OOTypeSym r => String -> VSType r
obj String
swiftData)
  in SValue r -> SValue r
forall (r :: * -> *). CommonRenderSym r => SValue r -> SValue r
swiftTryVal (SValue r -> SValue r) -> SValue r -> SValue r
forall a b. (a -> b) -> a -> b
$ VSType r -> SValue r -> String -> NamedArgs r -> SValue r
forall (r :: * -> *).
InternalValueExp r =>
VSType r -> SValue r -> String -> NamedArgs r -> SValue r
objMethodCallNamedArgs VSType r
forall (r :: * -> *). TypeSym r => VSType r
void SValue r
f String
swiftWrite
    [(SVariable r
contentsArg, PosCtorCall r
forall (r :: * -> *). OOValueExpression r => PosCtorCall r
newObj (String -> VSType r
forall (r :: * -> *). OOTypeSym r => String -> VSType r
obj String
swiftData) [SValue r
v SValue r -> VSFunction r -> SValue r
forall (r :: * -> *).
OOFunctionSym r =>
SValue r -> VSFunction r -> SValue r
$. Doc -> VSType r -> VSFunction r
forall (r :: * -> *).
RenderFunction r =>
Doc -> VSType r -> VSFunction r
funcFromData (Doc -> Doc
R.func Doc
swiftUTF8)
    (String -> VSType r
forall (r :: * -> *). OOTypeSym r => String -> VSType r
obj String
swiftEncoding)])]

swiftReadLineFunc :: (CommonRenderSym r) => SValue r
swiftReadLineFunc :: forall (r :: * -> *). CommonRenderSym r => SValue r
swiftReadLineFunc = SValue r -> SValue r
forall (r :: * -> *). CommonRenderSym r => SValue r -> SValue r
swiftUnwrapVal (SValue r -> SValue r) -> SValue r -> SValue r
forall a b. (a -> b) -> a -> b
$ PosCall r
forall (r :: * -> *). ValueExpression r => PosCall r
funcApp String
swiftReadLine VSType r
forall (r :: * -> *). TypeSym r => VSType r
string []

swiftReadFileFunc :: (CommonRenderSym r) => SValue r -> SValue r
swiftReadFileFunc :: forall (r :: * -> *). CommonRenderSym r => SValue r -> SValue r
swiftReadFileFunc SValue r
v = let contentsArg :: SVariable r
contentsArg = String -> VSType r -> SVariable r
forall (r :: * -> *).
VariableSym r =>
String -> VSType r -> SVariable r
var String
swiftContentsOf VSType r
forall (r :: * -> *). TypeSym r => VSType r
infile
  in SValue r -> SValue r
forall (r :: * -> *). CommonRenderSym r => SValue r -> SValue r
swiftTryVal (SValue r -> SValue r) -> SValue r -> SValue r
forall a b. (a -> b) -> a -> b
$ String -> VSType r -> NamedArgs r -> SValue r
forall (r :: * -> *).
ValueExpression r =>
String -> VSType r -> NamedArgs r -> SValue r
funcAppNamedArgs String
CP.stringRender' VSType r
forall (r :: * -> *). TypeSym r => VSType r
string [(SVariable r
contentsArg, SValue r
v)]

swiftSplitFunc :: (OORenderSym r) => Char -> SValue r -> SValue r
swiftSplitFunc :: forall (r :: * -> *). OORenderSym r => Char -> SValue r -> SValue r
swiftSplitFunc Char
d SValue r
s = let sepArg :: SVariable r
sepArg = String -> VSType r -> SVariable r
forall (r :: * -> *).
VariableSym r =>
String -> VSType r -> SVariable r
var String
swiftSepBy VSType r
forall (r :: * -> *). TypeSym r => VSType r
char
  in VSType r -> SValue r -> String -> NamedArgs r -> SValue r
forall (r :: * -> *).
InternalValueExp r =>
VSType r -> SValue r -> String -> NamedArgs r -> SValue r
objMethodCallNamedArgs (VSType r -> VSType r
forall (r :: * -> *). TypeSym r => VSType r -> VSType r
listType VSType r
forall (r :: * -> *). TypeSym r => VSType r
string) SValue r
s String
swiftSplit [(SVariable r
sepArg, Char -> SValue r
forall (r :: * -> *). Literal r => Char -> SValue r
litChar Char
d)]

swiftJoinedFunc :: (OORenderSym r) => Char -> SValue r -> SValue r
swiftJoinedFunc :: forall (r :: * -> *). OORenderSym r => Char -> SValue r -> SValue r
swiftJoinedFunc Char
d SValue r
s = let sepArg :: SVariable r
sepArg = String -> VSType r -> SVariable r
forall (r :: * -> *).
VariableSym r =>
String -> VSType r -> SVariable r
var String
swiftSep VSType r
forall (r :: * -> *). TypeSym r => VSType r
char
  in VSType r -> SValue r -> String -> NamedArgs r -> SValue r
forall (r :: * -> *).
InternalValueExp r =>
VSType r -> SValue r -> String -> NamedArgs r -> SValue r
objMethodCallNamedArgs VSType r
forall (r :: * -> *). TypeSym r => VSType r
string SValue r
s String
swiftJoined [(SVariable r
sepArg, Char -> SValue r
forall (r :: * -> *). Literal r => Char -> SValue r
litChar Char
d)]

swiftIndexOf :: (OORenderSym r) => SValue r -> SValue r -> SValue r
swiftIndexOf :: forall (r :: * -> *).
OORenderSym r =>
SValue r -> SValue r -> SValue r
swiftIndexOf = VS (r (Value r)) -> VS (r (Value r))
forall (r :: * -> *). CommonRenderSym r => SValue r -> SValue r
swiftUnwrapVal (VS (r (Value r)) -> VS (r (Value r)))
-> (VS (r (Value r)) -> VS (r (Value r)) -> VS (r (Value r)))
-> VS (r (Value r))
-> VS (r (Value r))
-> VS (r (Value r))
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: VS (r (Value r)) -> VS (r (Value r)) -> VS (r (Value r))
forall (r :: * -> *).
OORenderSym r =>
SValue r -> SValue r -> SValue r
swiftIndexFunc

-- | Swift's syntactic sugar for list slicing.
swiftListSlice :: (OORenderSym r) => SVariable r -> SValue r ->
  Maybe (SValue r) -> Maybe (SValue r) -> SValue r -> MSBlock r
swiftListSlice :: forall (r :: * -> *).
OORenderSym r =>
SVariable r
-> SValue r
-> Maybe (SValue r)
-> Maybe (SValue r)
-> SValue r
-> MSBlock r
swiftListSlice SVariable r
vn SValue r
vo Maybe (SValue r)
beg Maybe (SValue r)
end SValue r
step = do

  r (Variable r)
vnew <- 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
vn
  ScopeData
scpData <- String -> MS ScopeData
getVarScope (String -> MS ScopeData) -> String -> MS ScopeData
forall a b. (a -> b) -> a -> b
$ r (Variable r) -> String
forall (r :: * -> *). VariableElim r => r (Variable r) -> String
variableName r (Variable r)
vnew
  let scp :: r (Scope r)
scp = ScopeData -> r (Scope r)
forall (r :: * -> *). ScopeSym r => ScopeData -> r (Scope r)
convScope ScopeData
scpData

  r (Value r)
stepV <- 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
step
  let mbStepV :: Maybe Integer
mbStepV = r (Value r) -> Maybe Integer
forall (r :: * -> *). ValueElim r => r (Value r) -> Maybe Integer
valueInt r (Value r)
stepV

  -- Generate fresh variable names if required
  String
begName <- Bool -> String -> MS String
genVarNameIf (Maybe (SValue r) -> Bool
forall a. Maybe a -> Bool
isNothing Maybe (SValue r)
beg Bool -> Bool -> Bool
&& Maybe Integer -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Integer
mbStepV) String
"begIdx"
  String
endName <- Bool -> String -> MS String
genVarNameIf (Maybe (SValue r) -> Bool
forall a. Maybe a -> Bool
isNothing Maybe (SValue r)
end Bool -> Bool -> Bool
&& Maybe Integer -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Integer
mbStepV) String
"endIdx"

  let (MSStatement r
setBeg, SValue r
begVal) = String
-> SValue r
-> Maybe Integer
-> Maybe (SValue r)
-> SValue r
-> SValue r
-> r (Scope r)
-> (MSStatement r, SValue r)
forall (r :: * -> *).
CommonRenderSym r =>
String
-> SValue r
-> Maybe Integer
-> Maybe (SValue r)
-> SValue r
-> SValue r
-> r (Scope r)
-> (MSStatement r, SValue r)
M.makeSetterVal String
begName SValue r
step Maybe Integer
mbStepV Maybe (SValue r)
beg (Integer -> SValue r
forall (r :: * -> *). Literal r => Integer -> SValue r
litInt Integer
0)    (SValue r -> SValue r
forall (r :: * -> *). List r => SValue r -> SValue r
listSize SValue r
vo SValue r -> SValue r -> SValue r
forall (r :: * -> *).
NumericExpression r =>
SValue r -> SValue r -> SValue r
#- Integer -> SValue r
forall (r :: * -> *). Literal r => Integer -> SValue r
litInt Integer
1) r (Scope r)
scp
      (MSStatement r
setEnd, SValue r
endVal) = String
-> SValue r
-> Maybe Integer
-> Maybe (SValue r)
-> SValue r
-> SValue r
-> r (Scope r)
-> (MSStatement r, SValue r)
forall (r :: * -> *).
CommonRenderSym r =>
String
-> SValue r
-> Maybe Integer
-> Maybe (SValue r)
-> SValue r
-> SValue r
-> r (Scope r)
-> (MSStatement r, SValue r)
M.makeSetterVal String
endName SValue r
step Maybe Integer
mbStepV Maybe (SValue r)
end (SValue r -> SValue r
forall (r :: * -> *). List r => SValue r -> SValue r
listSize SValue r
vo) (Integer -> SValue r
forall (r :: * -> *). Literal r => Integer -> SValue r
litInt (-Integer
1)) r (Scope r)
scp

      i :: SVariable r
i = String -> VSType r -> SVariable r
forall (r :: * -> *).
VariableSym r =>
String -> VSType r -> SVariable r
var String
"i" VSType r
forall (r :: * -> *). TypeSym r => VSType r
int
      setToSlice :: MSStatement r
setToSlice = SVariable r
vn SVariable r -> SValue r -> MSStatement r
forall (r :: * -> *).
AssignStatement r =>
SVariable r -> SValue r -> MSStatement r
&= SValue r -> SValue r -> SValue r
forall (r :: * -> *).
OORenderSym r =>
SValue r -> SValue r -> SValue r
swiftMapFunc (SValue r -> SValue r -> SValue r -> SValue r
forall (r :: * -> *).
CommonRenderSym r =>
SValue r -> SValue r -> SValue r -> SValue r
swiftStrideFunc SValue r
begVal SValue r
endVal SValue r
step) ([SVariable r] -> SValue r -> SValue r
forall (r :: * -> *).
ValueExpression r =>
[SVariable r] -> SValue r -> SValue r
lambda [SVariable r
i] (SValue r -> SValue r -> SValue r
forall (r :: * -> *). List r => SValue r -> SValue r -> SValue r
listAccess SValue r
vo (SVariable r -> SValue r
forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
valueOf SVariable r
i)))
  [MSStatement r] -> MSBlock r
forall (r :: * -> *). BlockSym r => [MSStatement r] -> MSBlock r
block [
      MSStatement r
setBeg,
      MSStatement r
setEnd,
      MSStatement r
setToSlice
    ]

swiftPrint :: Bool -> Maybe (SValue SwiftCode) -> SValue SwiftCode ->
  SValue SwiftCode -> MSStatement SwiftCode
swiftPrint :: Bool
-> Maybe (SValue SwiftCode)
-> SValue SwiftCode
-> SValue SwiftCode
-> MSStatement SwiftCode
swiftPrint Bool
newLn Maybe (SValue SwiftCode)
Nothing SValue SwiftCode
_ SValue SwiftCode
v = do
  let s :: SValue SwiftCode
s = String -> SValue SwiftCode
forall (r :: * -> *). Literal r => String -> SValue r
litString String
"" :: SValue SwiftCode
      nl :: [(SVariable SwiftCode,
  StateT ValueState Identity (SwiftCode ValData))]
nl = [(String -> VSType SwiftCode -> SVariable SwiftCode
forall (r :: * -> *).
VariableSym r =>
String -> VSType r -> SVariable r
var String
swiftTerm VSType SwiftCode
forall (r :: * -> *). TypeSym r => VSType r
string, StateT ValueState Identity (SwiftCode ValData)
s) | Bool -> Bool
not Bool
newLn]
  SValue SwiftCode -> MSStatement SwiftCode
forall (r :: * -> *). StatementSym r => SValue r -> MSStatement r
valStmt (SValue SwiftCode -> MSStatement SwiftCode)
-> SValue SwiftCode -> MSStatement SwiftCode
forall a b. (a -> b) -> a -> b
$ MixedCall SwiftCode
forall (r :: * -> *). ValueExpression r => MixedCall r
funcAppMixedArgs String
printLabel VSType SwiftCode
forall (r :: * -> *). TypeSym r => VSType r
void [SValue SwiftCode
v] [(SVariable SwiftCode,
  StateT ValueState Identity (SwiftCode ValData))]
NamedArgs SwiftCode
nl
swiftPrint Bool
newLn (Just SValue SwiftCode
f) SValue SwiftCode
_ SValue SwiftCode
v' = do
  SwiftCode ValData
v <- LensLike'
  (Zoomed (StateT ValueState Identity) (SwiftCode ValData))
  MethodState
  ValueState
-> StateT ValueState Identity (SwiftCode ValData)
-> StateT MethodState Identity (SwiftCode 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) (SwiftCode ValData))
  MethodState
  ValueState
(ValueState -> Focusing Identity (SwiftCode ValData) ValueState)
-> MethodState -> Focusing Identity (SwiftCode ValData) MethodState
Lens' MethodState ValueState
lensMStoVS StateT ValueState Identity (SwiftCode ValData)
SValue SwiftCode
v'
  let valToPrint :: CodeType -> SValue SwiftCode
valToPrint (List CodeType
_) = SwiftCode ValData -> StateT ValueState Identity (SwiftCode ValData)
forall a. a -> StateT ValueState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SwiftCode ValData
v SValue SwiftCode -> VSFunction SwiftCode -> SValue SwiftCode
forall (r :: * -> *).
OOFunctionSym r =>
SValue r -> VSFunction r -> SValue r
$. Doc -> VSType SwiftCode -> VSFunction SwiftCode
forall (r :: * -> *).
RenderFunction r =>
Doc -> VSType r -> VSFunction r
funcFromData (Doc -> Doc
R.func Doc
swiftDesc) VSType SwiftCode
forall (r :: * -> *). TypeSym r => VSType r
string
      valToPrint CodeType
String = SwiftCode ValData -> StateT ValueState Identity (SwiftCode ValData)
forall a. a -> StateT ValueState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SwiftCode ValData
v
      valToPrint CodeType
_ = VSType SwiftCode -> SValue SwiftCode -> SValue SwiftCode
forall (r :: * -> *).
RenderValue r =>
VSType r -> SValue r -> SValue r
cast VSType SwiftCode
forall (r :: * -> *). TypeSym r => VSType r
string (SwiftCode ValData -> StateT ValueState Identity (SwiftCode ValData)
forall a. a -> StateT ValueState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SwiftCode ValData
v)
      prNewLn :: MSStatement SwiftCode
prNewLn = if Bool
newLn then SValue SwiftCode -> MSStatement SwiftCode
forall (r :: * -> *). StatementSym r => SValue r -> MSStatement r
valStmt (SValue SwiftCode -> SValue SwiftCode -> SValue SwiftCode
forall (r :: * -> *).
OORenderSym r =>
SValue r -> SValue r -> SValue r
swiftWriteFunc (String -> SValue SwiftCode
forall (r :: * -> *). Literal r => String -> SValue r
litString String
"\\n") SValue SwiftCode
f)
        else MSStatement SwiftCode
forall (r :: * -> *). StatementSym r => MSStatement r
emptyStmt
  MSBody SwiftCode -> MSBody SwiftCode -> MSStatement SwiftCode
forall (r :: * -> *).
ControlStatement r =>
MSBody r -> MSBody r -> MSStatement r
tryCatch ([MSStatement SwiftCode] -> MSBody SwiftCode
forall (r :: * -> *). BodySym r => [MSStatement r] -> MSBody r
bodyStatements
    [SValue SwiftCode -> MSStatement SwiftCode
forall (r :: * -> *). StatementSym r => SValue r -> MSStatement r
valStmt (SValue SwiftCode -> MSStatement SwiftCode)
-> SValue SwiftCode -> MSStatement SwiftCode
forall a b. (a -> b) -> a -> b
$ SValue SwiftCode -> SValue SwiftCode -> SValue SwiftCode
forall (r :: * -> *).
OORenderSym r =>
SValue r -> SValue r -> SValue r
swiftWriteFunc (CodeType -> SValue SwiftCode
valToPrint (CodeType -> SValue SwiftCode) -> CodeType -> SValue SwiftCode
forall a b. (a -> b) -> a -> b
$ SwiftCode (Type SwiftCode) -> CodeType
forall (r :: * -> *). TypeElim r => r (Type r) -> CodeType
getType (SwiftCode (Type SwiftCode) -> CodeType)
-> SwiftCode (Type SwiftCode) -> CodeType
forall a b. (a -> b) -> a -> b
$ SwiftCode (Value SwiftCode) -> SwiftCode (Type SwiftCode)
forall (r :: * -> *). ValueSym r => r (Value r) -> r (Type r)
valueType SwiftCode ValData
SwiftCode (Value SwiftCode)
v) SValue SwiftCode
f, MSStatement SwiftCode
prNewLn])
    (MSStatement SwiftCode -> MSBody SwiftCode
forall (r :: * -> *). BodySym r => MSStatement r -> MSBody r
oneLiner (MSStatement SwiftCode -> MSBody SwiftCode)
-> MSStatement SwiftCode -> MSBody SwiftCode
forall a b. (a -> b) -> a -> b
$ String -> MSStatement SwiftCode
forall (r :: * -> *). ControlStatement r => String -> MSStatement r
throw String
"Error printing to file.")

-- swiftPrint can handle lists, so don't use G.print for lists.
swiftOut :: (CommonRenderSym r) => Bool -> Maybe (SValue r) -> SValue r -> SValue r
  -> MSStatement r
swiftOut :: forall (r :: * -> *).
CommonRenderSym r =>
Bool -> Maybe (SValue r) -> SValue r -> SValue r -> MSStatement r
swiftOut 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))
swOut (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 swOut :: CodeType -> StateT MethodState Identity (r (Statement r))
swOut (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
        swOut 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

swiftInput :: SVariable SwiftCode -> SValue SwiftCode -> SValue SwiftCode
swiftInput :: SVariable SwiftCode -> SValue SwiftCode -> SValue SwiftCode
swiftInput SVariable SwiftCode
vr SValue SwiftCode
vl = do
  SwiftCode VarData
vr' <- StateT ValueState Identity (SwiftCode VarData)
SVariable SwiftCode
vr
  let swiftInput' :: CodeType -> SValue SwiftCode
swiftInput' CodeType
String = SValue SwiftCode
vl
      swiftInput' CodeType
ct
        | CodeType
ct CodeType -> [CodeType] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CodeType]
swiftReadableTypes = VSType SwiftCode -> SValue SwiftCode -> SValue SwiftCode
forall (r :: * -> *).
RenderValue r =>
VSType r -> SValue r -> SValue r
cast (SwiftCode (Type SwiftCode) -> VSType SwiftCode
forall a. a -> StateT ValueState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SwiftCode (Type SwiftCode) -> VSType SwiftCode)
-> SwiftCode (Type SwiftCode) -> VSType SwiftCode
forall a b. (a -> b) -> a -> b
$ SwiftCode (Variable SwiftCode) -> SwiftCode (Type SwiftCode)
forall (r :: * -> *).
VariableElim r =>
r (Variable r) -> r (Type r)
variableType SwiftCode VarData
SwiftCode (Variable SwiftCode)
vr') SValue SwiftCode
vl
        | Bool
otherwise = String -> StateT ValueState Identity (SwiftCode ValData)
forall a. HasCallStack => String -> a
error String
"Attempt to read value of unreadable type"
  CodeType -> SValue SwiftCode
swiftInput' (SwiftCode (Type SwiftCode) -> CodeType
forall (r :: * -> *). TypeElim r => r (Type r) -> CodeType
getType (SwiftCode (Type SwiftCode) -> CodeType)
-> SwiftCode (Type SwiftCode) -> CodeType
forall a b. (a -> b) -> a -> b
$ SwiftCode (Variable SwiftCode) -> SwiftCode (Type SwiftCode)
forall (r :: * -> *).
VariableElim r =>
r (Variable r) -> r (Type r)
variableType SwiftCode VarData
SwiftCode (Variable SwiftCode)
vr')

swiftOpenFile :: (OORenderSym r) => SValue r -> VSType r -> SValue r
swiftOpenFile :: forall (r :: * -> *).
OORenderSym r =>
SValue r -> VSType r -> SValue r
swiftOpenFile SValue r
n VSType r
t = let forArg :: SVariable r
forArg = String -> VSType r -> SVariable r
forall (r :: * -> *).
VariableSym r =>
String -> VSType r -> SVariable r
var String
swiftFor (String -> VSType r
forall (r :: * -> *). OOTypeSym r => String -> VSType r
obj String
swiftSearchDir)
                        dirVal :: SValue r
dirVal = VSType r -> Doc -> SValue r
forall (r :: * -> *).
CommonRenderSym r =>
VSType r -> Doc -> SValue r
mkStateVal (String -> VSType r
forall (r :: * -> *). OOTypeSym r => String -> VSType r
obj String
swiftSearchDir) Doc
swiftDocDir
                        inArg :: SVariable r
inArg = String -> VSType r -> SVariable r
forall (r :: * -> *).
VariableSym r =>
String -> VSType r -> SVariable r
var String
swiftIn (String -> VSType r
forall (r :: * -> *). OOTypeSym r => String -> VSType r
obj String
swiftPathMask)
                        maskVal :: SValue r
maskVal = VSType r -> Doc -> SValue r
forall (r :: * -> *).
CommonRenderSym r =>
VSType r -> Doc -> SValue r
mkStateVal (String -> VSType r
forall (r :: * -> *). OOTypeSym r => String -> VSType r
obj String
swiftPathMask) Doc
swiftUserMask
  in VSType r -> SValue r -> String -> [SValue r] -> SValue r
forall (r :: * -> *).
InternalValueExp r =>
VSType r -> SValue r -> String -> [SValue r] -> SValue r
objMethodCall VSType r
t (SValue r -> SValue r
forall (r :: * -> *). CommonRenderSym r => SValue r -> SValue r
swiftUnwrapVal (SValue r -> SValue r) -> SValue r -> SValue r
forall a b. (a -> b) -> a -> b
$
    String -> VSType r -> NamedArgs r -> SValue r
forall (r :: * -> *).
ValueExpression r =>
String -> VSType r -> NamedArgs r -> SValue r
funcAppNamedArgs String
swiftUrls (VSType r -> VSType r
forall (r :: * -> *). TypeSym r => VSType r -> VSType r
listType VSType r
t) [(SVariable r
forArg, SValue r
dirVal), (SVariable r
inArg, SValue r
maskVal)]
    SValue r -> VSFunction r -> SValue r
forall (r :: * -> *).
OOFunctionSym r =>
SValue r -> VSFunction r -> SValue r
$. Doc -> VSType r -> VSFunction r
forall (r :: * -> *).
RenderFunction r =>
Doc -> VSType r -> VSFunction r
funcFromData (Doc -> Doc
R.func Doc
swiftFirst) VSType r
t) String
swiftAppendPath [SValue r
n]

swiftOpenFileHdl :: (OORenderSym r) => SValue r -> VSType r -> SValue r
swiftOpenFileHdl :: forall (r :: * -> *).
OORenderSym r =>
SValue r -> VSType r -> SValue r
swiftOpenFileHdl SValue r
n VSType r
t = let forWritingArg :: SVariable r
forWritingArg = String -> VSType r -> SVariable r
forall (r :: * -> *).
VariableSym r =>
String -> VSType r -> SVariable r
var String
swiftWriteTo VSType r
forall (r :: * -> *). CommonRenderSym r => VSType r
swiftFileType
  in SValue r -> SValue r
forall (r :: * -> *). CommonRenderSym r => SValue r -> SValue r
swiftTryVal (SValue r -> SValue r) -> SValue r -> SValue r
forall a b. (a -> b) -> a -> b
$ String -> VSType r -> NamedArgs r -> SValue r
forall (r :: * -> *).
ValueExpression r =>
String -> VSType r -> NamedArgs r -> SValue r
funcAppNamedArgs String
swiftFileHdl VSType r
forall (r :: * -> *). TypeSym r => VSType r
outfile
    [(SVariable r
forWritingArg, SValue r -> VSType r -> SValue r
forall (r :: * -> *).
OORenderSym r =>
SValue r -> VSType r -> SValue r
swiftOpenFile SValue r
n VSType r
t)]

swiftOpenFileWA :: (OORenderSym r) => Bool -> SVariable r -> SValue r ->
  MSStatement r
swiftOpenFileWA :: forall (r :: * -> *).
OORenderSym r =>
Bool -> SVariable r -> SValue r -> MSStatement r
swiftOpenFileWA Bool
app SVariable r
f' SValue r
n' = MSBody r
-> MSBody r -> StateT MethodState Identity (r (Statement r))
forall (r :: * -> *).
ControlStatement r =>
MSBody r -> MSBody r -> MSStatement r
tryCatch
    ([StateT MethodState Identity (r (Statement r))] -> MSBody r
forall (r :: * -> *). BodySym r => [MSStatement r] -> MSBody r
bodyStatements [(SValue r -> VSType r -> SValue r -> SValue r)
-> SVariable r
-> SValue r
-> StateT MethodState Identity (r (Statement r))
forall (r :: * -> *).
CommonRenderSym r =>
(SValue r -> VSType r -> SValue r -> SValue r)
-> SVariable r -> SValue r -> MSStatement r
CP.openFileW (\SValue r
f VSType r
n SValue r
_ -> SValue r -> VSType r -> SValue r
forall (r :: * -> *).
OORenderSym r =>
SValue r -> VSType r -> SValue r
swiftOpenFileHdl SValue r
f VSType r
n) SVariable r
f' SValue r
n',
      if Bool
app
        then SValue r -> StateT MethodState Identity (r (Statement r))
forall (r :: * -> *). StatementSym r => SValue r -> MSStatement r
valStmt (SValue r -> StateT MethodState Identity (r (Statement r)))
-> SValue r -> StateT MethodState Identity (r (Statement r))
forall a b. (a -> b) -> a -> b
$ SValue r -> SValue r
forall (r :: * -> *). CommonRenderSym r => SValue r -> SValue r
swiftTryVal (SValue r -> SValue r) -> SValue r -> SValue r
forall a b. (a -> b) -> a -> b
$ VSType r -> SValue r -> String -> SValue r
forall (r :: * -> *).
InternalValueExp r =>
VSType r -> SValue r -> String -> SValue r
objMethodCallNoParams VSType r
forall (r :: * -> *). TypeSym r => VSType r
void (SVariable r -> SValue r
forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
valueOf SVariable r
f')
          String
swiftSeekEnd
        else StateT MethodState Identity (r (Statement r))
forall (r :: * -> *). StatementSym r => MSStatement r
emptyStmt])
    -- It's important for the catch case to throw, or else the swift compiler
    -- will have no guarantees that the file variable has been initialized.
    (StateT MethodState Identity (r (Statement r)) -> MSBody r
forall (r :: * -> *). BodySym r => MSStatement r -> MSBody r
oneLiner (StateT MethodState Identity (r (Statement r)) -> MSBody r)
-> StateT MethodState Identity (r (Statement r)) -> MSBody r
forall a b. (a -> b) -> a -> b
$ String -> StateT MethodState Identity (r (Statement r))
forall (r :: * -> *). ControlStatement r => String -> MSStatement r
throw String
"Error opening file.")

swiftCloseFile :: (OORenderSym r) => SValue r -> MSStatement r
swiftCloseFile :: forall (r :: * -> *). OORenderSym r => SValue r -> MSStatement r
swiftCloseFile SValue r
f' = do
  r (Value r)
f <- 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
f'
  -- How I've currently implemented file-reading, files don't need to be 
  -- "closed", so InFile case is (correctly) just an empty stmt
  let swClose :: CodeType -> MSStatement r
swClose CodeType
InFile = (MethodState -> MethodState) -> StateT MethodState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify MethodState -> MethodState
resetIndices StateT MethodState Identity () -> MSStatement r -> MSStatement r
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 r
forall (r :: * -> *). StatementSym r => MSStatement r
emptyStmt
      swClose CodeType
OutFile = MSBody r -> MSBody r -> MSStatement r
forall (r :: * -> *).
ControlStatement r =>
MSBody r -> MSBody r -> MSStatement r
tryCatch (MSStatement r -> MSBody r
forall (r :: * -> *). BodySym r => MSStatement r -> MSBody r
oneLiner (MSStatement r -> MSBody r) -> MSStatement r -> MSBody r
forall a b. (a -> b) -> a -> b
$ SValue r -> MSStatement r
forall (r :: * -> *). StatementSym r => SValue r -> MSStatement r
valStmt (SValue r -> MSStatement r) -> SValue r -> MSStatement r
forall a b. (a -> b) -> a -> b
$ SValue r -> SValue r
forall (r :: * -> *). CommonRenderSym r => SValue r -> SValue r
swiftTryVal (SValue r -> SValue r) -> SValue r -> SValue r
forall a b. (a -> b) -> a -> b
$
          VSType r -> SValue r -> String -> SValue r
forall (r :: * -> *).
InternalValueExp r =>
VSType r -> SValue r -> String -> SValue r
objMethodCallNoParams VSType r
forall (r :: * -> *). TypeSym r => VSType r
void (r (Value r) -> SValue r
forall a. a -> StateT ValueState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure r (Value r)
f) String
swiftClose)
        (MSStatement r -> MSBody r
forall (r :: * -> *). BodySym r => MSStatement r -> MSBody r
oneLiner (MSStatement r -> MSBody r) -> MSStatement r -> MSBody r
forall a b. (a -> b) -> a -> b
$ String -> MSStatement r
forall (r :: * -> *). ControlStatement r => String -> MSStatement r
throw String
"Error closing file.")
      swClose CodeType
_ = String -> MSStatement r
forall a. HasCallStack => String -> a
error String
"closeFile called on non-file-typed value"
  CodeType -> MSStatement r
swClose (r (Type r) -> CodeType
forall (r :: * -> *). TypeElim r => r (Type r) -> CodeType
getType (r (Type r) -> CodeType) -> r (Type r) -> CodeType
forall a b. (a -> b) -> a -> b
$ r (Value r) -> r (Type r)
forall (r :: * -> *). ValueSym r => r (Value r) -> r (Type r)
valueType r (Value r)
f)

swiftReadFile :: (OORenderSym r) => SVariable r -> SValue r -> MSStatement r
swiftReadFile :: forall (r :: * -> *).
OORenderSym r =>
SVariable r -> SValue r -> MSStatement r
swiftReadFile SVariable r
v SValue r
f = let l :: SVariable r
l = String -> VSType r -> SVariable r
forall (r :: * -> *).
VariableSym r =>
String -> VSType r -> SVariable r
var String
"l" VSType r
forall (r :: * -> *). TypeSym r => VSType r
string
  in MSBody r
-> MSBody r -> StateT MethodState Identity (r (Statement r))
forall (r :: * -> *).
ControlStatement r =>
MSBody r -> MSBody r -> MSStatement r
tryCatch
  (StateT MethodState Identity (r (Statement r)) -> MSBody r
forall (r :: * -> *). BodySym r => MSStatement r -> MSBody r
oneLiner (StateT MethodState Identity (r (Statement r)) -> MSBody r)
-> StateT MethodState Identity (r (Statement r)) -> MSBody r
forall a b. (a -> b) -> a -> b
$ SVariable r
v SVariable r
-> SValue r -> StateT MethodState Identity (r (Statement r))
forall (r :: * -> *).
AssignStatement r =>
SVariable r -> SValue r -> MSStatement r
&= SValue r -> SValue r -> SValue r
forall (r :: * -> *).
OORenderSym r =>
SValue r -> SValue r -> SValue r
swiftMapFunc (Char -> SValue r -> SValue r
forall (r :: * -> *). OORenderSym r => Char -> SValue r -> SValue r
swiftSplitFunc Char
'\n' (SValue r -> SValue r) -> SValue r -> SValue r
forall a b. (a -> b) -> a -> b
$ SValue r -> SValue r
forall (r :: * -> *). CommonRenderSym r => SValue r -> SValue r
swiftReadFileFunc SValue r
f)
    ([SVariable r] -> SValue r -> SValue r
forall (r :: * -> *).
ValueExpression r =>
[SVariable r] -> SValue r -> SValue r
lambda [SVariable r
l] (Char -> SValue r -> SValue r
forall (r :: * -> *). OORenderSym r => Char -> SValue r -> SValue r
swiftSplitFunc Char
' ' (SVariable r -> SValue r
forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
valueOf SVariable r
l))))
  (StateT MethodState Identity (r (Statement r)) -> MSBody r
forall (r :: * -> *). BodySym r => MSStatement r -> MSBody r
oneLiner (StateT MethodState Identity (r (Statement r)) -> MSBody r)
-> StateT MethodState Identity (r (Statement r)) -> MSBody r
forall a b. (a -> b) -> a -> b
$ String -> StateT MethodState Identity (r (Statement r))
forall (r :: * -> *). ControlStatement r => String -> MSStatement r
throw String
"Error reading from file.")

swiftVarDec :: Doc -> SVariable SwiftCode -> SwiftCode (Scope SwiftCode)
  -> MSStatement SwiftCode
swiftVarDec :: Doc
-> SVariable SwiftCode
-> SwiftCode (Scope SwiftCode)
-> MSStatement SwiftCode
swiftVarDec Doc
dec SVariable SwiftCode
v' SwiftCode (Scope SwiftCode)
scp = do
  SwiftCode VarData
v <- LensLike'
  (Zoomed (StateT ValueState Identity) (SwiftCode VarData))
  MethodState
  ValueState
-> StateT ValueState Identity (SwiftCode VarData)
-> StateT MethodState Identity (SwiftCode 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) (SwiftCode VarData))
  MethodState
  ValueState
(ValueState -> Focusing Identity (SwiftCode VarData) ValueState)
-> MethodState -> Focusing Identity (SwiftCode VarData) MethodState
Lens' MethodState ValueState
lensMStoVS StateT ValueState Identity (SwiftCode VarData)
SVariable SwiftCode
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 (SwiftCode (Variable SwiftCode) -> String
forall (r :: * -> *). VariableElim r => r (Variable r) -> String
variableName SwiftCode VarData
SwiftCode (Variable SwiftCode)
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 (SwiftCode (Variable SwiftCode) -> String
forall (r :: * -> *). VariableElim r => r (Variable r) -> String
variableName SwiftCode VarData
SwiftCode (Variable SwiftCode)
v) (SwiftCode (Scope SwiftCode) -> ScopeData
forall (r :: * -> *). ScopeElim r => r (Scope r) -> ScopeData
scopeData SwiftCode (Scope SwiftCode)
scp)
  let bind :: Binding -> SwiftCode (Permanence SwiftCode)
bind Binding
Static = SwiftCode (Permanence SwiftCode)
forall (r :: * -> *). PermanenceSym r => r (Permanence r)
static :: SwiftCode (Permanence SwiftCode)
      bind Binding
Dynamic = SwiftCode (Permanence SwiftCode)
forall (r :: * -> *). PermanenceSym r => r (Permanence r)
dynamic :: SwiftCode (Permanence SwiftCode)
      p :: SwiftCode Doc
p = Binding -> SwiftCode Doc
bind (Binding -> SwiftCode Doc) -> Binding -> SwiftCode Doc
forall a b. (a -> b) -> a -> b
$ SwiftCode (Variable SwiftCode) -> Binding
forall (r :: * -> *).
InternalVarElim r =>
r (Variable r) -> Binding
variableBind SwiftCode VarData
SwiftCode (Variable SwiftCode)
v
  Doc -> MSStatement SwiftCode
forall (r :: * -> *). CommonRenderSym r => Doc -> MSStatement r
mkStmtNoEnd (SwiftCode (Permanence SwiftCode) -> Doc
forall (r :: * -> *). PermElim r => r (Permanence r) -> Doc
RC.perm SwiftCode Doc
SwiftCode (Permanence SwiftCode)
p Doc -> Doc -> Doc
<+> Doc
dec Doc -> Doc -> Doc
<+> SwiftCode (Variable SwiftCode) -> Doc
forall (r :: * -> *). InternalVarElim r => r (Variable r) -> Doc
RC.variable SwiftCode VarData
SwiftCode (Variable SwiftCode)
v Doc -> Doc -> Doc
<> Doc
swiftTypeSpec
    Doc -> Doc -> Doc
<+> SwiftCode (Type SwiftCode) -> Doc
forall (r :: * -> *). InternalTypeElim r => r (Type r) -> Doc
RC.type' (SwiftCode (Variable SwiftCode) -> SwiftCode (Type SwiftCode)
forall (r :: * -> *).
VariableElim r =>
r (Variable r) -> r (Type r)
variableType SwiftCode VarData
SwiftCode (Variable SwiftCode)
v))

swiftSetDec :: Doc -> SVariable SwiftCode -> SwiftCode (Scope SwiftCode) -> MSStatement SwiftCode
swiftSetDec :: Doc
-> SVariable SwiftCode
-> SwiftCode (Scope SwiftCode)
-> MSStatement SwiftCode
swiftSetDec Doc
dec SVariable SwiftCode
v' SwiftCode (Scope SwiftCode)
scp = do
  SwiftCode VarData
v <- LensLike'
  (Zoomed (StateT ValueState Identity) (SwiftCode VarData))
  MethodState
  ValueState
-> StateT ValueState Identity (SwiftCode VarData)
-> StateT MethodState Identity (SwiftCode 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) (SwiftCode VarData))
  MethodState
  ValueState
(ValueState -> Focusing Identity (SwiftCode VarData) ValueState)
-> MethodState -> Focusing Identity (SwiftCode VarData) MethodState
Lens' MethodState ValueState
lensMStoVS StateT ValueState Identity (SwiftCode VarData)
SVariable SwiftCode
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 (SwiftCode (Variable SwiftCode) -> String
forall (r :: * -> *). VariableElim r => r (Variable r) -> String
variableName SwiftCode VarData
SwiftCode (Variable SwiftCode)
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 (SwiftCode (Variable SwiftCode) -> String
forall (r :: * -> *). VariableElim r => r (Variable r) -> String
variableName SwiftCode VarData
SwiftCode (Variable SwiftCode)
v) (SwiftCode (Scope SwiftCode) -> ScopeData
forall (r :: * -> *). ScopeElim r => r (Scope r) -> ScopeData
scopeData SwiftCode (Scope SwiftCode)
scp)
  let bind :: Binding -> SwiftCode (Permanence SwiftCode)
bind Binding
Static = SwiftCode (Permanence SwiftCode)
forall (r :: * -> *). PermanenceSym r => r (Permanence r)
static :: SwiftCode (Permanence SwiftCode)
      bind Binding
Dynamic = SwiftCode (Permanence SwiftCode)
forall (r :: * -> *). PermanenceSym r => r (Permanence r)
dynamic :: SwiftCode (Permanence SwiftCode)
      p :: SwiftCode Doc
p = Binding -> SwiftCode Doc
bind (Binding -> SwiftCode Doc) -> Binding -> SwiftCode Doc
forall a b. (a -> b) -> a -> b
$ SwiftCode (Variable SwiftCode) -> Binding
forall (r :: * -> *).
InternalVarElim r =>
r (Variable r) -> Binding
variableBind SwiftCode VarData
SwiftCode (Variable SwiftCode)
v
  Doc -> MSStatement SwiftCode
forall (r :: * -> *). CommonRenderSym r => Doc -> MSStatement r
mkStmtNoEnd (SwiftCode (Permanence SwiftCode) -> Doc
forall (r :: * -> *). PermElim r => r (Permanence r) -> Doc
RC.perm SwiftCode Doc
SwiftCode (Permanence SwiftCode)
p Doc -> Doc -> Doc
<+> Doc
dec Doc -> Doc -> Doc
<+> SwiftCode (Variable SwiftCode) -> Doc
forall (r :: * -> *). InternalVarElim r => r (Variable r) -> Doc
RC.variable SwiftCode VarData
SwiftCode (Variable SwiftCode)
v Doc -> Doc -> Doc
<> Doc
swiftTypeSpec
    Doc -> Doc -> Doc
<+> String -> Doc
text (String
swiftSet String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
replaceBrackets (SwiftCode (Type SwiftCode) -> String
forall (r :: * -> *). TypeElim r => r (Type r) -> String
getTypeString (SwiftCode (Variable SwiftCode) -> SwiftCode (Type SwiftCode)
forall (r :: * -> *).
VariableElim r =>
r (Variable r) -> r (Type r)
variableType SwiftCode VarData
SwiftCode (Variable SwiftCode)
v))))

replaceBrackets :: String -> String
replaceBrackets :: String -> String
replaceBrackets String
str = String
"<" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (String -> String
forall a. HasCallStack => [a] -> [a]
init (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. HasCallStack => [a] -> [a]
tail) String
str String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
">"

swiftThrowDoc :: (CommonRenderSym r) => r (Value r) -> Doc
swiftThrowDoc :: forall (r :: * -> *). CommonRenderSym r => r (Value r) -> Doc
swiftThrowDoc r (Value r)
errMsg = Doc
throwLabel Doc -> Doc -> Doc
<+> r (Value r) -> Doc
forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value r (Value r)
errMsg

swiftForEach :: (CommonRenderSym r) => r (Variable r) -> r (Value r) -> r (Body r) -> Doc
swiftForEach :: forall (r :: * -> *).
CommonRenderSym r =>
r (Variable r) -> r (Value r) -> r (Body r) -> Doc
swiftForEach r (Variable r)
i r (Value r)
lstVar r (Body r)
b = [Doc] -> Doc
vcat [
  Doc
forLabel Doc -> Doc -> Doc
<+> r (Variable r) -> Doc
forall (r :: * -> *). InternalVarElim r => r (Variable r) -> Doc
RC.variable r (Variable r)
i Doc -> Doc -> Doc
<+> Doc
inLabel Doc -> Doc -> Doc
<+> r (Value r) -> Doc
forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value r (Value r)
lstVar Doc -> Doc -> Doc
<+> Doc
bodyStart,
  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
bodyEnd]

swiftTryCatch :: (CommonRenderSym r) => r (Body r) -> r (Body r) -> Doc
swiftTryCatch :: forall (r :: * -> *).
CommonRenderSym r =>
r (Body r) -> r (Body r) -> Doc
swiftTryCatch r (Body r)
tb r (Body r)
cb = [Doc] -> Doc
vcat [
  Doc
swiftDo 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
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]

swiftAssert :: (CommonRenderSym r) => r (Value r) -> r (Value r) -> Doc
swiftAssert :: forall (r :: * -> *).
CommonRenderSym r =>
r (Value r) -> r (Value r) -> Doc
swiftAssert 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
<+> String -> Doc
text String
"," Doc -> Doc -> Doc
<+> r (Value r) -> Doc
forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value r (Value r)
errorMessage Doc -> Doc -> Doc
<> String -> Doc
text String
")"
  ]

swiftParam :: (CommonRenderSym r) => Doc -> r (Variable r) -> Doc
swiftParam :: forall (r :: * -> *).
CommonRenderSym r =>
Doc -> r (Variable r) -> Doc
swiftParam Doc
io r (Variable r)
v = Doc
swiftNoLabel 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
swiftTypeSpec Doc -> Doc -> Doc
<+> Doc
io
  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)

swiftMethod :: Label -> SwiftCode (Visibility SwiftCode) ->
  SwiftCode (Permanence SwiftCode) -> MSMthdType SwiftCode ->
  [MSParameter SwiftCode] -> MSBody SwiftCode -> SMethod SwiftCode
swiftMethod :: String
-> SwiftCode (Visibility SwiftCode)
-> SwiftCode (Permanence SwiftCode)
-> MSMthdType SwiftCode
-> [MSParameter SwiftCode]
-> MSBody SwiftCode
-> SMethod SwiftCode
swiftMethod String
n SwiftCode (Visibility SwiftCode)
s SwiftCode (Permanence SwiftCode)
p MSMthdType SwiftCode
t [MSParameter SwiftCode]
ps MSBody SwiftCode
b = do
  SwiftCode TypeData
tp <- StateT MethodState Identity (SwiftCode TypeData)
MSMthdType SwiftCode
t
  [SwiftCode ParamData]
pms <- [State MethodState (SwiftCode ParamData)]
-> StateT MethodState Identity [SwiftCode 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 (SwiftCode ParamData)]
[MSParameter SwiftCode]
ps
  SwiftCode Doc
bod <- State MethodState (SwiftCode Doc)
MSBody SwiftCode
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
  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 :: [ExceptionType]
excs = [ExceptionType]
-> QualifiedName
-> Map QualifiedName [ExceptionType]
-> [ExceptionType]
forall k a. Ord k => a -> k -> Map k a -> a
findWithDefault [] (String -> String -> QualifiedName
qualName String
mn String
n) Map QualifiedName [ExceptionType]
mem
  VisibilityTag -> Doc -> SMethod SwiftCode
forall (r :: * -> *).
RenderMethod r =>
VisibilityTag -> Doc -> SMethod r
mthdFromData VisibilityTag
Pub ([Doc] -> Doc
vcat [
    SwiftCode (Visibility SwiftCode) -> Doc
forall (r :: * -> *). VisibilityElim r => r (Visibility r) -> Doc
RC.visibility SwiftCode (Visibility SwiftCode)
s Doc -> Doc -> Doc
<+> SwiftCode (Permanence SwiftCode) -> Doc
forall (r :: * -> *). PermElim r => r (Permanence r) -> Doc
RC.perm SwiftCode (Permanence SwiftCode)
p Doc -> Doc -> Doc
<+> Doc
swiftFunc Doc -> Doc -> Doc
<+> String -> Doc
text String
n Doc -> Doc -> Doc
<>
      Doc -> Doc
parens ([SwiftCode (Parameter SwiftCode)] -> Doc
forall (r :: * -> *). CommonRenderSym r => [r (Parameter r)] -> Doc
parameterList [SwiftCode ParamData]
[SwiftCode (Parameter SwiftCode)]
pms) Doc -> Doc -> Doc
<+> [ExceptionType] -> Doc -> Doc
forall a. [a] -> Doc -> Doc
emptyIfNull [ExceptionType]
excs Doc
throwsLabel Doc -> Doc -> Doc
<+>
      Doc
swiftRetType' Doc -> Doc -> Doc
<+> SwiftCode (Type SwiftCode) -> Doc
forall (r :: * -> *). InternalTypeElim r => r (Type r) -> Doc
RC.type' SwiftCode TypeData
SwiftCode (Type SwiftCode)
tp Doc -> Doc -> Doc
<+> Doc
bodyStart,
    Doc -> Doc
indent (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ SwiftCode (Body SwiftCode) -> Doc
forall (r :: * -> *). BodyElim r => r (Body r) -> Doc
RC.body SwiftCode Doc
SwiftCode (Body SwiftCode)
bod,
    Doc
bodyEnd])

swiftConstructor :: (OORenderSym r) => [MSParameter r] -> Initializers r ->
  MSBody r -> SMethod r
swiftConstructor :: forall (r :: * -> *).
OORenderSym r =>
[MSParameter r] -> Initializers r -> MSBody r -> SMethod r
swiftConstructor [MSParameter r]
ps Initializers r
is MSBody r
b = do
  [r (Parameter r)]
pms <- [MSParameter r] -> StateT MethodState Identity [r (Parameter r)]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [MSParameter r]
ps
  r (Body r)
bod <- [MSBody r] -> MSBody r
forall (r :: * -> *). RenderBody r => [MSBody r] -> MSBody r
multiBody [Initializers r -> MSBody r
forall (r :: * -> *). OORenderSym r => Initializers r -> MSBody r
G.initStmts Initializers r
is, MSBody r
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
  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
  String
cn <- MS String
getClassName
  let excs :: [ExceptionType]
excs = [ExceptionType]
-> QualifiedName
-> Map QualifiedName [ExceptionType]
-> [ExceptionType]
forall k a. Ord k => a -> k -> Map k a -> a
findWithDefault [] (String -> String -> QualifiedName
qualName String
mn String
cn) Map QualifiedName [ExceptionType]
mem
  VisibilityTag -> Doc -> SMethod r
forall (r :: * -> *).
RenderMethod r =>
VisibilityTag -> Doc -> SMethod r
mthdFromData VisibilityTag
Pub ([Doc] -> Doc
vcat [
    Doc
swiftCtorName Doc -> Doc -> Doc
<> Doc -> Doc
parens ([r (Parameter r)] -> Doc
forall (r :: * -> *). CommonRenderSym r => [r (Parameter r)] -> Doc
parameterList [r (Parameter r)]
pms) Doc -> Doc -> Doc
<+>
      [ExceptionType] -> Doc -> Doc
forall a. [a] -> Doc -> Doc
emptyIfNull [ExceptionType]
excs Doc
throwsLabel Doc -> Doc -> Doc
<+> Doc
bodyStart,
    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)
bod,
    Doc
bodyEnd])

-- If the program uses throw, then generate code that extends Strings with the 
-- Error protocol. This line only needs to be generated once for the entire 
-- program
swiftStringError :: MS Doc
swiftStringError :: StateT MethodState Identity Doc
swiftStringError = do
  Bool
tu <- MS Bool
getThrowUsed
  Bool
errdef <- MS Bool
getErrorDefined
  SwiftCode TypeData
str <- LensLike'
  (Zoomed (StateT ValueState Identity) (SwiftCode TypeData))
  MethodState
  ValueState
-> StateT ValueState Identity (SwiftCode TypeData)
-> StateT MethodState Identity (SwiftCode 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) (SwiftCode TypeData))
  MethodState
  ValueState
(ValueState -> Focusing Identity (SwiftCode TypeData) ValueState)
-> MethodState
-> Focusing Identity (SwiftCode TypeData) MethodState
Lens' MethodState ValueState
lensMStoVS (VSType SwiftCode
forall (r :: * -> *). TypeSym r => VSType r
string :: VSType SwiftCode)
  if Bool
tu Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
errdef then do
    (MethodState -> MethodState) -> StateT MethodState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify MethodState -> MethodState
setErrorDefined
    Doc -> StateT MethodState Identity Doc
forall a. a -> StateT MethodState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc
swiftExtension Doc -> Doc -> Doc
<+> SwiftCode (Type SwiftCode) -> Doc
forall (r :: * -> *). InternalTypeElim r => r (Type r) -> Doc
RC.type' SwiftCode TypeData
SwiftCode (Type SwiftCode)
str Doc -> Doc -> Doc
<> Doc
swiftConforms Doc -> Doc -> Doc
<+> Doc
swiftError Doc -> Doc -> Doc
<+> Doc
bodyStart Doc -> Doc -> Doc
<> Doc
bodyEnd)
  else Doc -> StateT MethodState Identity Doc
forall a. a -> StateT MethodState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Doc
empty

swiftClassDoc :: ClassDocRenderer
swiftClassDoc :: ClassDocRenderer
swiftClassDoc String
desc = [String
desc | Bool -> Bool
not (String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
desc)]

typeDfltVal :: (OORenderSym r) => CodeType -> SValue r
typeDfltVal :: forall (r :: * -> *). OORenderSym r => CodeType -> SValue r
typeDfltVal CodeType
Boolean = SValue r
forall (r :: * -> *). Literal r => SValue r
litFalse
typeDfltVal CodeType
Integer = Integer -> SValue r
forall (r :: * -> *). Literal r => Integer -> SValue r
litInt Integer
0
typeDfltVal CodeType
Float = Float -> SValue r
forall (r :: * -> *). Literal r => Float -> SValue r
litFloat Float
0.0
typeDfltVal CodeType
Double = Double -> SValue r
forall (r :: * -> *). Literal r => Double -> SValue r
litDouble Double
0.0
typeDfltVal CodeType
Char = Char -> SValue r
forall (r :: * -> *). Literal r => Char -> SValue r
litChar Char
' '
typeDfltVal CodeType
String = String -> SValue r
forall (r :: * -> *). Literal r => String -> SValue r
litString String
""
typeDfltVal (List CodeType
t) = VSType r -> [SValue r] -> SValue r
forall (r :: * -> *).
Literal r =>
VSType r -> [SValue r] -> SValue r
litList (CodeType -> VSType r
forall (r :: * -> *). OOTypeSym r => CodeType -> VSType r
convTypeOO CodeType
t) []
typeDfltVal (Array CodeType
t) = VSType r -> [SValue r] -> SValue r
forall (r :: * -> *).
Literal r =>
VSType r -> [SValue r] -> SValue r
litArray (CodeType -> VSType r
forall (r :: * -> *). OOTypeSym r => CodeType -> VSType r
convTypeOO CodeType
t) []
typeDfltVal (Set CodeType
t) = VSType r -> [SValue r] -> SValue r
forall (r :: * -> *).
Literal r =>
VSType r -> [SValue r] -> SValue r
litSet (CodeType -> VSType r
forall (r :: * -> *). OOTypeSym r => CodeType -> VSType r
convTypeOO CodeType
t) []
typeDfltVal CodeType
_ = String -> SValue r
forall a. HasCallStack => String -> a
error String
"Attempt to get default value for type with none."