{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE DeriveFunctor #-}

-- | The logic to render Julia code is contained in this module
module Drasil.GOOL.LanguageRenderer.JuliaRenderer (
  -- * Julia Code Configuration -- defines syntax of all Julia code
  JuliaCode(..), jlName, jlVersion
) where

import Utils.Drasil (indent)

import Drasil.GOOL.CodeType (CodeType(..))
import Drasil.GOOL.InterfaceCommon (SharedProg, Label, VSType, SValue, litZero,
  SVariable, MSStatement, MSBlock, SMethod, BodySym(..), BlockSym(..),
  TypeSym(..), TypeElim(..), VariableSym(..), VariableElim(..), ValueSym(..),
  Argument(..), Literal(..), MathConstant(..), VariableValue(..),
  CommandLineArgs(..), NumericExpression(..), BooleanExpression(..),
  Comparison(..), ValueExpression(..), funcApp, extFuncApp, List(..), Set(..),
  InternalList(..), ThunkSym(..), VectorType(..), VectorDecl(..),
  VectorThunk(..), VectorExpression(..), ThunkAssign(..), StatementSym(..),
  AssignStatement(..), DeclStatement(..), IOStatement(..), StringStatement(..),
  FunctionSym(..), FuncAppStatement(..), CommentStatement(..),
  ControlStatement(..), VisibilitySym(..), ScopeSym(..), ParameterSym(..),
  MethodSym(..), (&=), switchAsIf, convScope)
import Drasil.GOOL.InterfaceProc (ProcProg, FSModule, ProgramSym(..),
  FileSym(..), ModuleSym(..))

import Drasil.GOOL.RendererClassesCommon (CommonRenderSym, ImportSym(..),
  ImportElim, RenderBody(..), BodyElim, RenderBlock(..), BlockElim,
  RenderType(..), InternalTypeElim, UnaryOpSym(..), BinaryOpSym(..),
  OpElim(uOpPrec, bOpPrec), RenderVariable(..), InternalVarElim(variableBind),
  RenderValue(..), ValueElim(..), 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.RendererClassesProc (ProcRenderSym, RenderFile(..),
  RenderMod(..), ModuleElim, ProcRenderMethod(..))
import qualified Drasil.GOOL.RendererClassesProc as RC (module')
import Drasil.GOOL.LanguageRenderer (printLabel, listSep, listSep',
  variableList, parameterList, forLabel, inLabel, tryLabel, catchLabel,
  valueList)
import qualified Drasil.GOOL.LanguageRenderer as R (sqrt, abs, log10, log,
  exp, sin, cos, tan, asin, acos, atan, floor, ceil, multiStmt, body,
  addComments, blockCmt, docCmt, commentedMod, listSetFunc, commentedItem,
  break, continue, constDec', assign, subAssign, addAssign)
import Drasil.GOOL.LanguageRenderer.Constructors (mkVal, mkStateVal, VSOp,
  unOpPrec, powerPrec, unExpr, unExpr', binExpr, multPrec, typeUnExpr,
  typeBinExpr, mkStmt, mkStmtNoEnd)
import Drasil.GOOL.LanguageRenderer.LanguagePolymorphic (OptionalSpace(..))
import qualified Drasil.GOOL.LanguageRenderer.LanguagePolymorphic as G (
  block, multiBlock, litChar, litDouble, litInt, litString, valueOf, negateOp,
  equalOp, notEqualOp, greaterOp, greaterEqualOp, lessOp, lessEqualOp, plusOp,
  minusOp, multOp, divideOp, moduloOp, call, funcAppMixedArgs, lambda,
  listAccess, listSet, tryCatch, csc, multiBody, sec, cot, stmt, loopStmt,
  emptyStmt, print, comment, valStmt, returnStmt, param, docFunc, throw, arg,
  argsList, ifCond, smartAdd, local, var)
import qualified Drasil.GOOL.LanguageRenderer.CommonPseudoOO as CP (bool,
  boolRender, extVar, funcType, listDec, listDecDef, listAccessFunc,
  listSetFunc, notNull, extFuncAppMixedArgs, functionDoc, listSize, listAdd,
  listAppend, intToIndex', indexToInt', inOutFunc, docInOutFunc', forLoopError,
  varDecDef, openFileR', openFileW', openFileA', multiReturn, multiAssign,
  inOutCall, mainBody, argExists, forEach', litSet)
import qualified Drasil.GOOL.LanguageRenderer.CLike as C (litTrue, litFalse,
  notOp, andOp, orOp, inlineIf, while)
import qualified Drasil.GOOL.LanguageRenderer.AbstractProc as A (fileDoc,
  fileFromData, buildModule, docMod, modFromData, listInnerType, arrayElem,
  funcDecDef, function)
import qualified Drasil.GOOL.LanguageRenderer.Macros as M (increment1,
  decrement1, ifExists, stringListVals, stringListLists)
import Drasil.GOOL.AST (Terminator(..), FileType(..), FileData(..), fileD,
  FuncData(..), ModData(..), md, updateMod, MethodData(..), mthd, OpData(..),
  ParamData(..), ProgData(..), TypeData(..), td, ValData(..), vd, VarData(..),
  vard, CommonThunk, progD, fd, pd, updateMthd, commonThunkDim, commonThunkElim,
  vectorize, vectorize2, commonVecIndex, sumComponents, pureValue, ScopeTag(..),
  ScopeData(..), sd)
import Drasil.GOOL.Helpers (vibcat, toCode, toState, onCodeValue, onStateValue,
  on2CodeValues, on2StateValues, onCodeList, onStateList, emptyIfEmpty)
import Drasil.GOOL.State (VS, lensGStoFS, revFiles, setFileType, lensMStoVS,
  getModuleImports, addModuleImportVS, getLangImports, getLibImports,
  addLibImportVS, useVarName, getMainDoc, genLoopIndex, genVarNameIf,
  setVarScope, getVarScope)

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

jlExt :: String
jlExt :: Label
jlExt = Label
"jl"

newtype JuliaCode a = JLC {forall a. JuliaCode a -> a
unJLC :: a} deriving (forall a b. (a -> b) -> JuliaCode a -> JuliaCode b)
-> (forall a b. a -> JuliaCode b -> JuliaCode a)
-> Functor JuliaCode
forall a b. a -> JuliaCode b -> JuliaCode a
forall a b. (a -> b) -> JuliaCode a -> JuliaCode b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> JuliaCode a -> JuliaCode b
fmap :: forall a b. (a -> b) -> JuliaCode a -> JuliaCode b
$c<$ :: forall a b. a -> JuliaCode b -> JuliaCode a
<$ :: forall a b. a -> JuliaCode b -> JuliaCode a
Functor

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

instance Monad JuliaCode where
  JLC a
x >>= :: forall a b. JuliaCode a -> (a -> JuliaCode b) -> JuliaCode b
>>= a -> JuliaCode b
f = a -> JuliaCode b
f a
x

instance SharedProg JuliaCode
instance ProcProg JuliaCode

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

instance CommonRenderSym JuliaCode
instance ProcRenderSym JuliaCode

instance FileSym JuliaCode where
  type File JuliaCode = FileData
  fileDoc :: FSModule JuliaCode -> SFile JuliaCode
fileDoc FSModule JuliaCode
m = do
    (FileState -> FileState) -> StateT FileState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (FileType -> FileState -> FileState
setFileType FileType
Combined)
    Label -> FSModule JuliaCode -> SFile JuliaCode
forall (r :: * -> *).
ProcRenderSym r =>
Label -> FSModule r -> SFile r
A.fileDoc Label
jlExt FSModule JuliaCode
m
  docMod :: Label -> [Label] -> Label -> SFile JuliaCode -> SFile JuliaCode
docMod = Label
-> Label -> [Label] -> Label -> SFile JuliaCode -> SFile JuliaCode
forall (r :: * -> *).
ProcRenderSym r =>
Label -> Label -> [Label] -> Label -> SFile r -> SFile r
A.docMod Label
jlExt

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

  commentedMod :: SFile JuliaCode
-> FS (JuliaCode (BlockComment JuliaCode)) -> SFile JuliaCode
commentedMod = (JuliaCode FileData -> JuliaCode Doc -> JuliaCode FileData)
-> StateT FileState Identity (JuliaCode FileData)
-> State FileState (JuliaCode Doc)
-> StateT FileState Identity (JuliaCode FileData)
forall a b c s.
(a -> b -> c) -> State s a -> State s b -> State s c
on2StateValues ((FileData -> Doc -> FileData)
-> JuliaCode FileData -> JuliaCode Doc -> JuliaCode FileData
forall (r :: * -> *) a b c.
Applicative r =>
(a -> b -> c) -> r a -> r b -> r c
on2CodeValues FileData -> Doc -> FileData
R.commentedMod)

  fileFromData :: Label -> FSModule JuliaCode -> SFile JuliaCode
fileFromData = (Label
 -> JuliaCode (Module JuliaCode) -> JuliaCode (File JuliaCode))
-> Label -> FSModule JuliaCode -> SFile JuliaCode
forall (r :: * -> *).
ProcRenderSym r =>
(Label -> r (Module r) -> r (File r))
-> Label -> FSModule r -> SFile r
A.fileFromData ((ModData -> FileData) -> JuliaCode ModData -> JuliaCode FileData
forall (r :: * -> *) a b. Functor r => (a -> b) -> r a -> r b
onCodeValue ((ModData -> FileData) -> JuliaCode ModData -> JuliaCode FileData)
-> (Label -> ModData -> FileData)
-> Label
-> JuliaCode ModData
-> JuliaCode FileData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Label -> ModData -> FileData
fileD)

instance ImportSym JuliaCode where
  type Import JuliaCode = Doc
  langImport :: Label -> JuliaCode (Import JuliaCode)
langImport Label
n = let modName :: Doc
modName = Label -> Doc
text Label
n
    in Doc -> JuliaCode Doc
forall (r :: * -> *) a. Monad r => a -> r a
toCode (Doc -> JuliaCode Doc) -> Doc -> JuliaCode Doc
forall a b. (a -> b) -> a -> b
$ Doc
importLabel Doc -> Doc -> Doc
<+> Doc
modName
  modImport :: Label -> JuliaCode (Import JuliaCode)
modImport Label
n = let modName :: Doc
modName = Label -> Doc
text Label
n
                    fileName :: Doc
fileName = Label -> Doc
text (Label -> Doc) -> Label -> Doc
forall a b. (a -> b) -> a -> b
$ Label
n Label -> Label -> Label
forall a. [a] -> [a] -> [a]
++ Char
'.' Char -> Label -> Label
forall a. a -> [a] -> [a]
: Label
jlExt
    in Doc -> JuliaCode Doc
forall (r :: * -> *) a. Monad r => a -> r a
toCode (Doc -> JuliaCode Doc) -> Doc -> JuliaCode Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat [Doc
includeLabel Doc -> Doc -> Doc
<> Doc -> Doc
parens (Doc -> Doc
doubleQuotes Doc
fileName),
                      Doc
importLabel Doc -> Doc -> Doc
<+> Label -> Doc
text Label
"." Doc -> Doc -> Doc
<> Doc
modName]

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

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

  addComments :: Label -> MSBody JuliaCode -> MSBody JuliaCode
addComments Label
s = (JuliaCode Doc -> JuliaCode Doc)
-> State MethodState (JuliaCode Doc)
-> State MethodState (JuliaCode Doc)
forall a b s. (a -> b) -> State s a -> State s b
onStateValue ((Doc -> Doc) -> JuliaCode Doc -> JuliaCode Doc
forall (r :: * -> *) a b. Functor r => (a -> b) -> r a -> r b
onCodeValue (Label -> Doc -> Doc -> Doc
R.addComments Label
s Doc
jlCmtStart))

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

instance BodyElim JuliaCode where
  body :: JuliaCode (Body JuliaCode) -> Doc
body = JuliaCode Doc -> Doc
JuliaCode (Body JuliaCode) -> Doc
forall a. JuliaCode a -> a
unJLC

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

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

instance BlockElim JuliaCode where
  block :: JuliaCode (Block JuliaCode) -> Doc
block = JuliaCode Doc -> Doc
JuliaCode (Block JuliaCode) -> Doc
forall a. JuliaCode a -> a
unJLC

instance TypeSym JuliaCode where
  type Type JuliaCode = TypeData
  bool :: VSType JuliaCode
bool = VSType JuliaCode
forall (r :: * -> *). CommonRenderSym r => VSType r
CP.bool
  int :: VSType JuliaCode
int = VSType JuliaCode
forall (r :: * -> *). CommonRenderSym r => VSType r
jlIntType
  float :: VSType JuliaCode
float = VSType JuliaCode
forall (r :: * -> *). CommonRenderSym r => VSType r
jlFloatType
  double :: VSType JuliaCode
double = VSType JuliaCode
forall (r :: * -> *). CommonRenderSym r => VSType r
jlDoubleType
  char :: VSType JuliaCode
char = VSType JuliaCode
forall (r :: * -> *). CommonRenderSym r => VSType r
jlCharType
  string :: VSType JuliaCode
string = VSType JuliaCode
forall (r :: * -> *). CommonRenderSym r => VSType r
jlStringType
  infile :: VSType JuliaCode
infile = VSType JuliaCode
forall (r :: * -> *). CommonRenderSym r => VSType r
jlInfileType
  outfile :: VSType JuliaCode
outfile = VSType JuliaCode
forall (r :: * -> *). CommonRenderSym r => VSType r
jlOutfileType
  listType :: VSType JuliaCode -> VSType JuliaCode
listType = VSType JuliaCode -> VSType JuliaCode
forall (r :: * -> *). CommonRenderSym r => VSType r -> VSType r
jlListType
  setType :: VSType JuliaCode -> VSType JuliaCode
setType = VSType JuliaCode -> VSType JuliaCode
forall (r :: * -> *). CommonRenderSym r => VSType r -> VSType r
jlSetType
  arrayType :: VSType JuliaCode -> VSType JuliaCode
arrayType = VSType JuliaCode -> VSType JuliaCode
forall (r :: * -> *). TypeSym r => VSType r -> VSType r
listType -- Treat arrays and lists the same, as in Python
  listInnerType :: VSType JuliaCode -> VSType JuliaCode
listInnerType = VSType JuliaCode -> VSType JuliaCode
forall (r :: * -> *). ProcRenderSym r => VSType r -> VSType r
A.listInnerType
  funcType :: [VSType JuliaCode] -> VSType JuliaCode -> VSType JuliaCode
funcType = [VSType JuliaCode] -> VSType JuliaCode -> VSType JuliaCode
forall (r :: * -> *).
CommonRenderSym r =>
[VSType r] -> VSType r -> VSType r
CP.funcType
  void :: VSType JuliaCode
void = VSType JuliaCode
forall (r :: * -> *). CommonRenderSym r => VSType r
jlVoidType

instance TypeElim JuliaCode where
  getType :: JuliaCode (Type JuliaCode) -> CodeType
getType = TypeData -> CodeType
cType (TypeData -> CodeType)
-> (JuliaCode TypeData -> TypeData)
-> JuliaCode TypeData
-> CodeType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JuliaCode TypeData -> TypeData
forall a. JuliaCode a -> a
unJLC
  getTypeString :: JuliaCode (Type JuliaCode) -> Label
getTypeString JuliaCode (Type JuliaCode)
v = let tp :: Label
tp = TypeData -> Label
typeString (TypeData -> Label) -> TypeData -> Label
forall a b. (a -> b) -> a -> b
$ JuliaCode TypeData -> TypeData
forall a. JuliaCode a -> a
unJLC JuliaCode TypeData
JuliaCode (Type JuliaCode)
v in
    case TypeData -> CodeType
cType (TypeData -> CodeType) -> TypeData -> CodeType
forall a b. (a -> b) -> a -> b
$ JuliaCode TypeData -> TypeData
forall a. JuliaCode a -> a
unJLC JuliaCode TypeData
JuliaCode (Type JuliaCode)
v of
      (Object Label
_) -> Label -> Label
forall a. HasCallStack => Label -> a
error Label
jlClassError
      CodeType
_ -> Label
tp

instance RenderType JuliaCode where
  multiType :: [VSType JuliaCode] -> VSType JuliaCode
multiType [VSType JuliaCode]
ts = do
    [JuliaCode TypeData]
typs <- [StateT ValueState Identity (JuliaCode TypeData)]
-> StateT ValueState Identity [JuliaCode 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 (JuliaCode TypeData)]
[VSType JuliaCode]
ts
    let mt :: Label
mt = [Label] -> Label
jlTuple ([Label] -> Label) -> [Label] -> Label
forall a b. (a -> b) -> a -> b
$ (JuliaCode TypeData -> Label) -> [JuliaCode TypeData] -> [Label]
forall a b. (a -> b) -> [a] -> [b]
map JuliaCode TypeData -> Label
JuliaCode (Type JuliaCode) -> Label
forall (r :: * -> *). TypeElim r => r (Type r) -> Label
getTypeString [JuliaCode TypeData]
typs
    CodeType -> Label -> Doc -> VSType JuliaCode
forall (r :: * -> *).
RenderType r =>
CodeType -> Label -> Doc -> VSType r
typeFromData CodeType
Void Label
mt (Label -> Doc
text Label
mt)
  typeFromData :: CodeType -> Label -> Doc -> VSType JuliaCode
typeFromData CodeType
t Label
s Doc
d = JuliaCode (Type JuliaCode) -> VSType JuliaCode
forall a s. a -> State s a
toState (JuliaCode (Type JuliaCode) -> VSType JuliaCode)
-> JuliaCode (Type JuliaCode) -> VSType JuliaCode
forall a b. (a -> b) -> a -> b
$ TypeData -> JuliaCode TypeData
forall (r :: * -> *) a. Monad r => a -> r a
toCode (TypeData -> JuliaCode TypeData) -> TypeData -> JuliaCode TypeData
forall a b. (a -> b) -> a -> b
$ CodeType -> Label -> Doc -> TypeData
td CodeType
t Label
s Doc
d

instance InternalTypeElim JuliaCode where
  type' :: JuliaCode (Type JuliaCode) -> Doc
type' JuliaCode (Type JuliaCode)
v = let t :: Doc
t = TypeData -> Doc
typeDoc (TypeData -> Doc) -> TypeData -> Doc
forall a b. (a -> b) -> a -> b
$ JuliaCode TypeData -> TypeData
forall a. JuliaCode a -> a
unJLC JuliaCode TypeData
JuliaCode (Type JuliaCode)
v in
    case TypeData -> CodeType
cType (TypeData -> CodeType) -> TypeData -> CodeType
forall a b. (a -> b) -> a -> b
$ JuliaCode TypeData -> TypeData
forall a. JuliaCode a -> a
unJLC JuliaCode TypeData
JuliaCode (Type JuliaCode)
v of
      (Object Label
_) -> Doc
t Doc -> Doc -> Doc
<> Label -> Doc
forall a. HasCallStack => Label -> a
error Label
jlClassError
      CodeType
_ -> Doc
t

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

instance BinaryOpSym JuliaCode where
  type BinaryOp JuliaCode = OpData
  equalOp :: VSBinOp JuliaCode
equalOp = VSOp JuliaCode
VSBinOp JuliaCode
forall (r :: * -> *). Monad r => VSOp r
G.equalOp
  notEqualOp :: VSBinOp JuliaCode
notEqualOp = VSOp JuliaCode
VSBinOp JuliaCode
forall (r :: * -> *). Monad r => VSOp r
G.notEqualOp
  greaterOp :: VSBinOp JuliaCode
greaterOp = VSOp JuliaCode
VSBinOp JuliaCode
forall (r :: * -> *). Monad r => VSOp r
G.greaterOp
  greaterEqualOp :: VSBinOp JuliaCode
greaterEqualOp = VSOp JuliaCode
VSBinOp JuliaCode
forall (r :: * -> *). Monad r => VSOp r
G.greaterEqualOp
  lessOp :: VSBinOp JuliaCode
lessOp = VSOp JuliaCode
VSBinOp JuliaCode
forall (r :: * -> *). Monad r => VSOp r
G.lessOp
  lessEqualOp :: VSBinOp JuliaCode
lessEqualOp = VSOp JuliaCode
VSBinOp JuliaCode
forall (r :: * -> *). Monad r => VSOp r
G.lessEqualOp
  plusOp :: VSBinOp JuliaCode
plusOp = VSOp JuliaCode
VSBinOp JuliaCode
forall (r :: * -> *). Monad r => VSOp r
G.plusOp
  minusOp :: VSBinOp JuliaCode
minusOp = VSOp JuliaCode
VSBinOp JuliaCode
forall (r :: * -> *). Monad r => VSOp r
G.minusOp
  multOp :: VSBinOp JuliaCode
multOp = VSOp JuliaCode
VSBinOp JuliaCode
forall (r :: * -> *). Monad r => VSOp r
G.multOp
  divideOp :: VSBinOp JuliaCode
divideOp = VSOp JuliaCode
VSBinOp JuliaCode
forall (r :: * -> *). Monad r => VSOp r
G.divideOp
  powerOp :: VSBinOp JuliaCode
powerOp = Label -> VSOp JuliaCode
forall (r :: * -> *). Monad r => Label -> VSOp r
powerPrec Label
jlPower
  moduloOp :: VSBinOp JuliaCode
moduloOp = VSOp JuliaCode
VSBinOp JuliaCode
forall (r :: * -> *). Monad r => VSOp r
G.moduloOp
  andOp :: VSBinOp JuliaCode
andOp = VSOp JuliaCode
VSBinOp JuliaCode
forall (r :: * -> *). Monad r => VSOp r
C.andOp
  orOp :: VSBinOp JuliaCode
orOp = VSOp JuliaCode
VSBinOp JuliaCode
forall (r :: * -> *). Monad r => VSOp r
C.orOp

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

instance ScopeSym JuliaCode where
  type Scope JuliaCode = ScopeData
  global :: JuliaCode (Scope JuliaCode)
global = ScopeData -> JuliaCode ScopeData
forall (r :: * -> *) a. Monad r => a -> r a
toCode (ScopeData -> JuliaCode ScopeData)
-> ScopeData -> JuliaCode ScopeData
forall a b. (a -> b) -> a -> b
$ ScopeTag -> ScopeData
sd ScopeTag
Global
  mainFn :: JuliaCode (Scope JuliaCode)
mainFn = JuliaCode (Scope JuliaCode)
forall (r :: * -> *). ScopeSym r => r (Scope r)
global
  local :: JuliaCode (Scope JuliaCode)
local = JuliaCode ScopeData
JuliaCode (Scope JuliaCode)
forall (r :: * -> *). Monad r => r ScopeData
G.local

instance ScopeElim JuliaCode where
  scopeData :: JuliaCode (Scope JuliaCode) -> ScopeData
scopeData = JuliaCode ScopeData -> ScopeData
JuliaCode (Scope JuliaCode) -> ScopeData
forall a. JuliaCode a -> a
unJLC

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

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

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

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

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

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

instance Literal JuliaCode where
  litTrue :: SValue JuliaCode
litTrue = SValue JuliaCode
forall (r :: * -> *). CommonRenderSym r => SValue r
C.litTrue
  litFalse :: SValue JuliaCode
litFalse = SValue JuliaCode
forall (r :: * -> *). CommonRenderSym r => SValue r
C.litFalse
  litChar :: Char -> SValue JuliaCode
litChar = (Doc -> Doc) -> Char -> SValue JuliaCode
forall (r :: * -> *).
CommonRenderSym r =>
(Doc -> Doc) -> Char -> SValue r
G.litChar Doc -> Doc
quotes
  litDouble :: Double -> SValue JuliaCode
litDouble = Double -> SValue JuliaCode
forall (r :: * -> *). CommonRenderSym r => Double -> SValue r
G.litDouble
  litFloat :: Float -> SValue JuliaCode
litFloat = Float -> SValue JuliaCode
forall (r :: * -> *). CommonRenderSym r => Float -> SValue r
jlLitFloat
  litInt :: Integer -> SValue JuliaCode
litInt = Integer -> SValue JuliaCode
forall (r :: * -> *). CommonRenderSym r => Integer -> SValue r
G.litInt
  litString :: Label -> SValue JuliaCode
litString = Label -> SValue JuliaCode
forall (r :: * -> *). CommonRenderSym r => Label -> SValue r
G.litString
  litArray :: VSType JuliaCode -> [SValue JuliaCode] -> SValue JuliaCode
litArray = VSType JuliaCode -> [SValue JuliaCode] -> SValue JuliaCode
forall (r :: * -> *).
Literal r =>
VSType r -> [SValue r] -> SValue r
litList
  litList :: VSType JuliaCode -> [SValue JuliaCode] -> SValue JuliaCode
litList = VSType JuliaCode -> [SValue JuliaCode] -> SValue JuliaCode
forall (r :: * -> *).
CommonRenderSym r =>
VSType r -> [SValue r] -> SValue r
jlLitList
  litSet :: VSType JuliaCode -> [SValue JuliaCode] -> SValue JuliaCode
litSet = (Doc -> Doc)
-> (Doc -> Doc)
-> VSType JuliaCode
-> [SValue JuliaCode]
-> SValue JuliaCode
forall (r :: * -> *).
CommonRenderSym r =>
(Doc -> Doc) -> (Doc -> Doc) -> VSType r -> [SValue r] -> SValue r
CP.litSet (Label -> Doc
text Label
"Set" Doc -> Doc -> Doc
<>) (Doc -> Doc
parens (Doc -> Doc) -> (Doc -> Doc) -> Doc -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Doc
brackets)

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

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

instance CommandLineArgs JuliaCode where
  arg :: Integer -> SValue JuliaCode
arg Integer
n = SValue JuliaCode -> SValue JuliaCode -> SValue JuliaCode
forall (r :: * -> *).
CommonRenderSym r =>
SValue r -> SValue r -> SValue r
G.arg (Integer -> SValue JuliaCode
forall (r :: * -> *). Literal r => Integer -> SValue r
litInt (Integer -> SValue JuliaCode) -> Integer -> SValue JuliaCode
forall a b. (a -> b) -> a -> b
$ Integer
nInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
1) SValue JuliaCode
forall (r :: * -> *). CommandLineArgs r => SValue r
argsList
  argsList :: SValue JuliaCode
argsList = Label -> SValue JuliaCode
forall (r :: * -> *). CommonRenderSym r => Label -> SValue r
G.argsList Label
jlArgs
  argExists :: Integer -> SValue JuliaCode
argExists = Integer -> SValue JuliaCode
forall (r :: * -> *). CommonRenderSym r => Integer -> SValue r
CP.argExists

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

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

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

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

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

  funcAppMixedArgs :: MixedCall JuliaCode
funcAppMixedArgs = MixedCall JuliaCode
forall (r :: * -> *). CommonRenderSym r => MixedCall r
G.funcAppMixedArgs
  extFuncAppMixedArgs :: Label -> MixedCall JuliaCode
extFuncAppMixedArgs Label
l Label
n VSType JuliaCode
t [SValue JuliaCode]
ps NamedArgs JuliaCode
ns = do
    (ValueState -> ValueState) -> StateT ValueState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (Label -> ValueState -> ValueState
addModuleImportVS Label
l)
    Label -> MixedCall JuliaCode
forall (r :: * -> *). CommonRenderSym r => Label -> MixedCall r
CP.extFuncAppMixedArgs Label
l Label
n VSType JuliaCode
t [SValue JuliaCode]
ps NamedArgs JuliaCode
ns
  libFuncAppMixedArgs :: Label -> MixedCall JuliaCode
libFuncAppMixedArgs Label
l Label
n VSType JuliaCode
t [SValue JuliaCode]
ps NamedArgs JuliaCode
ns = do
    (ValueState -> ValueState) -> StateT ValueState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (Label -> ValueState -> ValueState
addLibImportVS Label
l)
    Label -> MixedCall JuliaCode
forall (r :: * -> *). CommonRenderSym r => Label -> MixedCall r
CP.extFuncAppMixedArgs Label
l Label
n VSType JuliaCode
t [SValue JuliaCode]
ps NamedArgs JuliaCode
ns

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

  notNull :: SValue JuliaCode -> SValue JuliaCode
notNull = Label -> SValue JuliaCode -> SValue JuliaCode
forall (r :: * -> *).
CommonRenderSym r =>
Label -> SValue r -> SValue r
CP.notNull Label
jlNull

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

  cast :: VSType JuliaCode -> SValue JuliaCode -> SValue JuliaCode
cast = VSType JuliaCode -> SValue JuliaCode -> SValue JuliaCode
forall (r :: * -> *).
CommonRenderSym r =>
VSType r -> SValue r -> SValue r
jlCast

  call :: Maybe Label -> Maybe Doc -> MixedCall JuliaCode
call = Doc -> Maybe Label -> Maybe Doc -> MixedCall JuliaCode
forall (r :: * -> *).
CommonRenderSym r =>
Doc -> Maybe Label -> Maybe Doc -> MixedCall r
G.call Doc
jlNamedArgSep

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

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

instance List JuliaCode where
  intToIndex :: SValue JuliaCode -> SValue JuliaCode
intToIndex = SValue JuliaCode -> SValue JuliaCode
forall (r :: * -> *). CommonRenderSym r => SValue r -> SValue r
CP.intToIndex'
  indexToInt :: SValue JuliaCode -> SValue JuliaCode
indexToInt = SValue JuliaCode -> SValue JuliaCode
forall (r :: * -> *). CommonRenderSym r => SValue r -> SValue r
CP.indexToInt'
  listSize :: SValue JuliaCode -> SValue JuliaCode
listSize = SValue JuliaCode -> SValue JuliaCode
forall (r :: * -> *). CommonRenderSym r => SValue r -> SValue r
CP.listSize
  listAdd :: SValue JuliaCode
-> SValue JuliaCode -> SValue JuliaCode -> SValue JuliaCode
listAdd = SValue JuliaCode
-> SValue JuliaCode -> SValue JuliaCode -> SValue JuliaCode
forall (r :: * -> *).
CommonRenderSym r =>
SValue r -> SValue r -> SValue r -> SValue r
CP.listAdd
  listAppend :: SValue JuliaCode -> SValue JuliaCode -> SValue JuliaCode
listAppend = SValue JuliaCode -> SValue JuliaCode -> SValue JuliaCode
forall (r :: * -> *).
CommonRenderSym r =>
SValue r -> SValue r -> SValue r
CP.listAppend
  listAccess :: SValue JuliaCode -> SValue JuliaCode -> SValue JuliaCode
listAccess = SValue JuliaCode -> SValue JuliaCode -> SValue JuliaCode
forall (r :: * -> *).
CommonRenderSym r =>
SValue r -> SValue r -> SValue r
G.listAccess
  listSet :: SValue JuliaCode
-> SValue JuliaCode -> SValue JuliaCode -> SValue JuliaCode
listSet = SValue JuliaCode
-> SValue JuliaCode -> SValue JuliaCode -> SValue JuliaCode
forall (r :: * -> *).
CommonRenderSym r =>
SValue r -> SValue r -> SValue r -> SValue r
G.listSet
  indexOf :: SValue JuliaCode -> SValue JuliaCode -> SValue JuliaCode
indexOf = SValue JuliaCode -> SValue JuliaCode -> SValue JuliaCode
forall (r :: * -> *).
SharedProg r =>
SValue r -> SValue r -> SValue r
jlIndexOf

instance Set JuliaCode where
  contains :: SValue JuliaCode -> SValue JuliaCode -> SValue JuliaCode
contains SValue JuliaCode
s SValue JuliaCode
e = PosCall JuliaCode
forall (r :: * -> *). ValueExpression r => PosCall r
funcApp Label
"in" VSType JuliaCode
forall (r :: * -> *). TypeSym r => VSType r
bool [SValue JuliaCode
e, SValue JuliaCode
s]
  setAdd :: SValue JuliaCode -> SValue JuliaCode -> SValue JuliaCode
setAdd SValue JuliaCode
s SValue JuliaCode
e = PosCall JuliaCode
forall (r :: * -> *). ValueExpression r => PosCall r
funcApp Label
"push!" VSType JuliaCode
forall (r :: * -> *). TypeSym r => VSType r
void [SValue JuliaCode
s, SValue JuliaCode
e]
  setRemove :: SValue JuliaCode -> SValue JuliaCode -> SValue JuliaCode
setRemove SValue JuliaCode
s SValue JuliaCode
e = PosCall JuliaCode
forall (r :: * -> *). ValueExpression r => PosCall r
funcApp Label
"delete!" VSType JuliaCode
forall (r :: * -> *). TypeSym r => VSType r
void [SValue JuliaCode
s, SValue JuliaCode
e]
  setUnion :: SValue JuliaCode -> SValue JuliaCode -> SValue JuliaCode
setUnion SValue JuliaCode
a SValue JuliaCode
b = PosCall JuliaCode
forall (r :: * -> *). ValueExpression r => PosCall r
funcApp Label
"union!" VSType JuliaCode
forall (r :: * -> *). TypeSym r => VSType r
void [SValue JuliaCode
a, SValue JuliaCode
b]

instance InternalList JuliaCode where
  listSlice' :: Maybe (SValue JuliaCode)
-> Maybe (SValue JuliaCode)
-> Maybe (SValue JuliaCode)
-> SVariable JuliaCode
-> SValue JuliaCode
-> MSBlock JuliaCode
listSlice' Maybe (SValue JuliaCode)
b Maybe (SValue JuliaCode)
e Maybe (SValue JuliaCode)
s SVariable JuliaCode
vn SValue JuliaCode
vo = SVariable JuliaCode
-> SValue JuliaCode
-> Maybe (SValue JuliaCode)
-> Maybe (SValue JuliaCode)
-> SValue JuliaCode
-> MSBlock JuliaCode
forall (r :: * -> *).
CommonRenderSym r =>
SVariable r
-> SValue r
-> Maybe (SValue r)
-> Maybe (SValue r)
-> SValue r
-> MSBlock r
jlListSlice SVariable JuliaCode
vn SValue JuliaCode
vo Maybe (SValue JuliaCode)
b Maybe (SValue JuliaCode)
e (VS (JuliaCode ValData)
-> Maybe (VS (JuliaCode ValData)) -> VS (JuliaCode ValData)
forall a. a -> Maybe a -> a
fromMaybe (Integer -> SValue JuliaCode
forall (r :: * -> *). Literal r => Integer -> SValue r
litInt Integer
1) Maybe (VS (JuliaCode ValData))
Maybe (SValue JuliaCode)
s)

instance InternalListFunc JuliaCode where
  listSizeFunc :: SValue JuliaCode -> VSFunction JuliaCode
listSizeFunc SValue JuliaCode
l = do
    JuliaCode ValData
f <- PosCall JuliaCode
forall (r :: * -> *). ValueExpression r => PosCall r
funcApp Label
jlListSize VSType JuliaCode
forall (r :: * -> *). TypeSym r => VSType r
int [SValue JuliaCode
l]
    Doc -> VSType JuliaCode -> VSFunction JuliaCode
forall (r :: * -> *).
RenderFunction r =>
Doc -> VSType r -> VSFunction r
funcFromData (JuliaCode (Value JuliaCode) -> Doc
forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value JuliaCode ValData
JuliaCode (Value JuliaCode)
f) VSType JuliaCode
forall (r :: * -> *). TypeSym r => VSType r
int
  listAddFunc :: SValue JuliaCode
-> SValue JuliaCode -> SValue JuliaCode -> VSFunction JuliaCode
listAddFunc SValue JuliaCode
l SValue JuliaCode
i SValue JuliaCode
v = do
    JuliaCode ValData
f <- PosCall JuliaCode
forall (r :: * -> *). ValueExpression r => PosCall r
funcApp Label
jlListAdd VSType JuliaCode
forall (r :: * -> *). TypeSym r => VSType r
void [SValue JuliaCode
l, SValue JuliaCode
i, SValue JuliaCode
v]
    Doc -> VSType JuliaCode -> VSFunction JuliaCode
forall (r :: * -> *).
RenderFunction r =>
Doc -> VSType r -> VSFunction r
funcFromData (JuliaCode (Value JuliaCode) -> Doc
forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value JuliaCode ValData
JuliaCode (Value JuliaCode)
f) VSType JuliaCode
forall (r :: * -> *). TypeSym r => VSType r
void
  listAppendFunc :: SValue JuliaCode -> SValue JuliaCode -> VSFunction JuliaCode
listAppendFunc SValue JuliaCode
l SValue JuliaCode
v = do
    JuliaCode ValData
f <- PosCall JuliaCode
forall (r :: * -> *). ValueExpression r => PosCall r
funcApp Label
jlListAppend VSType JuliaCode
forall (r :: * -> *). TypeSym r => VSType r
void [SValue JuliaCode
l, SValue JuliaCode
v]
    Doc -> VSType JuliaCode -> VSFunction JuliaCode
forall (r :: * -> *).
RenderFunction r =>
Doc -> VSType r -> VSFunction r
funcFromData (JuliaCode (Value JuliaCode) -> Doc
forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value JuliaCode ValData
JuliaCode (Value JuliaCode)
f) VSType JuliaCode
forall (r :: * -> *). TypeSym r => VSType r
void
  listAccessFunc :: VSType JuliaCode -> SValue JuliaCode -> VSFunction JuliaCode
listAccessFunc = VSType JuliaCode -> SValue JuliaCode -> VSFunction JuliaCode
forall (r :: * -> *).
CommonRenderSym r =>
VSType r -> SValue r -> VSFunction r
CP.listAccessFunc
  listSetFunc :: SValue JuliaCode
-> SValue JuliaCode -> SValue JuliaCode -> VSFunction JuliaCode
listSetFunc = (Doc -> Doc -> Doc)
-> SValue JuliaCode
-> SValue JuliaCode
-> SValue JuliaCode
-> VSFunction JuliaCode
forall (r :: * -> *).
CommonRenderSym r =>
(Doc -> Doc -> Doc)
-> SValue r -> SValue r -> SValue r -> VSFunction r
CP.listSetFunc Doc -> Doc -> Doc
R.listSetFunc

instance ThunkSym JuliaCode where
  type Thunk JuliaCode = CommonThunk VS

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

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

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

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

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

instance RenderFunction JuliaCode where
  funcFromData :: Doc -> VSType JuliaCode -> VSFunction JuliaCode
funcFromData Doc
d = (JuliaCode (Type JuliaCode) -> JuliaCode (Function JuliaCode))
-> VSType JuliaCode -> VSFunction JuliaCode
forall a b s. (a -> b) -> State s a -> State s b
onStateValue ((JuliaCode (Type JuliaCode) -> JuliaCode (Function JuliaCode))
 -> VSType JuliaCode -> VSFunction JuliaCode)
-> (JuliaCode (Type JuliaCode) -> JuliaCode (Function JuliaCode))
-> VSType JuliaCode
-> VSFunction JuliaCode
forall a b. (a -> b) -> a -> b
$ (TypeData -> FuncData) -> JuliaCode TypeData -> JuliaCode FuncData
forall (r :: * -> *) a b. Functor r => (a -> b) -> r a -> r b
onCodeValue (TypeData -> Doc -> FuncData
`fd` Doc
d)

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

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

instance InternalIOStmt JuliaCode where
  printSt :: Bool
-> Maybe (SValue JuliaCode)
-> SValue JuliaCode
-> SValue JuliaCode
-> MSStatement JuliaCode
printSt = Bool
-> Maybe (SValue JuliaCode)
-> SValue JuliaCode
-> SValue JuliaCode
-> MSStatement JuliaCode
jlPrint

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

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

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

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

instance AssignStatement JuliaCode where
  assign :: SVariable JuliaCode -> SValue JuliaCode -> MSStatement JuliaCode
assign = SVariable JuliaCode -> SValue JuliaCode -> MSStatement JuliaCode
forall (r :: * -> *).
CommonRenderSym r =>
SVariable r -> SValue r -> MSStatement r
jlAssign
  &-= :: SVariable JuliaCode -> SValue JuliaCode -> MSStatement JuliaCode
(&-=) = SVariable JuliaCode -> SValue JuliaCode -> MSStatement JuliaCode
forall (r :: * -> *).
CommonRenderSym r =>
SVariable r -> SValue r -> MSStatement r
jlSubAssign
  &+= :: SVariable JuliaCode -> SValue JuliaCode -> MSStatement JuliaCode
(&+=) = SVariable JuliaCode -> SValue JuliaCode -> MSStatement JuliaCode
forall (r :: * -> *).
CommonRenderSym r =>
SVariable r -> SValue r -> MSStatement r
jlIncrement
  &++ :: SVariable JuliaCode -> MSStatement JuliaCode
(&++) = SVariable JuliaCode -> MSStatement JuliaCode
forall (r :: * -> *).
CommonRenderSym r =>
SVariable r -> MSStatement r
M.increment1
  &-- :: SVariable JuliaCode -> MSStatement JuliaCode
(&--) = SVariable JuliaCode -> MSStatement JuliaCode
forall (r :: * -> *).
CommonRenderSym r =>
SVariable r -> MSStatement r
M.decrement1

instance DeclStatement JuliaCode where
  varDec :: SVariable JuliaCode
-> JuliaCode (Scope JuliaCode) -> MSStatement JuliaCode
varDec SVariable JuliaCode
v JuliaCode (Scope JuliaCode)
scp = SVariable JuliaCode
-> JuliaCode (Scope JuliaCode)
-> Maybe (SValue JuliaCode)
-> MSStatement JuliaCode
forall (r :: * -> *).
CommonRenderSym r =>
SVariable r -> r (Scope r) -> Maybe (SValue r) -> MSStatement r
CP.varDecDef SVariable JuliaCode
v JuliaCode (Scope JuliaCode)
scp Maybe (VS (JuliaCode ValData))
Maybe (SValue JuliaCode)
forall a. Maybe a
Nothing
  varDecDef :: SVariable JuliaCode
-> JuliaCode (Scope JuliaCode)
-> SValue JuliaCode
-> MSStatement JuliaCode
varDecDef SVariable JuliaCode
v JuliaCode (Scope JuliaCode)
scp SValue JuliaCode
e = SVariable JuliaCode
-> JuliaCode (Scope JuliaCode)
-> Maybe (SValue JuliaCode)
-> MSStatement JuliaCode
forall (r :: * -> *).
CommonRenderSym r =>
SVariable r -> r (Scope r) -> Maybe (SValue r) -> MSStatement r
CP.varDecDef SVariable JuliaCode
v JuliaCode (Scope JuliaCode)
scp (VS (JuliaCode ValData) -> Maybe (VS (JuliaCode ValData))
forall a. a -> Maybe a
Just VS (JuliaCode ValData)
SValue JuliaCode
e)
  setDec :: SVariable JuliaCode
-> JuliaCode (Scope JuliaCode) -> MSStatement JuliaCode
setDec = SVariable JuliaCode
-> JuliaCode (Scope JuliaCode) -> MSStatement JuliaCode
forall (r :: * -> *).
DeclStatement r =>
SVariable r -> r (Scope r) -> MSStatement r
varDec
  setDecDef :: SVariable JuliaCode
-> JuliaCode (Scope JuliaCode)
-> SValue JuliaCode
-> MSStatement JuliaCode
setDecDef = SVariable JuliaCode
-> JuliaCode (Scope JuliaCode)
-> SValue JuliaCode
-> MSStatement JuliaCode
forall (r :: * -> *).
DeclStatement r =>
SVariable r -> r (Scope r) -> SValue r -> MSStatement r
varDecDef
  listDec :: Integer
-> SVariable JuliaCode
-> JuliaCode (Scope JuliaCode)
-> MSStatement JuliaCode
listDec Integer
_ = SVariable JuliaCode
-> JuliaCode (Scope JuliaCode) -> MSStatement JuliaCode
forall (r :: * -> *).
CommonRenderSym r =>
SVariable r -> r (Scope r) -> MSStatement r
CP.listDec
  listDecDef :: SVariable JuliaCode
-> JuliaCode (Scope JuliaCode)
-> [SValue JuliaCode]
-> MSStatement JuliaCode
listDecDef = SVariable JuliaCode
-> JuliaCode (Scope JuliaCode)
-> [SValue JuliaCode]
-> MSStatement JuliaCode
forall (r :: * -> *).
CommonRenderSym r =>
SVariable r -> r (Scope r) -> [SValue r] -> MSStatement r
CP.listDecDef
  arrayDec :: Integer
-> SVariable JuliaCode
-> JuliaCode (Scope JuliaCode)
-> MSStatement JuliaCode
arrayDec = Integer
-> SVariable JuliaCode
-> JuliaCode (Scope JuliaCode)
-> MSStatement JuliaCode
forall (r :: * -> *).
DeclStatement r =>
Integer -> SVariable r -> r (Scope r) -> MSStatement r
listDec
  arrayDecDef :: SVariable JuliaCode
-> JuliaCode (Scope JuliaCode)
-> [SValue JuliaCode]
-> MSStatement JuliaCode
arrayDecDef = SVariable JuliaCode
-> JuliaCode (Scope JuliaCode)
-> [SValue JuliaCode]
-> MSStatement JuliaCode
forall (r :: * -> *).
DeclStatement r =>
SVariable r -> r (Scope r) -> [SValue r] -> MSStatement r
listDecDef
  constDecDef :: SVariable JuliaCode
-> JuliaCode (Scope JuliaCode)
-> SValue JuliaCode
-> MSStatement JuliaCode
constDecDef = SVariable JuliaCode
-> JuliaCode (Scope JuliaCode)
-> SValue JuliaCode
-> MSStatement JuliaCode
forall (r :: * -> *).
CommonRenderSym r =>
SVariable r -> r (Scope r) -> SValue r -> MSStatement r
jlConstDecDef
  funcDecDef :: SVariable JuliaCode
-> JuliaCode (Scope JuliaCode)
-> [SVariable JuliaCode]
-> MSBody JuliaCode
-> MSStatement JuliaCode
funcDecDef = SVariable JuliaCode
-> JuliaCode (Scope JuliaCode)
-> [SVariable JuliaCode]
-> MSBody JuliaCode
-> MSStatement JuliaCode
forall (r :: * -> *).
ProcRenderSym r =>
SVariable r
-> r (Scope r) -> [SVariable r] -> MSBody r -> MSStatement r
A.funcDecDef

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

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

  getInput :: SVariable JuliaCode -> MSStatement JuliaCode
getInput = SValue JuliaCode -> SVariable JuliaCode -> MSStatement JuliaCode
jlInput SValue JuliaCode
forall (r :: * -> *). RenderValue r => SValue r
inputFunc
  discardInput :: MSStatement JuliaCode
discardInput = SValue JuliaCode -> MSStatement JuliaCode
forall (r :: * -> *). StatementSym r => SValue r -> MSStatement r
valStmt SValue JuliaCode
forall (r :: * -> *). RenderValue r => SValue r
inputFunc
  getFileInput :: SValue JuliaCode -> SVariable JuliaCode -> MSStatement JuliaCode
getFileInput SValue JuliaCode
f = SValue JuliaCode -> SVariable JuliaCode -> MSStatement JuliaCode
jlInput (SValue JuliaCode -> SValue JuliaCode
forall (r :: * -> *). CommonRenderSym r => SValue r -> SValue r
readLine SValue JuliaCode
f)
  discardFileInput :: SValue JuliaCode -> MSStatement JuliaCode
discardFileInput SValue JuliaCode
f = SValue JuliaCode -> MSStatement JuliaCode
forall (r :: * -> *). StatementSym r => SValue r -> MSStatement r
valStmt (SValue JuliaCode -> SValue JuliaCode
forall (r :: * -> *). CommonRenderSym r => SValue r -> SValue r
readLine SValue JuliaCode
f)
  openFileR :: SVariable JuliaCode -> SValue JuliaCode -> MSStatement JuliaCode
openFileR SVariable JuliaCode
f SValue JuliaCode
n = SVariable JuliaCode
f SVariable JuliaCode -> SValue JuliaCode -> MSStatement JuliaCode
forall (r :: * -> *).
AssignStatement r =>
SVariable r -> SValue r -> MSStatement r
&= SValue JuliaCode -> SValue JuliaCode
forall (r :: * -> *). CommonRenderSym r => SValue r -> SValue r
CP.openFileR' SValue JuliaCode
n
  openFileW :: SVariable JuliaCode -> SValue JuliaCode -> MSStatement JuliaCode
openFileW SVariable JuliaCode
f SValue JuliaCode
n = SVariable JuliaCode
f SVariable JuliaCode -> SValue JuliaCode -> MSStatement JuliaCode
forall (r :: * -> *).
AssignStatement r =>
SVariable r -> SValue r -> MSStatement r
&= SValue JuliaCode -> SValue JuliaCode
forall (r :: * -> *). CommonRenderSym r => SValue r -> SValue r
CP.openFileW' SValue JuliaCode
n
  openFileA :: SVariable JuliaCode -> SValue JuliaCode -> MSStatement JuliaCode
openFileA SVariable JuliaCode
f SValue JuliaCode
n = SVariable JuliaCode
f SVariable JuliaCode -> SValue JuliaCode -> MSStatement JuliaCode
forall (r :: * -> *).
AssignStatement r =>
SVariable r -> SValue r -> MSStatement r
&= SValue JuliaCode -> SValue JuliaCode
forall (r :: * -> *). CommonRenderSym r => SValue r -> SValue r
CP.openFileA' SValue JuliaCode
n
  closeFile :: SValue JuliaCode -> MSStatement JuliaCode
closeFile SValue JuliaCode
f = SValue JuliaCode -> MSStatement JuliaCode
forall (r :: * -> *). StatementSym r => SValue r -> MSStatement r
valStmt (SValue JuliaCode -> MSStatement JuliaCode)
-> SValue JuliaCode -> MSStatement JuliaCode
forall a b. (a -> b) -> a -> b
$ PosCall JuliaCode
forall (r :: * -> *). ValueExpression r => PosCall r
funcApp Label
jlCloseFunc VSType JuliaCode
forall (r :: * -> *). TypeSym r => VSType r
void [SValue JuliaCode
f]
  getFileInputLine :: SValue JuliaCode -> SVariable JuliaCode -> MSStatement JuliaCode
getFileInputLine = SValue JuliaCode -> SVariable JuliaCode -> MSStatement JuliaCode
forall (r :: * -> *).
IOStatement r =>
SValue r -> SVariable r -> MSStatement r
getFileInput
  discardFileLine :: SValue JuliaCode -> MSStatement JuliaCode
discardFileLine = SValue JuliaCode -> MSStatement JuliaCode
forall (r :: * -> *). IOStatement r => SValue r -> MSStatement r
discardFileInput
  getFileInputAll :: SValue JuliaCode -> SVariable JuliaCode -> MSStatement JuliaCode
getFileInputAll SValue JuliaCode
f SVariable JuliaCode
v = SVariable JuliaCode
v SVariable JuliaCode -> SValue JuliaCode -> MSStatement JuliaCode
forall (r :: * -> *).
AssignStatement r =>
SVariable r -> SValue r -> MSStatement r
&= SValue JuliaCode -> SValue JuliaCode
forall (r :: * -> *). CommonRenderSym r => SValue r -> SValue r
readLines SValue JuliaCode
f

instance StringStatement JuliaCode where
  stringSplit :: Char
-> SVariable JuliaCode -> SValue JuliaCode -> MSStatement JuliaCode
stringSplit Char
d SVariable JuliaCode
vnew SValue JuliaCode
s = SVariable JuliaCode
vnew SVariable JuliaCode -> SValue JuliaCode -> MSStatement JuliaCode
forall (r :: * -> *).
AssignStatement r =>
SVariable r -> SValue r -> MSStatement r
&= PosCall JuliaCode
forall (r :: * -> *). ValueExpression r => PosCall r
funcApp Label
jlSplit (VSType JuliaCode -> VSType JuliaCode
forall (r :: * -> *). TypeSym r => VSType r -> VSType r
listType VSType JuliaCode
forall (r :: * -> *). TypeSym r => VSType r
string) [SValue JuliaCode
s, Label -> SValue JuliaCode
forall (r :: * -> *). Literal r => Label -> SValue r
litString [Char
d]]
  stringListVals :: [SVariable JuliaCode] -> SValue JuliaCode -> MSStatement JuliaCode
stringListVals = [SVariable JuliaCode] -> SValue JuliaCode -> MSStatement JuliaCode
forall (r :: * -> *).
CommonRenderSym r =>
[SVariable r] -> SValue r -> MSStatement r
M.stringListVals
  stringListLists :: [SVariable JuliaCode] -> SValue JuliaCode -> MSStatement JuliaCode
stringListLists = [SVariable JuliaCode] -> SValue JuliaCode -> MSStatement JuliaCode
forall (r :: * -> *).
CommonRenderSym r =>
[SVariable r] -> SValue r -> MSStatement r
M.stringListLists

instance FunctionSym JuliaCode where
  type Function JuliaCode = FuncData

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

instance CommentStatement JuliaCode where
  comment :: Label -> MSStatement JuliaCode
comment = Doc -> Label -> MSStatement JuliaCode
forall (r :: * -> *).
CommonRenderSym r =>
Doc -> Label -> MSStatement r
G.comment Doc
jlCmtStart

instance ControlStatement JuliaCode where
  break :: MSStatement JuliaCode
break = Doc -> MSStatement JuliaCode
forall (r :: * -> *). CommonRenderSym r => Doc -> MSStatement r
mkStmtNoEnd Doc
R.break
  continue :: MSStatement JuliaCode
continue = Doc -> MSStatement JuliaCode
forall (r :: * -> *). CommonRenderSym r => Doc -> MSStatement r
mkStmtNoEnd Doc
R.continue
  returnStmt :: SValue JuliaCode -> MSStatement JuliaCode
returnStmt = Terminator -> SValue JuliaCode -> MSStatement JuliaCode
forall (r :: * -> *).
CommonRenderSym r =>
Terminator -> SValue r -> MSStatement r
G.returnStmt Terminator
Empty
  throw :: Label -> MSStatement JuliaCode
throw = (JuliaCode (Value JuliaCode) -> Doc)
-> Terminator -> Label -> MSStatement JuliaCode
forall (r :: * -> *).
CommonRenderSym r =>
(r (Value r) -> Doc) -> Terminator -> Label -> MSStatement r
G.throw JuliaCode (Value JuliaCode) -> Doc
forall (r :: * -> *). CommonRenderSym r => r (Value r) -> Doc
jlThrow Terminator
Empty
  ifCond :: [(SValue JuliaCode, MSBody JuliaCode)]
-> MSBody JuliaCode -> MSStatement JuliaCode
ifCond = (Doc -> Doc)
-> Doc
-> OptionalSpace
-> Doc
-> Doc
-> Doc
-> [(SValue JuliaCode, MSBody JuliaCode)]
-> MSBody JuliaCode
-> MSStatement JuliaCode
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
empty OptionalSpace
jlSpace Doc
elseIfLabel Doc
empty Doc
jlEnd
  switch :: SValue JuliaCode
-> [(SValue JuliaCode, MSBody JuliaCode)]
-> MSBody JuliaCode
-> MSStatement JuliaCode
switch = SValue JuliaCode
-> [(SValue JuliaCode, MSBody JuliaCode)]
-> MSBody JuliaCode
-> MSStatement JuliaCode
forall (r :: * -> *).
(ControlStatement r, Comparison r) =>
SValue r -> [(SValue r, MSBody r)] -> MSBody r -> MSStatement r
switchAsIf
  ifExists :: SValue JuliaCode
-> MSBody JuliaCode -> MSBody JuliaCode -> MSStatement JuliaCode
ifExists = SValue JuliaCode
-> MSBody JuliaCode -> MSBody JuliaCode -> MSStatement JuliaCode
forall (r :: * -> *).
CommonRenderSym r =>
SValue r -> MSBody r -> MSBody r -> MSStatement r
M.ifExists
  for :: MSStatement JuliaCode
-> SValue JuliaCode
-> MSStatement JuliaCode
-> MSBody JuliaCode
-> MSStatement JuliaCode
for MSStatement JuliaCode
_ SValue JuliaCode
_ MSStatement JuliaCode
_ MSBody JuliaCode
_ = Label -> MSStatement JuliaCode
forall a. HasCallStack => Label -> a
error (Label -> MSStatement JuliaCode) -> Label -> MSStatement JuliaCode
forall a b. (a -> b) -> a -> b
$ Label -> Label
CP.forLoopError Label
jlName
  forRange :: SVariable JuliaCode
-> SValue JuliaCode
-> SValue JuliaCode
-> SValue JuliaCode
-> MSBody JuliaCode
-> MSStatement JuliaCode
forRange SVariable JuliaCode
i SValue JuliaCode
initv SValue JuliaCode
finalv SValue JuliaCode
stepv = SVariable JuliaCode
-> SValue JuliaCode -> MSBody JuliaCode -> MSStatement JuliaCode
forall (r :: * -> *).
ControlStatement r =>
SVariable r -> SValue r -> MSBody r -> MSStatement r
forEach SVariable JuliaCode
i (SValue JuliaCode
-> SValue JuliaCode -> SValue JuliaCode -> SValue JuliaCode
forall (r :: * -> *).
CommonRenderSym r =>
SValue r -> SValue r -> SValue r -> SValue r
jlRange SValue JuliaCode
initv SValue JuliaCode
finalv SValue JuliaCode
stepv)
  forEach :: SVariable JuliaCode
-> SValue JuliaCode -> MSBody JuliaCode -> MSStatement JuliaCode
forEach = (JuliaCode (Variable JuliaCode)
 -> JuliaCode (Value JuliaCode)
 -> JuliaCode (Body JuliaCode)
 -> Doc)
-> SVariable JuliaCode
-> SValue JuliaCode
-> MSBody JuliaCode
-> MSStatement JuliaCode
forall (r :: * -> *).
CommonRenderSym r =>
(r (Variable r) -> r (Value r) -> r (Body r) -> Doc)
-> SVariable r -> SValue r -> MSBody r -> MSStatement r
CP.forEach' JuliaCode (Variable JuliaCode)
-> JuliaCode (Value JuliaCode) -> JuliaCode (Body JuliaCode) -> Doc
forall (r :: * -> *).
CommonRenderSym r =>
r (Variable r) -> r (Value r) -> r (Body r) -> Doc
jlForEach
  while :: SValue JuliaCode -> MSBody JuliaCode -> MSStatement JuliaCode
while = (Doc -> Doc)
-> Doc
-> Doc
-> SValue JuliaCode
-> MSBody JuliaCode
-> MSStatement JuliaCode
forall (r :: * -> *).
CommonRenderSym r =>
(Doc -> Doc) -> Doc -> Doc -> SValue r -> MSBody r -> MSStatement r
C.while Doc -> Doc
forall a. a -> a
id Doc
empty Doc
jlEnd
  tryCatch :: MSBody JuliaCode -> MSBody JuliaCode -> MSStatement JuliaCode
tryCatch = (JuliaCode (Body JuliaCode) -> JuliaCode (Body JuliaCode) -> Doc)
-> MSBody JuliaCode -> MSBody JuliaCode -> MSStatement JuliaCode
forall (r :: * -> *).
CommonRenderSym r =>
(r (Body r) -> r (Body r) -> Doc)
-> MSBody r -> MSBody r -> MSStatement r
G.tryCatch JuliaCode (Body JuliaCode) -> JuliaCode (Body JuliaCode) -> Doc
forall (r :: * -> *).
CommonRenderSym r =>
r (Body r) -> r (Body r) -> Doc
jlTryCatch
  assert :: SValue JuliaCode -> SValue JuliaCode -> MSStatement JuliaCode
assert SValue JuliaCode
condition SValue JuliaCode
errorMessage = do
    JuliaCode ValData
cond <- LensLike'
  (Zoomed (StateT ValueState Identity) (JuliaCode ValData))
  MethodState
  ValueState
-> VS (JuliaCode ValData)
-> StateT MethodState Identity (JuliaCode 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) (JuliaCode ValData))
  MethodState
  ValueState
(ValueState -> Focusing Identity (JuliaCode ValData) ValueState)
-> MethodState -> Focusing Identity (JuliaCode ValData) MethodState
Lens' MethodState ValueState
lensMStoVS VS (JuliaCode ValData)
SValue JuliaCode
condition
    JuliaCode ValData
errMsg <- LensLike'
  (Zoomed (StateT ValueState Identity) (JuliaCode ValData))
  MethodState
  ValueState
-> VS (JuliaCode ValData)
-> StateT MethodState Identity (JuliaCode 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) (JuliaCode ValData))
  MethodState
  ValueState
(ValueState -> Focusing Identity (JuliaCode ValData) ValueState)
-> MethodState -> Focusing Identity (JuliaCode ValData) MethodState
Lens' MethodState ValueState
lensMStoVS VS (JuliaCode ValData)
SValue JuliaCode
errorMessage
    Doc -> MSStatement JuliaCode
forall (r :: * -> *). CommonRenderSym r => Doc -> MSStatement r
mkStmtNoEnd (JuliaCode (Value JuliaCode) -> JuliaCode (Value JuliaCode) -> Doc
forall (r :: * -> *).
CommonRenderSym r =>
r (Value r) -> r (Value r) -> Doc
jlAssert JuliaCode ValData
JuliaCode (Value JuliaCode)
cond JuliaCode ValData
JuliaCode (Value JuliaCode)
errMsg)

instance VisibilitySym JuliaCode where
  type Visibility JuliaCode = Doc

  private :: JuliaCode (Visibility JuliaCode)
private = Doc -> JuliaCode Doc
forall (r :: * -> *) a. Monad r => a -> r a
toCode Doc
empty -- Julia doesn't have private/public members
  public :: JuliaCode (Visibility JuliaCode)
public = Doc -> JuliaCode Doc
forall (r :: * -> *) a. Monad r => a -> r a
toCode Doc
empty

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

instance VisibilityElim JuliaCode where
  visibility :: JuliaCode (Visibility JuliaCode) -> Doc
visibility = JuliaCode Doc -> Doc
JuliaCode (Visibility JuliaCode) -> Doc
forall a. JuliaCode a -> a
unJLC

instance MethodTypeSym JuliaCode where
  type MethodType JuliaCode = TypeData

  mType :: VSType JuliaCode -> MSMthdType JuliaCode
mType = LensLike'
  (Zoomed (StateT ValueState Identity) (JuliaCode TypeData))
  MethodState
  ValueState
-> StateT ValueState Identity (JuliaCode TypeData)
-> StateT MethodState Identity (JuliaCode 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) (JuliaCode TypeData))
  MethodState
  ValueState
(ValueState -> Focusing Identity (JuliaCode TypeData) ValueState)
-> MethodState
-> Focusing Identity (JuliaCode TypeData) MethodState
Lens' MethodState ValueState
lensMStoVS

instance ParameterSym JuliaCode where
  type Parameter JuliaCode = ParamData

  param :: SVariable JuliaCode -> MSParameter JuliaCode
param = (JuliaCode (Variable JuliaCode) -> Doc)
-> SVariable JuliaCode -> MSParameter JuliaCode
forall (r :: * -> *).
CommonRenderSym r =>
(r (Variable r) -> Doc) -> SVariable r -> MSParameter r
G.param JuliaCode (Variable JuliaCode) -> Doc
forall (r :: * -> *). CommonRenderSym r => r (Variable r) -> Doc
jlParam
  pointerParam :: SVariable JuliaCode -> MSParameter JuliaCode
pointerParam = SVariable JuliaCode -> MSParameter JuliaCode
forall (r :: * -> *).
ParameterSym r =>
SVariable r -> MSParameter r
param

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

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

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

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

instance RenderMethod JuliaCode where
  commentedFunc :: MS (JuliaCode (BlockComment JuliaCode))
-> SMethod JuliaCode -> SMethod JuliaCode
commentedFunc MS (JuliaCode (BlockComment JuliaCode))
cmt SMethod JuliaCode
m = (JuliaCode MethodData
 -> JuliaCode (Doc -> Doc) -> JuliaCode MethodData)
-> State MethodState (JuliaCode MethodData)
-> State MethodState (JuliaCode (Doc -> Doc))
-> State MethodState (JuliaCode MethodData)
forall a b c s.
(a -> b -> c) -> State s a -> State s b -> State s c
on2StateValues ((MethodData -> (Doc -> Doc) -> MethodData)
-> JuliaCode MethodData
-> JuliaCode (Doc -> Doc)
-> JuliaCode 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 (JuliaCode MethodData)
SMethod JuliaCode
m
    ((JuliaCode Doc -> JuliaCode (Doc -> Doc))
-> State MethodState (JuliaCode Doc)
-> State MethodState (JuliaCode (Doc -> Doc))
forall a b s. (a -> b) -> State s a -> State s b
onStateValue ((Doc -> Doc -> Doc) -> JuliaCode Doc -> JuliaCode (Doc -> Doc)
forall (r :: * -> *) a b. Functor r => (a -> b) -> r a -> r b
onCodeValue Doc -> Doc -> Doc
R.commentedItem) State MethodState (JuliaCode Doc)
MS (JuliaCode (BlockComment JuliaCode))
cmt)
  mthdFromData :: VisibilityTag -> Doc -> SMethod JuliaCode
mthdFromData VisibilityTag
_ Doc
d = JuliaCode (Method JuliaCode) -> SMethod JuliaCode
forall a s. a -> State s a
toState (JuliaCode (Method JuliaCode) -> SMethod JuliaCode)
-> JuliaCode (Method JuliaCode) -> SMethod JuliaCode
forall a b. (a -> b) -> a -> b
$ MethodData -> JuliaCode MethodData
forall (r :: * -> *) a. Monad r => a -> r a
toCode (MethodData -> JuliaCode MethodData)
-> MethodData -> JuliaCode MethodData
forall a b. (a -> b) -> a -> b
$ Doc -> MethodData
mthd Doc
d

instance ProcRenderMethod JuliaCode where
  intFunc :: Bool
-> Label
-> JuliaCode (Visibility JuliaCode)
-> MSMthdType JuliaCode
-> [MSParameter JuliaCode]
-> MSBody JuliaCode
-> SMethod JuliaCode
intFunc Bool
_ Label
n JuliaCode (Visibility JuliaCode)
_ MSMthdType JuliaCode
_ [MSParameter JuliaCode]
ps MSBody JuliaCode
b = do
    [JuliaCode ParamData]
pms <- [State MethodState (JuliaCode ParamData)]
-> StateT MethodState Identity [JuliaCode 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 (JuliaCode ParamData)]
[MSParameter JuliaCode]
ps
    MethodData -> JuliaCode MethodData
forall (r :: * -> *) a. Monad r => a -> r a
toCode (MethodData -> JuliaCode MethodData)
-> (JuliaCode (Body JuliaCode) -> MethodData)
-> JuliaCode (Body JuliaCode)
-> JuliaCode MethodData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> MethodData
mthd (Doc -> MethodData)
-> (JuliaCode (Body JuliaCode) -> Doc)
-> JuliaCode (Body JuliaCode)
-> MethodData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Label
-> [JuliaCode (Parameter JuliaCode)]
-> JuliaCode (Body JuliaCode)
-> Doc
forall (r :: * -> *).
CommonRenderSym r =>
Label -> [r (Parameter r)] -> r (Body r) -> Doc
jlIntFunc Label
n [JuliaCode ParamData]
[JuliaCode (Parameter JuliaCode)]
pms (JuliaCode (Body JuliaCode) -> JuliaCode MethodData)
-> MSBody JuliaCode -> State MethodState (JuliaCode MethodData)
forall (r :: * -> *) a b. Functor r => (a -> b) -> r a -> r b
<$> MSBody JuliaCode
b

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

instance ModuleSym JuliaCode where
  type Module JuliaCode = ModData
  buildModule :: Label -> [Label] -> [SMethod JuliaCode] -> FSModule JuliaCode
buildModule Label
n [Label]
is [SMethod JuliaCode]
fs = Label -> [Label] -> [SMethod JuliaCode] -> FSModule JuliaCode
jlModContents Label
n [Label]
is [SMethod JuliaCode]
fs StateT FileState Identity (JuliaCode ModData)
-> (JuliaCode ModData -> JuliaCode ModData)
-> StateT FileState Identity (JuliaCode ModData)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&>
    (Doc -> Doc)
-> JuliaCode (Module JuliaCode) -> JuliaCode (Module JuliaCode)
forall (r :: * -> *).
RenderMod r =>
(Doc -> Doc) -> r (Module r) -> r (Module r)
updateModuleDoc (\Doc
m -> Doc -> Doc -> Doc
emptyIfEmpty Doc
m ([Doc] -> Doc
vibcat [Label -> Doc
jlModStart Label
n, Doc
m, Doc
jlEnd]))

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

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

instance BlockCommentSym JuliaCode where
  type BlockComment JuliaCode = Doc

  blockComment :: [Label] -> JuliaCode (BlockComment JuliaCode)
blockComment [Label]
lns = Doc -> JuliaCode Doc
forall (r :: * -> *) a. Monad r => a -> r a
toCode (Doc -> JuliaCode Doc) -> Doc -> JuliaCode Doc
forall a b. (a -> b) -> a -> b
$ [Label] -> Doc -> Doc -> Doc
R.blockCmt [Label]
lns Doc
jlBlockCmtStart Doc
jlBlockCmtEnd
  docComment :: forall a.
State a [Label] -> State a (JuliaCode (BlockComment JuliaCode))
docComment = ([Label] -> JuliaCode Doc)
-> StateT a Identity [Label] -> State a (JuliaCode Doc)
forall a b s. (a -> b) -> State s a -> State s b
onStateValue (\[Label]
lns -> Doc -> JuliaCode Doc
forall (r :: * -> *) a. Monad r => a -> r a
toCode (Doc -> JuliaCode Doc) -> Doc -> JuliaCode Doc
forall a b. (a -> b) -> a -> b
$ [Label] -> Doc -> Doc -> Doc
R.docCmt [Label]
lns Doc
jlDocCmtStart
    Doc
jlDocCmtEnd)

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

-- convenience
jlName, jlVersion :: String
jlName :: Label
jlName = Label
"Julia"
jlVersion :: Label
jlVersion = Label
"1.10.3"

-- Concrete versions of each Julia datatype
jlIntConc, jlFloatConc, jlDoubleConc, jlCharConc, jlStringConc, jlListConc,
  jlSetConc, jlFile, jlVoid :: String
jlIntConc :: Label
jlIntConc = Label
"Int64"
jlFloatConc :: Label
jlFloatConc = Label
"Float32"
jlDoubleConc :: Label
jlDoubleConc = Label
"Float64"
jlCharConc :: Label
jlCharConc = Label
"Char"
jlStringConc :: Label
jlStringConc = Label
"String"
jlListConc :: Label
jlListConc = Label
"Array"
jlSetConc :: Label
jlSetConc = Label
"Set"
jlFile :: Label
jlFile = Label
"IOStream"
jlVoid :: Label
jlVoid = Label
"Nothing"

jlClassError :: String
jlClassError :: Label
jlClassError = Label
"Classes are not supported in Julia"

-- The only consistent way of creating floats is by casting
jlLitFloat :: (CommonRenderSym r) => Float -> SValue r
jlLitFloat :: forall (r :: * -> *). CommonRenderSym r => Float -> SValue r
jlLitFloat Float
f = VSType r -> Doc -> StateT ValueState Identity (r (Value r))
forall (r :: * -> *).
CommonRenderSym r =>
VSType r -> Doc -> SValue r
mkStateVal VSType r
forall (r :: * -> *). TypeSym r => VSType r
float (Label -> Doc
text Label
jlFloatConc Doc -> Doc -> Doc
<> Doc -> Doc
parens (Float -> Doc
D.float Float
f))

jlLitList :: (CommonRenderSym r) => VSType r -> [SValue r] -> SValue r
jlLitList :: forall (r :: * -> *).
CommonRenderSym r =>
VSType r -> [SValue r] -> SValue r
jlLitList VSType r
t' [SValue r]
es = do
  r (Type r)
t <- VSType r
t'
  let lt' :: VSType r
lt' = VSType r -> VSType r
forall (r :: * -> *). TypeSym r => VSType r -> VSType r
listType VSType r
t'
  [r (Value r)]
elems <- [SValue r] -> StateT ValueState Identity [r (Value 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 [SValue r]
es
  let typeDec :: Doc
typeDec = if [SValue r] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SValue r]
es then r (Type r) -> Doc
forall (r :: * -> *). InternalTypeElim r => r (Type r) -> Doc
RC.type' r (Type r)
t else Doc
empty
  VSType r -> Doc -> SValue r
forall (r :: * -> *).
CommonRenderSym r =>
VSType r -> Doc -> SValue r
mkStateVal VSType r
lt' (Doc
typeDec Doc -> Doc -> Doc
<> Doc -> Doc
brackets ([r (Value r)] -> Doc
forall (r :: * -> *). CommonRenderSym r => [r (Value r)] -> Doc
valueList [r (Value r)]
elems))

jlCast :: (CommonRenderSym r) => VSType r -> SValue r -> SValue r
jlCast :: forall (r :: * -> *).
CommonRenderSym r =>
VSType r -> SValue r -> SValue r
jlCast VSType r
t' SValue r
v' = do
  r (Type r)
t <- VSType r
t'
  r (Value r)
v <- SValue r
v'
  let vTp :: CodeType
vTp = 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)
v
      tTp :: CodeType
tTp = r (Type r) -> CodeType
forall (r :: * -> *). TypeElim r => r (Type r) -> CodeType
getType r (Type r)
t
      vDoc :: Doc
vDoc = r (Value r) -> Doc
forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value r (Value r)
v
      tDoc :: Doc
tDoc = r (Type r) -> Doc
forall (r :: * -> *). InternalTypeElim r => r (Type r) -> Doc
RC.type' r (Type r)
t
      jlCast' :: CodeType -> CodeType -> Doc -> Doc -> Doc
      -- Converting string to char
      jlCast' :: CodeType -> CodeType -> Doc -> Doc -> Doc
jlCast' CodeType
String CodeType
Char Doc
vDoc' Doc
_ = Label -> Doc
text Label
"only" Doc -> Doc -> Doc
<> Doc -> Doc
parens Doc
vDoc'
      -- Converting string to something else
      jlCast' CodeType
String CodeType
_    Doc
vDoc' Doc
tDoc' = Label -> Doc
text Label
"parse" Doc -> Doc -> Doc
<> Doc -> Doc
parens (Doc
tDoc' Doc -> Doc -> Doc
<> Doc
listSep' Doc -> Doc -> Doc
<+> Doc
vDoc')
      -- Converting non-string to char
      jlCast' CodeType
_      CodeType
Char Doc
vDoc' Doc
_ = Label -> Doc
text Label
"only" Doc -> Doc -> Doc
<> Doc -> Doc
parens (Label -> Doc
text Label
"string" Doc -> Doc -> Doc
<> Doc -> Doc
parens Doc
vDoc')
      -- Converting something to string
      jlCast' CodeType
_      CodeType
String Doc
vDoc' Doc
_ = Label -> Doc
text Label
"string" Doc -> Doc -> Doc
<> Doc -> Doc
parens Doc
vDoc'
      -- Converting non-string to non-string
      jlCast' CodeType
_      CodeType
_    Doc
vDoc' Doc
tDoc' = Doc
tDoc' Doc -> Doc -> Doc
<> Doc -> Doc
parens Doc
vDoc'
  r (Type r) -> Doc -> SValue r
forall (r :: * -> *).
CommonRenderSym r =>
r (Type r) -> Doc -> SValue r
mkVal r (Type r)
t (CodeType -> CodeType -> Doc -> Doc -> Doc
jlCast' CodeType
vTp CodeType
tTp Doc
vDoc Doc
tDoc)

jlAssign :: (CommonRenderSym r) => SVariable r -> SValue r -> MSStatement r
jlAssign :: forall (r :: * -> *).
CommonRenderSym r =>
SVariable r -> SValue r -> MSStatement r
jlAssign SVariable r
vr' SValue r
v' = do
  r (Variable r)
vr <- LensLike'
  (Zoomed (StateT ValueState Identity) (r (Variable r)))
  MethodState
  ValueState
-> SVariable r -> StateT MethodState Identity (r (Variable r))
forall c.
LensLike'
  (Zoomed (StateT ValueState Identity) c) MethodState ValueState
-> StateT ValueState Identity c -> StateT MethodState Identity c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (StateT ValueState Identity) (r (Variable r)))
  MethodState
  ValueState
(ValueState -> Focusing Identity (r (Variable r)) ValueState)
-> MethodState -> Focusing Identity (r (Variable r)) MethodState
Lens' MethodState ValueState
lensMStoVS SVariable r
vr'
  r (Value 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'
  ScopeData
scpData <- Label -> MS ScopeData
getVarScope (r (Variable r) -> Label
forall (r :: * -> *). VariableElim r => r (Variable r) -> Label
variableName r (Variable r)
vr) -- Need to do global declarations
  Doc -> MSStatement r
forall (r :: * -> *). CommonRenderSym r => Doc -> MSStatement r
mkStmtNoEnd (Doc -> MSStatement r) -> Doc -> MSStatement r
forall a b. (a -> b) -> a -> b
$ ScopeData -> Doc
jlGlobalDec ScopeData
scpData Doc -> Doc -> Doc
<+> r (Variable r) -> r (Value r) -> Doc
forall (r :: * -> *).
CommonRenderSym r =>
r (Variable r) -> r (Value r) -> Doc
R.assign r (Variable r)
vr r (Value r)
v

jlSubAssign :: (CommonRenderSym r) => SVariable r -> SValue r -> MSStatement r
jlSubAssign :: forall (r :: * -> *).
CommonRenderSym r =>
SVariable r -> SValue r -> MSStatement r
jlSubAssign SVariable r
vr' SValue r
v' = do
  r (Variable r)
vr <- LensLike'
  (Zoomed (StateT ValueState Identity) (r (Variable r)))
  MethodState
  ValueState
-> SVariable r -> StateT MethodState Identity (r (Variable r))
forall c.
LensLike'
  (Zoomed (StateT ValueState Identity) c) MethodState ValueState
-> StateT ValueState Identity c -> StateT MethodState Identity c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (StateT ValueState Identity) (r (Variable r)))
  MethodState
  ValueState
(ValueState -> Focusing Identity (r (Variable r)) ValueState)
-> MethodState -> Focusing Identity (r (Variable r)) MethodState
Lens' MethodState ValueState
lensMStoVS SVariable r
vr'
  r (Value 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'
  ScopeData
scpData <- Label -> MS ScopeData
getVarScope (r (Variable r) -> Label
forall (r :: * -> *). VariableElim r => r (Variable r) -> Label
variableName r (Variable r)
vr) -- Need to do global declarations
  Doc -> MSStatement r
forall (r :: * -> *). CommonRenderSym r => Doc -> MSStatement r
mkStmtNoEnd (Doc -> MSStatement r) -> Doc -> MSStatement r
forall a b. (a -> b) -> a -> b
$ ScopeData -> Doc
jlGlobalDec ScopeData
scpData Doc -> Doc -> Doc
<+> r (Variable r) -> r (Value r) -> Doc
forall (r :: * -> *).
CommonRenderSym r =>
r (Variable r) -> r (Value r) -> Doc
R.subAssign r (Variable r)
vr r (Value r)
v

jlIncrement :: (CommonRenderSym r) => SVariable r -> SValue r -> MSStatement r
jlIncrement :: forall (r :: * -> *).
CommonRenderSym r =>
SVariable r -> SValue r -> MSStatement r
jlIncrement SVariable r
vr' SValue r
v'= do
  r (Variable r)
vr <- LensLike'
  (Zoomed (StateT ValueState Identity) (r (Variable r)))
  MethodState
  ValueState
-> SVariable r -> StateT MethodState Identity (r (Variable r))
forall c.
LensLike'
  (Zoomed (StateT ValueState Identity) c) MethodState ValueState
-> StateT ValueState Identity c -> StateT MethodState Identity c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (StateT ValueState Identity) (r (Variable r)))
  MethodState
  ValueState
(ValueState -> Focusing Identity (r (Variable r)) ValueState)
-> MethodState -> Focusing Identity (r (Variable r)) MethodState
Lens' MethodState ValueState
lensMStoVS SVariable r
vr'
  r (Value 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'
  ScopeData
scpData <- Label -> MS ScopeData
getVarScope (r (Variable r) -> Label
forall (r :: * -> *). VariableElim r => r (Variable r) -> Label
variableName r (Variable r)
vr) -- Need to do global declarations
  Doc -> MSStatement r
forall (r :: * -> *). CommonRenderSym r => Doc -> MSStatement r
mkStmt (Doc -> MSStatement r) -> Doc -> MSStatement r
forall a b. (a -> b) -> a -> b
$ ScopeData -> Doc
jlGlobalDec ScopeData
scpData Doc -> Doc -> Doc
<+> r (Variable r) -> r (Value r) -> Doc
forall (r :: * -> *).
CommonRenderSym r =>
r (Variable r) -> r (Value r) -> Doc
R.addAssign r (Variable r)
vr r (Value r)
v

jlGlobalDec :: ScopeData -> Doc
jlGlobalDec :: ScopeData -> Doc
jlGlobalDec ScopeData
scp = if ScopeData -> ScopeTag
scopeTag ScopeData
scp ScopeTag -> ScopeTag -> Bool
forall a. Eq a => a -> a -> Bool
== ScopeTag
Global then Doc
jlGlobal else Doc
empty

jlGlobal :: Doc
jlGlobal :: Doc
jlGlobal = Label -> Doc
text Label
"global"

jlConstDecDef :: (CommonRenderSym r) => SVariable r -> r (Scope r) -> SValue r
  -> MSStatement r
jlConstDecDef :: forall (r :: * -> *).
CommonRenderSym r =>
SVariable r -> r (Scope r) -> SValue r -> MSStatement r
jlConstDecDef SVariable r
v' r (Scope r)
scp SValue r
def' = do
  let scpData :: ScopeData
scpData = r (Scope r) -> ScopeData
forall (r :: * -> *). ScopeElim r => r (Scope r) -> ScopeData
scopeData r (Scope r)
scp
  r (Variable r)
v <- LensLike'
  (Zoomed (StateT ValueState Identity) (r (Variable r)))
  MethodState
  ValueState
-> SVariable r -> StateT MethodState Identity (r (Variable r))
forall c.
LensLike'
  (Zoomed (StateT ValueState Identity) c) MethodState ValueState
-> StateT ValueState Identity c -> StateT MethodState Identity c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (StateT ValueState Identity) (r (Variable r)))
  MethodState
  ValueState
(ValueState -> Focusing Identity (r (Variable r)) ValueState)
-> MethodState -> Focusing Identity (r (Variable r)) MethodState
Lens' MethodState ValueState
lensMStoVS SVariable r
v'
  r (Value r)
def <- LensLike'
  (Zoomed (StateT ValueState Identity) (r (Value r)))
  MethodState
  ValueState
-> SValue r -> StateT MethodState Identity (r (Value r))
forall c.
LensLike'
  (Zoomed (StateT ValueState Identity) c) MethodState ValueState
-> StateT ValueState Identity c -> StateT MethodState Identity c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (StateT ValueState Identity) (r (Value r)))
  MethodState
  ValueState
(ValueState -> Focusing Identity (r (Value r)) ValueState)
-> MethodState -> Focusing Identity (r (Value r)) MethodState
Lens' MethodState ValueState
lensMStoVS SValue r
def'
  (MethodState -> MethodState) -> StateT MethodState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((MethodState -> MethodState) -> StateT MethodState Identity ())
-> (MethodState -> MethodState) -> StateT MethodState Identity ()
forall a b. (a -> b) -> a -> b
$ Label -> MethodState -> MethodState
useVarName (Label -> MethodState -> MethodState)
-> Label -> MethodState -> MethodState
forall a b. (a -> b) -> a -> b
$ r (Variable r) -> Label
forall (r :: * -> *). VariableElim r => r (Variable r) -> Label
variableName r (Variable r)
v
  (MethodState -> MethodState) -> StateT MethodState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((MethodState -> MethodState) -> StateT MethodState Identity ())
-> (MethodState -> MethodState) -> StateT MethodState Identity ()
forall a b. (a -> b) -> a -> b
$ Label -> ScopeData -> MethodState -> MethodState
setVarScope (r (Variable r) -> Label
forall (r :: * -> *). VariableElim r => r (Variable r) -> Label
variableName r (Variable r)
v) ScopeData
scpData
  let decDoc :: Doc
decDoc = if ScopeData -> ScopeTag
scopeTag ScopeData
scpData ScopeTag -> ScopeTag -> Bool
forall a. Eq a => a -> a -> Bool
== ScopeTag
Global then Doc
R.constDec' else Doc
empty
  Doc -> MSStatement r
forall (r :: * -> *). CommonRenderSym r => Doc -> MSStatement r
mkStmt (Doc -> MSStatement r) -> Doc -> MSStatement r
forall a b. (a -> b) -> a -> b
$ Doc
decDoc Doc -> Doc -> Doc
<+> r (Variable r) -> Doc
forall (r :: * -> *). InternalVarElim r => r (Variable r) -> Doc
RC.variable r (Variable r)
v Doc -> Doc -> Doc
<+> Doc
equals Doc -> Doc -> Doc
<+> r (Value r) -> Doc
forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value r (Value r)
def

-- List API
jlListSize, jlListAdd, jlListAppend, jlListAbsdex :: Label
jlListSize :: Label
jlListSize   = Label
"length"
jlListAdd :: Label
jlListAdd    = Label
"insert!"
jlListAppend :: Label
jlListAppend = Label
"append!"
jlListAbsdex :: Label
jlListAbsdex = Label
"findfirst"

jlIndexOf :: (SharedProg r) => SValue r -> SValue r -> SValue r
jlIndexOf :: forall (r :: * -> *).
SharedProg r =>
SValue r -> SValue r -> SValue r
jlIndexOf 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 (r :: * -> *) a. Monad r => a -> r a
toCode (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'
  SValue r -> SValue r
forall (r :: * -> *). List r => SValue r -> SValue r
indexToInt (SValue r -> SValue r) -> SValue r -> SValue r
forall a b. (a -> b) -> a -> b
$ PosCall r
forall (r :: * -> *). ValueExpression r => PosCall r
funcApp
    Label
jlListAbsdex StateT ValueState Identity (r (Type r))
t [[SVariable r] -> SValue r -> SValue r
forall (r :: * -> *).
ValueExpression r =>
[SVariable r] -> SValue r -> SValue r
lambda [Label -> StateT ValueState Identity (r (Type r)) -> SVariable r
forall (r :: * -> *).
VariableSym r =>
Label -> VSType r -> SVariable r
var Label
"x" StateT ValueState Identity (r (Type r))
t] (SVariable r -> SValue r
forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
valueOf (Label -> StateT ValueState Identity (r (Type r)) -> SVariable r
forall (r :: * -> *).
VariableSym r =>
Label -> VSType r -> SVariable r
var Label
"x" StateT ValueState Identity (r (Type r))
t) SValue r -> SValue r -> SValue r
forall (r :: * -> *).
Comparison r =>
SValue r -> SValue r -> SValue r
?== SValue r
v), SValue r
l]

-- List slicing in Julia.  See HelloWorld.jl to see the full suite of
-- possible outputs of this function.
jlListSlice :: (CommonRenderSym r) => SVariable r -> SValue r ->
  Maybe (SValue r) -> Maybe (SValue r) -> SValue r -> MSBlock r
jlListSlice :: forall (r :: * -> *).
CommonRenderSym r =>
SVariable r
-> SValue r
-> Maybe (SValue r)
-> Maybe (SValue r)
-> SValue r
-> MSBlock r
jlListSlice 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 <- Label -> MS ScopeData
getVarScope (Label -> MS ScopeData) -> Label -> MS ScopeData
forall a b. (a -> b) -> a -> b
$ r (Variable r) -> Label
forall (r :: * -> *). VariableElim r => r (Variable r) -> Label
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
  Label
bName <- Bool -> Label -> MS Label
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) Label
"begIdx"
  Label
eName <- Bool -> Label -> MS Label
genVarNameIf (Maybe Integer -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Integer
mbStepV) Label
"endIdx"

  let begVar :: SVariable r
begVar = Label -> VSType r -> SVariable r
forall (r :: * -> *).
VariableSym r =>
Label -> VSType r -> SVariable r
var Label
bName VSType r
forall (r :: * -> *). TypeSym r => VSType r
int
      endVar :: SVariable r
endVar = Label -> VSType r -> SVariable r
forall (r :: * -> *).
VariableSym r =>
Label -> VSType r -> SVariable r
var Label
eName VSType r
forall (r :: * -> *). TypeSym r => VSType r
int

      (MS (r (Statement r))
setBeg, SValue r
begVal) = case (Maybe (SValue r)
beg, Maybe Integer
mbStepV) of
        -- If we have a value for beg, just use it
        (Just SValue r
b, Maybe Integer
_)        -> (MS (r (Statement r))
forall (r :: * -> *). StatementSym r => MSStatement r
emptyStmt, SValue r -> SValue r
forall (r :: * -> *). List r => SValue r -> SValue r
intToIndex SValue r
b)
        -- If we don't have a value for `beg` but we do for `step`, use `begin` or `end`
        (Maybe (SValue r)
Nothing, Just Integer
s)  -> (MS (r (Statement r))
forall (r :: * -> *). StatementSym r => MSStatement r
emptyStmt,
          if Integer
s Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0 then VSType r -> Doc -> SValue r
forall (r :: * -> *).
CommonRenderSym r =>
VSType r -> Doc -> SValue r
mkStateVal VSType r
forall (r :: * -> *). TypeSym r => VSType r
int Doc
jlBegin else VSType r -> Doc -> SValue r
forall (r :: * -> *).
CommonRenderSym r =>
VSType r -> Doc -> SValue r
mkStateVal VSType r
forall (r :: * -> *). TypeSym r => VSType r
int Doc
jlEnd)
        -- Otherwise, generate an if-statement to calculate `beg` at runtime
        (Maybe (SValue r)
Nothing, Maybe Integer
Nothing) -> (SVariable r -> r (Scope r) -> SValue r -> MS (r (Statement r))
forall (r :: * -> *).
DeclStatement r =>
SVariable r -> r (Scope r) -> SValue r -> MSStatement r
varDecDef SVariable r
begVar r (Scope r)
scp (SValue r -> MS (r (Statement r)))
-> SValue r -> MS (r (Statement r))
forall a b. (a -> b) -> a -> b
$
          SValue r -> SValue r -> SValue r -> SValue r
forall (r :: * -> *).
ValueExpression r =>
SValue r -> SValue r -> SValue r -> SValue r
inlineIf (SValue r
step SValue r -> SValue r -> SValue r
forall (r :: * -> *).
Comparison r =>
SValue r -> SValue r -> SValue r
?> Integer -> SValue r
forall (r :: * -> *). Literal r => Integer -> SValue r
litInt Integer
0) (Integer -> SValue r
forall (r :: * -> *). Literal r => Integer -> SValue r
litInt Integer
1) (SValue r -> SValue r
forall (r :: * -> *). List r => SValue r -> SValue r
listSize SValue r
vo),
          SVariable r -> SValue r
forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
valueOf SVariable r
begVar)

      -- Similar to `begVal`, but if we're given a value, we have to either
      -- do nothing or add 2 based on the sign of `step`, because `end` needs
      -- to be inclusive
      (MS (r (Statement r))
setEnd, SValue r
endVal) = case (Maybe (SValue r)
end, Maybe Integer
mbStepV) of
        (Just SValue r
e, Just Integer
s)  -> (MS (r (Statement r))
forall (r :: * -> *). StatementSym r => MSStatement r
emptyStmt,
          if Integer
s Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0 then SValue r
e else SValue r
e SValue r -> SValue r -> SValue r
forall (r :: * -> *).
CommonRenderSym r =>
SValue r -> SValue r -> SValue r
`G.smartAdd` Integer -> SValue r
forall (r :: * -> *). Literal r => Integer -> SValue r
litInt Integer
2)
        (Just SValue r
e, Maybe Integer
Nothing) -> (SVariable r -> r (Scope r) -> SValue r -> MS (r (Statement r))
forall (r :: * -> *).
DeclStatement r =>
SVariable r -> r (Scope r) -> SValue r -> MSStatement r
varDecDef SVariable r
endVar r (Scope r)
scp (SValue r -> MS (r (Statement r)))
-> SValue r -> MS (r (Statement r))
forall a b. (a -> b) -> a -> b
$
          SValue r -> SValue r -> SValue r -> SValue r
forall (r :: * -> *).
ValueExpression r =>
SValue r -> SValue r -> SValue r -> SValue r
inlineIf (SValue r
step SValue r -> SValue r -> SValue r
forall (r :: * -> *).
Comparison r =>
SValue r -> SValue r -> SValue r
?> Integer -> SValue r
forall (r :: * -> *). Literal r => Integer -> SValue r
litInt Integer
0) SValue r
e (SValue r
e SValue r -> SValue r -> SValue r
forall (r :: * -> *).
CommonRenderSym r =>
SValue r -> SValue r -> SValue r
`G.smartAdd` Integer -> SValue r
forall (r :: * -> *). Literal r => Integer -> SValue r
litInt Integer
2),
          SVariable r -> SValue r
forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
valueOf SVariable r
endVar)
        (Maybe (SValue r)
Nothing, Just Integer
s) -> (MS (r (Statement r))
forall (r :: * -> *). StatementSym r => MSStatement r
emptyStmt,
          if Integer
s Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0 then VSType r -> Doc -> SValue r
forall (r :: * -> *).
CommonRenderSym r =>
VSType r -> Doc -> SValue r
mkStateVal VSType r
forall (r :: * -> *). TypeSym r => VSType r
int Doc
jlEnd else VSType r -> Doc -> SValue r
forall (r :: * -> *).
CommonRenderSym r =>
VSType r -> Doc -> SValue r
mkStateVal VSType r
forall (r :: * -> *). TypeSym r => VSType r
int Doc
jlBegin)
        (Maybe (SValue r)
Nothing, Maybe Integer
Nothing) -> (SVariable r -> r (Scope r) -> SValue r -> MS (r (Statement r))
forall (r :: * -> *).
DeclStatement r =>
SVariable r -> r (Scope r) -> SValue r -> MSStatement r
varDecDef SVariable r
endVar r (Scope r)
scp (SValue r -> MS (r (Statement r)))
-> SValue r -> MS (r (Statement r))
forall a b. (a -> b) -> a -> b
$
          SValue r -> SValue r -> SValue r -> SValue r
forall (r :: * -> *).
ValueExpression r =>
SValue r -> SValue r -> SValue r -> SValue r
inlineIf (SValue r
step SValue r -> SValue r -> SValue r
forall (r :: * -> *).
Comparison r =>
SValue r -> SValue r -> SValue r
?> 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) (Integer -> SValue r
forall (r :: * -> *). Literal r => Integer -> SValue r
litInt Integer
1), SVariable r -> SValue r
forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
valueOf SVariable r
endVar)

      setToSlice :: MS (r (Statement r))
setToSlice = SVariable r
-> SValue r
-> SValue r
-> SValue r
-> SValue r
-> Maybe Integer
-> MS (r (Statement r))
forall (r :: * -> *).
CommonRenderSym r =>
SVariable r
-> SValue r
-> SValue r
-> SValue r
-> SValue r
-> Maybe Integer
-> MSStatement r
jlListSlice' SVariable r
vn SValue r
vo SValue r
begVal SValue r
endVal SValue r
step Maybe Integer
mbStepV

  [MS (r (Statement r))] -> MSBlock r
forall (r :: * -> *). BlockSym r => [MSStatement r] -> MSBlock r
block [
      MS (r (Statement r))
setBeg,
      MS (r (Statement r))
setEnd,
      MS (r (Statement r))
setToSlice
    ]

jlListSlice' :: (CommonRenderSym r) => SVariable r -> SValue r -> SValue r ->
  SValue r -> SValue r -> Maybe Integer -> MSStatement r
jlListSlice' :: forall (r :: * -> *).
CommonRenderSym r =>
SVariable r
-> SValue r
-> SValue r
-> SValue r
-> SValue r
-> Maybe Integer
-> MSStatement r
jlListSlice' SVariable r
vn SValue r
vo SValue r
beg SValue r
end SValue r
step Maybe Integer
mStep = do
  r (Value r)
vold  <- 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
vo
  r (Value r)
beg'  <- 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
beg
  r (Value r)
end'  <- 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
end
  r (Value r)
step' <- 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 stepDoc :: Doc
stepDoc = case Maybe Integer
mStep of
        (Just Integer
1) -> Doc
empty
        Maybe Integer
_        -> Doc
colon Doc -> Doc -> Doc
<> r (Value r) -> Doc
forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value r (Value r)
step'
      theSlice :: SValue r
theSlice = VSType r -> Doc -> SValue r
forall (r :: * -> *).
CommonRenderSym r =>
VSType r -> Doc -> SValue r
mkStateVal VSType r
forall (r :: * -> *). TypeSym r => VSType r
void (r (Value r) -> Doc
forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value r (Value r)
vold Doc -> Doc -> Doc
<> Doc -> Doc
brackets (r (Value r) -> Doc
forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value r (Value r)
beg' Doc -> Doc -> Doc
<> Doc
stepDoc Doc -> Doc -> Doc
<> Doc
colon Doc -> Doc -> Doc
<> r (Value r) -> Doc
forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value r (Value r)
end'))
  SVariable r
vn SVariable r -> SValue r -> MSStatement r
forall (r :: * -> *).
AssignStatement r =>
SVariable r -> SValue r -> MSStatement r
&= SValue r
theSlice

-- Other functionality
jlRange :: (CommonRenderSym r) => SValue r -> SValue r -> SValue r -> SValue r
jlRange :: forall (r :: * -> *).
CommonRenderSym r =>
SValue r -> SValue r -> SValue r -> SValue r
jlRange SValue r
initv SValue r
finalv SValue r
stepv = do
  r (Type r)
t <- StateT ValueState Identity (r (Type r))
-> StateT ValueState Identity (r (Type r))
forall (r :: * -> *). TypeSym r => VSType r -> VSType r
listType StateT ValueState Identity (r (Type r))
forall (r :: * -> *). TypeSym r => VSType r
int
  r (Value r)
iv <- SValue r
initv
  r (Value r)
sv <- SValue r
stepv
  r (Value r)
fv <- SValue r
finalv
  r (Type r) -> Doc -> SValue r
forall (r :: * -> *).
CommonRenderSym r =>
r (Type r) -> Doc -> SValue r
mkVal r (Type r)
t (r (Value r) -> Doc
forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value r (Value r)
iv Doc -> Doc -> Doc
<> Doc
colon Doc -> Doc -> Doc
<> r (Value r) -> Doc
forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value r (Value r)
sv Doc -> Doc -> Doc
<> Doc
colon Doc -> Doc -> Doc
<> r (Value r) -> Doc
forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value r (Value r)
fv)

jlSplit :: String
jlSplit :: Label
jlSplit = Label
"split"

jlPrintFunc, jlPrintLnFunc :: Doc
jlPrintFunc :: Doc
jlPrintFunc = Label -> Doc
text Label
printLabel
jlPrintLnFunc :: Doc
jlPrintLnFunc = Label -> Doc
text Label
"println"

jlParseFunc :: Label
jlParseFunc :: Label
jlParseFunc = Label
"parse"

jlType, arrow, jlNamedArgSep :: Doc
jlType :: Doc
jlType = Doc
colon Doc -> Doc -> Doc
<> Doc
colon
arrow :: Doc
arrow = Label -> Doc
text Label
"->"
jlNamedArgSep :: Doc
jlNamedArgSep = Doc
equals

jlTuple :: [String] -> String
jlTuple :: [Label] -> Label
jlTuple [Label]
ts = Label
"Tuple{" Label -> Label -> Label
forall a. [a] -> [a] -> [a]
++ Label -> [Label] -> Label
forall a. [a] -> [[a]] -> [a]
intercalate Label
listSep [Label]
ts Label -> Label -> Label
forall a. [a] -> [a] -> [a]
++ Label
"}"

-- Operators
jlUnaryMath :: (Monad r) => String -> VSOp r
jlUnaryMath :: forall (r :: * -> *). Monad r => Label -> VSOp r
jlUnaryMath = Label -> VSOp r
forall (r :: * -> *). Monad r => Label -> VSOp r
unOpPrec

jlPower, jlIntDiv :: String
jlPower :: Label
jlPower = Label
"^"
jlIntDiv :: Label
jlIntDiv = Label
"÷"

-- Constants
jlPi :: Doc
jlPi :: Doc
jlPi = Label -> Doc
text Label
"pi"

-- Comments
jlCmtStart, jlBlockCmtStart, jlBlockCmtEnd, jlDocCmtStart, jlDocCmtEnd :: Doc
jlCmtStart :: Doc
jlCmtStart      = Label -> Doc
text Label
"#"
jlBlockCmtStart :: Doc
jlBlockCmtStart = Label -> Doc
text Label
"#="
jlBlockCmtEnd :: Doc
jlBlockCmtEnd   = Label -> Doc
text Label
"=#"
jlDocCmtStart :: Doc
jlDocCmtStart   = Label -> Doc
text Label
"\"\"\""
jlDocCmtEnd :: Doc
jlDocCmtEnd     = Label -> Doc
text Label
"\"\"\""

-- Control structures

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

-- | Creates a for-each loop in Julia
jlForEach :: (CommonRenderSym r) => r (Variable r) -> r (Value r) -> r (Body r) -> Doc
jlForEach :: forall (r :: * -> *).
CommonRenderSym r =>
r (Variable r) -> r (Value r) -> r (Body r) -> Doc
jlForEach 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
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
jlEnd]

-- | Creates the contents of a module in Julia
jlModContents :: Label -> [Label] -> [SMethod JuliaCode] ->
  FSModule JuliaCode
jlModContents :: Label -> [Label] -> [SMethod JuliaCode] -> FSModule JuliaCode
jlModContents Label
n [Label]
is = Label
-> FS Doc -> FS Doc -> [SMethod JuliaCode] -> FSModule JuliaCode
forall (r :: * -> *).
ProcRenderSym r =>
Label -> FS Doc -> FS Doc -> [SMethod r] -> FSModule r
A.buildModule Label
n (do
  [Label]
lis <- FS [Label]
getLangImports
  [Label]
libis <- FS [Label]
getLibImports
  [Label]
mis <- FS [Label]
getModuleImports
  Doc -> FS Doc
forall a. a -> StateT FileState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc -> FS Doc) -> Doc -> FS Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vibcat [
    [Doc] -> Doc
vcat ((Label -> Doc) -> [Label] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (JuliaCode (Import JuliaCode) -> Doc
forall (r :: * -> *). ImportElim r => r (Import r) -> Doc
RC.import' (JuliaCode (Import JuliaCode) -> Doc)
-> (Label -> JuliaCode (Import JuliaCode)) -> Label -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Label -> JuliaCode (Import JuliaCode)
li) [Label]
lis),
    [Doc] -> Doc
vcat ((Label -> Doc) -> [Label] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (JuliaCode (Import JuliaCode) -> Doc
forall (r :: * -> *). ImportElim r => r (Import r) -> Doc
RC.import' (JuliaCode (Import JuliaCode) -> Doc)
-> (Label -> JuliaCode (Import JuliaCode)) -> Label -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Label -> JuliaCode (Import JuliaCode)
li) ([Label] -> [Label]
forall a. Ord a => [a] -> [a]
sort ([Label] -> [Label]) -> [Label] -> [Label]
forall a b. (a -> b) -> a -> b
$ [Label]
is [Label] -> [Label] -> [Label]
forall a. [a] -> [a] -> [a]
++ [Label]
libis)),
    [Doc] -> Doc
vcat ((Label -> Doc) -> [Label] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (JuliaCode (Import JuliaCode) -> Doc
forall (r :: * -> *). ImportElim r => r (Import r) -> Doc
RC.import' (JuliaCode (Import JuliaCode) -> Doc)
-> (Label -> JuliaCode (Import JuliaCode)) -> Label -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Label -> JuliaCode (Import JuliaCode)
mi) [Label]
mis)])
  (do FS Doc
getMainDoc)
  where mi, li :: Label -> JuliaCode (Import JuliaCode)
        mi :: Label -> JuliaCode (Import JuliaCode)
mi = Label -> JuliaCode (Import JuliaCode)
forall (r :: * -> *). ImportSym r => Label -> r (Import r)
modImport
        li :: Label -> JuliaCode (Import JuliaCode)
li = Label -> JuliaCode (Import JuliaCode)
forall (r :: * -> *). ImportSym r => Label -> r (Import r)
langImport

-- Functions
-- | Creates a function.  n is function name, pms is list of parameters, and
--   bod is body.
jlIntFunc :: (CommonRenderSym r) => Label -> [r (Parameter r)] ->
  r (Body r) -> Doc
jlIntFunc :: forall (r :: * -> *).
CommonRenderSym r =>
Label -> [r (Parameter r)] -> r (Body r) -> Doc
jlIntFunc Label
n [r (Parameter r)]
pms r (Body r)
bod = do
  [Doc] -> Doc
vcat [Doc
jlFunc Doc -> Doc -> Doc
<+> Label -> Doc
text Label
n 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
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
jlEnd]

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

-- Exceptions
jlThrow :: (CommonRenderSym r) => r (Value r) -> Doc
jlThrow :: forall (r :: * -> *). CommonRenderSym r => r (Value r) -> Doc
jlThrow r (Value r)
errMsg = Doc
jlThrowLabel Doc -> Doc -> Doc
<> Doc -> Doc
parens (r (Value r) -> Doc
forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value r (Value r)
errMsg)

jlTryCatch :: (CommonRenderSym r) => r (Body r) -> r (Body r) -> Doc
jlTryCatch :: forall (r :: * -> *).
CommonRenderSym r =>
r (Body r) -> r (Body r) -> Doc
jlTryCatch r (Body r)
tryB r (Body r)
catchB = [Doc] -> Doc
vcat [
  Doc
tryLabel,
  Doc -> Doc
indent (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ r (Body r) -> Doc
forall (r :: * -> *). BodyElim r => r (Body r) -> Doc
RC.body r (Body r)
tryB,
  Doc
catchLabel Doc -> Doc -> Doc
<+> Doc
jlException,
  Doc -> Doc
indent (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ r (Body r) -> Doc
forall (r :: * -> *). BodyElim r => r (Body r) -> Doc
RC.body r (Body r)
catchB,
  Doc
jlEnd]

jlException :: Doc
jlException :: Doc
jlException = Label -> Doc
text Label
"ErrorException"

includeLabel, importLabel :: Doc
includeLabel :: Doc
includeLabel = Label -> Doc
text Label
"include"
importLabel :: Doc
importLabel = Label -> Doc
text Label
"import"

-- Assertions
jlAssert :: (CommonRenderSym r) => r (Value r) -> r (Value r) -> Doc
jlAssert :: forall (r :: * -> *).
CommonRenderSym r =>
r (Value r) -> r (Value r) -> Doc
jlAssert r (Value r)
condition r (Value r)
errorMessage = [Doc] -> Doc
vcat [
  Label -> Doc
text Label
"@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
<+> r (Value r) -> Doc
forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value r (Value r)
errorMessage
  ]

jlMod, elseIfLabel, jlFunc, jlBegin, jlEnd, jlThrowLabel :: Doc
jlMod :: Doc
jlMod        = Label -> Doc
text Label
"module"
elseIfLabel :: Doc
elseIfLabel  = Label -> Doc
text Label
"elseif"
jlFunc :: Doc
jlFunc       = Label -> Doc
text Label
"function"
jlBegin :: Doc
jlBegin      = Label -> Doc
text Label
"begin"
jlEnd :: Doc
jlEnd        = Label -> Doc
text Label
"end"
jlThrowLabel :: Doc
jlThrowLabel = Label -> Doc
text Label
"error" -- TODO: this hints at an underdeveloped exception system

jlParam :: (CommonRenderSym r) => r (Variable r) -> Doc
jlParam :: forall (r :: * -> *). CommonRenderSym r => r (Variable r) -> Doc
jlParam r (Variable r)
v = r (Variable r) -> Doc
forall (r :: * -> *). InternalVarElim r => r (Variable r) -> Doc
RC.variable r (Variable r)
v Doc -> Doc -> Doc
<> Doc
jlType 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)

-- Type names specific to Julia (there's a lot of them)
jlIntType :: (CommonRenderSym r) => VSType r
jlIntType :: forall (r :: * -> *). CommonRenderSym r => VSType r
jlIntType = CodeType -> Label -> Doc -> StateT ValueState Identity (r (Type r))
forall (r :: * -> *).
RenderType r =>
CodeType -> Label -> Doc -> VSType r
typeFromData CodeType
Integer Label
jlIntConc (Label -> Doc
text Label
jlIntConc)

jlFloatType :: (CommonRenderSym r) => VSType r
jlFloatType :: forall (r :: * -> *). CommonRenderSym r => VSType r
jlFloatType = CodeType -> Label -> Doc -> StateT ValueState Identity (r (Type r))
forall (r :: * -> *).
RenderType r =>
CodeType -> Label -> Doc -> VSType r
typeFromData CodeType
Float Label
jlFloatConc (Label -> Doc
text Label
jlFloatConc)

jlDoubleType :: (CommonRenderSym r) => VSType r
jlDoubleType :: forall (r :: * -> *). CommonRenderSym r => VSType r
jlDoubleType = CodeType -> Label -> Doc -> StateT ValueState Identity (r (Type r))
forall (r :: * -> *).
RenderType r =>
CodeType -> Label -> Doc -> VSType r
typeFromData CodeType
Double Label
jlDoubleConc (Label -> Doc
text Label
jlDoubleConc)

jlCharType :: (CommonRenderSym r) => VSType r
jlCharType :: forall (r :: * -> *). CommonRenderSym r => VSType r
jlCharType = CodeType -> Label -> Doc -> StateT ValueState Identity (r (Type r))
forall (r :: * -> *).
RenderType r =>
CodeType -> Label -> Doc -> VSType r
typeFromData CodeType
Char Label
jlCharConc (Label -> Doc
text Label
jlCharConc)

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

jlInfileType :: (CommonRenderSym r) => VSType r
jlInfileType :: forall (r :: * -> *). CommonRenderSym r => VSType r
jlInfileType = CodeType -> Label -> Doc -> StateT ValueState Identity (r (Type r))
forall (r :: * -> *).
RenderType r =>
CodeType -> Label -> Doc -> VSType r
typeFromData CodeType
InFile Label
jlFile (Label -> Doc
text Label
jlFile)

jlOutfileType :: (CommonRenderSym r) => VSType r
jlOutfileType :: forall (r :: * -> *). CommonRenderSym r => VSType r
jlOutfileType = CodeType -> Label -> Doc -> StateT ValueState Identity (r (Type r))
forall (r :: * -> *).
RenderType r =>
CodeType -> Label -> Doc -> VSType r
typeFromData CodeType
OutFile Label
jlFile (Label -> Doc
text Label
jlFile)

jlListType :: (CommonRenderSym r) => VSType r -> VSType r
jlListType :: forall (r :: * -> *). CommonRenderSym r => VSType r -> VSType r
jlListType VSType r
t' = do
  r (Type r)
t <- VSType r
t'
  let typeName :: Label
typeName = Label
jlListConc Label -> Label -> Label
forall a. [a] -> [a] -> [a]
++ Label
"{" Label -> Label -> Label
forall a. [a] -> [a] -> [a]
++ r (Type r) -> Label
forall (r :: * -> *). TypeElim r => r (Type r) -> Label
getTypeString r (Type r)
t Label -> Label -> Label
forall a. [a] -> [a] -> [a]
++ Label
"}"
  CodeType -> Label -> Doc -> VSType r
forall (r :: * -> *).
RenderType r =>
CodeType -> Label -> 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) Label
typeName (Label -> Doc
text Label
typeName)

jlSetType :: (CommonRenderSym r) => VSType r -> VSType r
jlSetType :: forall (r :: * -> *). CommonRenderSym r => VSType r -> VSType r
jlSetType VSType r
t' = do
  r (Type r)
t <- VSType r
t'
  let typeName :: Label
typeName = Label
jlSetConc Label -> Label -> Label
forall a. [a] -> [a] -> [a]
++ Label
"{" Label -> Label -> Label
forall a. [a] -> [a] -> [a]
++ r (Type r) -> Label
forall (r :: * -> *). TypeElim r => r (Type r) -> Label
getTypeString r (Type r)
t Label -> Label -> Label
forall a. [a] -> [a] -> [a]
++ Label
"}"
  CodeType -> Label -> Doc -> VSType r
forall (r :: * -> *).
RenderType r =>
CodeType -> Label -> Doc -> VSType r
typeFromData (CodeType -> CodeType
Set (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) Label
typeName (Label -> Doc
text Label
typeName)

jlVoidType :: (CommonRenderSym r) => VSType r
jlVoidType :: forall (r :: * -> *). CommonRenderSym r => VSType r
jlVoidType = CodeType -> Label -> Doc -> StateT ValueState Identity (r (Type r))
forall (r :: * -> *).
RenderType r =>
CodeType -> Label -> Doc -> VSType r
typeFromData CodeType
Void Label
jlVoid (Label -> Doc
text Label
jlVoid)

jlNull :: Label
jlNull :: Label
jlNull = Label
"nothing"

-- Modules
-- | Creates the text for the start of a module.
--   n is the name of the module.
jlModStart :: Label -> Doc
jlModStart :: Label -> Doc
jlModStart Label
n = Doc
jlMod Doc -> Doc -> Doc
<+> Label -> Doc
text Label
n

-- IO
jlPrint :: Bool -> Maybe (SValue JuliaCode) -> SValue JuliaCode ->
  SValue JuliaCode -> MSStatement JuliaCode
-- Printing to console
jlPrint :: Bool
-> Maybe (SValue JuliaCode)
-> SValue JuliaCode
-> SValue JuliaCode
-> MSStatement JuliaCode
jlPrint Bool
_ Maybe (SValue JuliaCode)
f' SValue JuliaCode
p' SValue JuliaCode
v' = do
  JuliaCode (Value JuliaCode)
f <- LensLike'
  (Zoomed (StateT ValueState Identity) (JuliaCode (Value JuliaCode)))
  MethodState
  ValueState
-> SValue JuliaCode
-> StateT MethodState Identity (JuliaCode (Value JuliaCode))
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) (JuliaCode (Value JuliaCode)))
  MethodState
  ValueState
(ValueState
 -> Focusing Identity (JuliaCode (Value JuliaCode)) ValueState)
-> MethodState
-> Focusing Identity (JuliaCode (Value JuliaCode)) MethodState
Lens' MethodState ValueState
lensMStoVS (SValue JuliaCode
 -> StateT MethodState Identity (JuliaCode (Value JuliaCode)))
-> SValue JuliaCode
-> StateT MethodState Identity (JuliaCode (Value JuliaCode))
forall a b. (a -> b) -> a -> b
$ SValue JuliaCode -> Maybe (SValue JuliaCode) -> SValue JuliaCode
forall a. a -> Maybe a -> a
fromMaybe (VSType JuliaCode -> Doc -> SValue JuliaCode
forall (r :: * -> *).
CommonRenderSym r =>
VSType r -> Doc -> SValue r
mkStateVal VSType JuliaCode
forall (r :: * -> *). TypeSym r => VSType r
void Doc
empty) Maybe (SValue JuliaCode)
f' -- The file to print to
  JuliaCode ValData
prf <- LensLike'
  (Zoomed (StateT ValueState Identity) (JuliaCode ValData))
  MethodState
  ValueState
-> VS (JuliaCode ValData)
-> StateT MethodState Identity (JuliaCode 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) (JuliaCode ValData))
  MethodState
  ValueState
(ValueState -> Focusing Identity (JuliaCode ValData) ValueState)
-> MethodState -> Focusing Identity (JuliaCode ValData) MethodState
Lens' MethodState ValueState
lensMStoVS VS (JuliaCode ValData)
SValue JuliaCode
p' -- The print function to use
  JuliaCode ValData
v <- LensLike'
  (Zoomed (StateT ValueState Identity) (JuliaCode ValData))
  MethodState
  ValueState
-> VS (JuliaCode ValData)
-> StateT MethodState Identity (JuliaCode 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) (JuliaCode ValData))
  MethodState
  ValueState
(ValueState -> Focusing Identity (JuliaCode ValData) ValueState)
-> MethodState -> Focusing Identity (JuliaCode ValData) MethodState
Lens' MethodState ValueState
lensMStoVS VS (JuliaCode ValData)
SValue JuliaCode
v' -- The value to print
  let fl :: Doc
fl = Doc -> Doc -> Doc
emptyIfEmpty (JuliaCode (Value JuliaCode) -> Doc
forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value JuliaCode (Value JuliaCode)
f) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ JuliaCode (Value JuliaCode) -> Doc
forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value JuliaCode (Value JuliaCode)
f Doc -> Doc -> Doc
<> Doc
listSep'
  Doc -> MSStatement JuliaCode
forall (r :: * -> *). CommonRenderSym r => Doc -> MSStatement r
mkStmtNoEnd (Doc -> MSStatement JuliaCode) -> Doc -> MSStatement JuliaCode
forall a b. (a -> b) -> a -> b
$ JuliaCode (Value JuliaCode) -> Doc
forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value JuliaCode ValData
JuliaCode (Value JuliaCode)
prf Doc -> Doc -> Doc
<> Doc -> Doc
parens (Doc
fl Doc -> Doc -> Doc
<> JuliaCode (Value JuliaCode) -> Doc
forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value JuliaCode ValData
JuliaCode (Value JuliaCode)
v)

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

jlInput :: SValue JuliaCode -> SVariable JuliaCode -> MSStatement JuliaCode
jlInput :: SValue JuliaCode -> SVariable JuliaCode -> MSStatement JuliaCode
jlInput SValue JuliaCode
inSrc SVariable JuliaCode
v = SVariable JuliaCode
v SVariable JuliaCode -> SValue JuliaCode -> MSStatement JuliaCode
forall (r :: * -> *).
AssignStatement r =>
SVariable r -> SValue r -> MSStatement r
&= (StateT ValueState Identity (JuliaCode VarData)
SVariable JuliaCode
v StateT ValueState Identity (JuliaCode VarData)
-> (JuliaCode VarData -> VS (JuliaCode ValData))
-> VS (JuliaCode ValData)
forall a b.
StateT ValueState Identity a
-> (a -> StateT ValueState Identity b)
-> StateT ValueState Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CodeType -> VS (JuliaCode ValData)
CodeType -> SValue JuliaCode
jlInput' (CodeType -> VS (JuliaCode ValData))
-> (JuliaCode VarData -> CodeType)
-> JuliaCode VarData
-> VS (JuliaCode ValData)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JuliaCode (Type JuliaCode) -> CodeType
forall (r :: * -> *). TypeElim r => r (Type r) -> CodeType
getType (JuliaCode (Type JuliaCode) -> CodeType)
-> (JuliaCode VarData -> JuliaCode (Type JuliaCode))
-> JuliaCode VarData
-> CodeType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JuliaCode VarData -> JuliaCode (Type JuliaCode)
JuliaCode (Variable JuliaCode) -> JuliaCode (Type JuliaCode)
forall (r :: * -> *).
VariableElim r =>
r (Variable r) -> r (Type r)
variableType)
  where jlInput' :: CodeType -> SValue JuliaCode
jlInput' CodeType
Integer = Label -> VSType JuliaCode -> SValue JuliaCode -> SValue JuliaCode
forall (r :: * -> *).
CommonRenderSym r =>
Label -> VSType r -> SValue r -> SValue r
jlParse Label
jlIntConc VSType JuliaCode
forall (r :: * -> *). TypeSym r => VSType r
int SValue JuliaCode
inSrc
        jlInput' CodeType
Float = Label -> VSType JuliaCode -> SValue JuliaCode -> SValue JuliaCode
forall (r :: * -> *).
CommonRenderSym r =>
Label -> VSType r -> SValue r -> SValue r
jlParse Label
jlFloatConc VSType JuliaCode
forall (r :: * -> *). TypeSym r => VSType r
float SValue JuliaCode
inSrc
        jlInput' CodeType
Double = Label -> VSType JuliaCode -> SValue JuliaCode -> SValue JuliaCode
forall (r :: * -> *).
CommonRenderSym r =>
Label -> VSType r -> SValue r -> SValue r
jlParse Label
jlDoubleConc VSType JuliaCode
forall (r :: * -> *). TypeSym r => VSType r
double SValue JuliaCode
inSrc
        jlInput' CodeType
Boolean = Label -> VSType JuliaCode -> SValue JuliaCode -> SValue JuliaCode
forall (r :: * -> *).
CommonRenderSym r =>
Label -> VSType r -> SValue r -> SValue r
jlParse Label
CP.boolRender VSType JuliaCode
forall (r :: * -> *). TypeSym r => VSType r
bool SValue JuliaCode
inSrc
        jlInput' CodeType
String = SValue JuliaCode
inSrc
        jlInput' CodeType
Char = Label -> VSType JuliaCode -> SValue JuliaCode -> SValue JuliaCode
forall (r :: * -> *).
CommonRenderSym r =>
Label -> VSType r -> SValue r -> SValue r
jlParse Label
jlCharConc VSType JuliaCode
forall (r :: * -> *). TypeSym r => VSType r
char SValue JuliaCode
inSrc
        jlInput' CodeType
_ = Label -> VS (JuliaCode ValData)
forall a. HasCallStack => Label -> a
error Label
"Attempt to read a value of unreadable type"

readLine, readLines :: (CommonRenderSym r) => SValue r -> SValue r
readLine :: forall (r :: * -> *). CommonRenderSym r => SValue r -> SValue r
readLine SValue r
f = PosCall r
forall (r :: * -> *). ValueExpression r => PosCall r
funcApp Label
jlReadLineFunc VSType r
forall (r :: * -> *). TypeSym r => VSType r
string [SValue r
f]
readLines :: forall (r :: * -> *). CommonRenderSym r => SValue r -> SValue r
readLines SValue r
f = PosCall r
forall (r :: * -> *). ValueExpression r => PosCall r
funcApp Label
jlReadLinesFunc (StateT ValueState Identity (r (Type r))
-> StateT ValueState Identity (r (Type r))
forall (r :: * -> *). TypeSym r => VSType r -> VSType r
listType StateT ValueState Identity (r (Type r))
forall (r :: * -> *). TypeSym r => VSType r
string) [SValue r
f]

jlReadLine :: Doc
jlReadLine :: Doc
jlReadLine = Label -> Doc
text Label
jlReadLineFunc

jlReadLineFunc, jlReadLinesFunc, jlCloseFunc :: Label
jlReadLineFunc :: Label
jlReadLineFunc = Label
"readline"
jlReadLinesFunc :: Label
jlReadLinesFunc = Label
"readlines"
jlCloseFunc :: Label
jlCloseFunc = Label
"close"

jlArgs :: Label
jlArgs :: Label
jlArgs = Label
"ARGS"

jlParse :: (CommonRenderSym r) => Label -> VSType r -> SValue r -> SValue r
jlParse :: forall (r :: * -> *).
CommonRenderSym r =>
Label -> VSType r -> SValue r -> SValue r
jlParse Label
tl VSType r
tp SValue r
v = let
  typeLabel :: SValue r
typeLabel = VSType r -> Doc -> SValue r
forall (r :: * -> *).
CommonRenderSym r =>
VSType r -> Doc -> SValue r
mkStateVal VSType r
forall (r :: * -> *). TypeSym r => VSType r
void (Label -> Doc
text Label
tl)
  in PosCall r
forall (r :: * -> *). ValueExpression r => PosCall r
funcApp Label
jlParseFunc VSType r
tp [SValue r
typeLabel, SValue r
v]