module Language.Drasil.Code.Imperative.Modules (
genMain, genMainFunc, chooseInModule, genInputClass, genInputDerived,
genInputConstraints, genInputFormat, genConstMod, genConstClass, genCalcMod,
genCalcFunc, genOutputMod, genOutputFormat, genSampleInput
) where
import Language.Drasil (Constraint(..), RealInterval(..),
HasUID(uid), Stage(..))
import Database.Drasil (ChunkDB)
import Language.Drasil.Code.Expr.Development
import Language.Drasil.Code.Imperative.Comments (getComment)
import Language.Drasil.Code.Imperative.Descriptions (constClassDesc,
constModDesc, derivedValuesDesc, dvFuncDesc, inConsFuncDesc, inFmtFuncDesc,
inputClassDesc, inputConstraintsDesc, inputConstructorDesc, inputFormatDesc,
inputParametersDesc, modDesc, outputFormatDesc, woFuncDesc, calcModDesc)
import Language.Drasil.Code.Imperative.FunctionCalls (getCalcCall,
getAllInputCalls, getOutputCall)
import Language.Drasil.Code.Imperative.GenerateGOOL (ClassType(..), genModule,
genModuleWithImports, primaryClass, auxClass)
import Language.Drasil.Code.Imperative.Helpers (liftS)
import Language.Drasil.Code.Imperative.Import (codeType, convExpr, convStmt,
genConstructor, mkVal, mkVar, privateInOutMethod, privateMethod, publicFunc,
publicInOutFunc, readData, renderC)
import Language.Drasil.Code.Imperative.Logging (maybeLog, varLogFile)
import Language.Drasil.Code.Imperative.Parameters (getConstraintParams,
getDerivedIns, getDerivedOuts, getInConstructorParams, getInputFormatIns,
getInputFormatOuts, getCalcParams, getOutputParams)
import Language.Drasil.Code.Imperative.DrasilState (GenState, DrasilState(..))
import Language.Drasil.Code.Imperative.GOOL.ClassInterface (AuxiliarySym(..))
import Language.Drasil.Chunk.Code (CodeIdea(codeName), CodeVarChunk, quantvar,
DefiningCodeExpr(..))
import Language.Drasil.Chunk.CodeDefinition (CodeDefinition, DefinitionType(..),
defType)
import Language.Drasil.Chunk.ConstraintMap (physLookup, sfwrLookup)
import Language.Drasil.Chunk.Parameter (pcAuto)
import Language.Drasil.Code.CodeQuantityDicts (inFileName, inParams, consts)
import Language.Drasil.Code.DataDesc (DataDesc, junkLine, singleton)
import Language.Drasil.Code.ExtLibImport (defs, imports, steps)
import Language.Drasil.Choices (Comments(..), ConstantStructure(..),
ConstantRepr(..), ConstraintBehaviour(..), ImplementationType(..),
InputModule(..), Logging(..), Structure(..), hasSampleInput)
import Language.Drasil.CodeSpec (CodeSpec(..))
import Language.Drasil.Expr.Development (Completeness(..))
import Language.Drasil.Printers (Linearity(Linear), codeExprDoc)
import GOOL.Drasil (SFile, MSBody, MSBlock, SVariable, SValue, MSStatement,
SMethod, CSStateVar, SClass, OOProg, BodySym(..), bodyStatements, oneLiner,
BlockSym(..), PermanenceSym(..), TypeSym(..), VariableSym(..), Literal(..),
VariableValue(..), CommandLineArgs(..), BooleanExpression(..),
StatementSym(..), AssignStatement(..), DeclStatement(..), objDecNewNoParams,
extObjDecNewNoParams, IOStatement(..), ControlStatement(..), ifNoElse,
ScopeSym(..), MethodSym(..), StateVarSym(..), pubDVar, convType, ScopeTag(..))
import Prelude hiding (print)
import Data.List (intersperse, partition)
import Data.Map ((!), elems, member)
import qualified Data.Map as Map (lookup, filter)
import Data.Maybe (maybeToList, catMaybes)
import Control.Monad (liftM2, zipWithM)
import Control.Monad.State (get, gets)
import Control.Lens ((^.))
import Text.PrettyPrint.HughesPJ (render)
type ConstraintCE = Constraint CodeExpr
genMain :: (OOProg r) => GenState (SFile r)
genMain :: GenState (SFile r)
genMain = Name
-> Name
-> [GenState (Maybe (SMethod r))]
-> [GenState (Maybe (SClass r))]
-> GenState (SFile r)
forall (r :: * -> *).
OOProg r =>
Name
-> Name
-> [GenState (Maybe (SMethod r))]
-> [GenState (Maybe (SClass r))]
-> GenState (SFile r)
genModule "Control" "Controls the flow of the program"
[GenState (Maybe (SMethod r))
forall (r :: * -> *). OOProg r => GenState (Maybe (SMethod r))
genMainFunc] []
genMainFunc :: (OOProg r) => GenState (Maybe (SMethod r))
genMainFunc :: GenState (Maybe (SMethod r))
genMainFunc = do
DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
let mainFunc :: ImplementationType
-> StateT DrasilState Identity (Maybe (MS (r (Method r))))
mainFunc Library = Maybe (MS (r (Method r)))
-> StateT DrasilState Identity (Maybe (MS (r (Method r))))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MS (r (Method r)))
forall a. Maybe a
Nothing
mainFunc Program = do
VS (r (Variable r))
v_filename <- CodeVarChunk -> GenState (VS (r (Variable r)))
forall (r :: * -> *).
OOProg r =>
CodeVarChunk -> GenState (SVariable r)
mkVar (CodeVarChunk -> GenState (VS (r (Variable r))))
-> CodeVarChunk -> GenState (VS (r (Variable r)))
forall a b. (a -> b) -> a -> b
$ QuantityDict -> CodeVarChunk
forall c. (Quantity c, MayHaveUnit c) => c -> CodeVarChunk
quantvar QuantityDict
inFileName
[MS (r (Statement r))]
logInFile <- VS (r (Variable r)) -> GenState [MS (r (Statement r))]
forall (r :: * -> *).
OOProg r =>
SVariable r -> GenState [MSStatement r]
maybeLog VS (r (Variable r))
v_filename
Maybe (MS (r (Statement r)))
co <- GenState (Maybe (MS (r (Statement r))))
forall (r :: * -> *). OOProg r => GenState (Maybe (MSStatement r))
initConsts
Maybe (MS (r (Statement r)))
ip <- GenState (Maybe (MS (r (Statement r))))
forall (r :: * -> *). OOProg r => GenState (Maybe (MSStatement r))
getInputDecl
[MS (r (Statement r))]
ics <- GenState [MS (r (Statement r))]
forall (r :: * -> *). OOProg r => GenState [MSStatement r]
getAllInputCalls
[Maybe (MS (r (Statement r)))]
varDef <- (CodeDefinition -> GenState (Maybe (MS (r (Statement r)))))
-> [CodeDefinition]
-> StateT DrasilState Identity [Maybe (MS (r (Statement r)))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM CodeDefinition -> GenState (Maybe (MS (r (Statement r))))
forall (r :: * -> *).
OOProg r =>
CodeDefinition -> GenState (Maybe (MSStatement r))
getCalcCall (CodeSpec -> [CodeDefinition]
execOrder (CodeSpec -> [CodeDefinition]) -> CodeSpec -> [CodeDefinition]
forall a b. (a -> b) -> a -> b
$ DrasilState -> CodeSpec
codeSpec DrasilState
g)
Maybe (MS (r (Statement r)))
wo <- GenState (Maybe (MS (r (Statement r))))
forall (r :: * -> *). OOProg r => GenState (Maybe (MSStatement r))
getOutputCall
Maybe (MS (r (Method r)))
-> StateT DrasilState Identity (Maybe (MS (r (Method r))))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MS (r (Method r)))
-> StateT DrasilState Identity (Maybe (MS (r (Method r)))))
-> Maybe (MS (r (Method r)))
-> StateT DrasilState Identity (Maybe (MS (r (Method r))))
forall a b. (a -> b) -> a -> b
$ MS (r (Method r)) -> Maybe (MS (r (Method r)))
forall a. a -> Maybe a
Just (MS (r (Method r)) -> Maybe (MS (r (Method r))))
-> MS (r (Method r)) -> Maybe (MS (r (Method r)))
forall a b. (a -> b) -> a -> b
$ (if Comments
CommentFunc Comments -> [Comments] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` DrasilState -> [Comments]
commented DrasilState
g then MSBody r -> MS (r (Method r))
forall (r :: * -> *). MethodSym r => MSBody r -> SMethod r
docMain else
MSBody r -> MS (r (Method r))
forall (r :: * -> *). MethodSym r => MSBody r -> SMethod r
mainFunction) (MSBody r -> MS (r (Method r))) -> MSBody r -> MS (r (Method r))
forall a b. (a -> b) -> a -> b
$ [MS (r (Statement r))] -> MSBody r
forall (r :: * -> *). BodySym r => [MSStatement r] -> MSBody r
bodyStatements ([MS (r (Statement r))] -> MSBody r)
-> [MS (r (Statement r))] -> MSBody r
forall a b. (a -> b) -> a -> b
$ [Logging] -> [MS (r (Statement r))]
forall (r :: * -> *). OOProg r => [Logging] -> [MSStatement r]
initLogFileVar (DrasilState -> [Logging]
logKind DrasilState
g)
[MS (r (Statement r))]
-> [MS (r (Statement r))] -> [MS (r (Statement r))]
forall a. [a] -> [a] -> [a]
++ VS (r (Variable r)) -> SValue r -> MS (r (Statement r))
forall (r :: * -> *).
DeclStatement r =>
SVariable r -> SValue r -> MSStatement r
varDecDef VS (r (Variable r))
v_filename (Integer -> SValue r
forall (r :: * -> *). CommandLineArgs r => Integer -> SValue r
arg 0)
MS (r (Statement r))
-> [MS (r (Statement r))] -> [MS (r (Statement r))]
forall a. a -> [a] -> [a]
: [MS (r (Statement r))]
logInFile
[MS (r (Statement r))]
-> [MS (r (Statement r))] -> [MS (r (Statement r))]
forall a. [a] -> [a] -> [a]
++ [Maybe (MS (r (Statement r)))] -> [MS (r (Statement r))]
forall a. [Maybe a] -> [a]
catMaybes [Maybe (MS (r (Statement r)))
co, Maybe (MS (r (Statement r)))
ip] [MS (r (Statement r))]
-> [MS (r (Statement r))] -> [MS (r (Statement r))]
forall a. [a] -> [a] -> [a]
++ [MS (r (Statement r))]
ics [MS (r (Statement r))]
-> [MS (r (Statement r))] -> [MS (r (Statement r))]
forall a. [a] -> [a] -> [a]
++ [Maybe (MS (r (Statement r)))] -> [MS (r (Statement r))]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (MS (r (Statement r)))]
varDef [Maybe (MS (r (Statement r)))]
-> [Maybe (MS (r (Statement r)))] -> [Maybe (MS (r (Statement r)))]
forall a. [a] -> [a] -> [a]
++ [Maybe (MS (r (Statement r)))
wo])
ImplementationType -> GenState (Maybe (SMethod r))
forall (r :: * -> *).
OOProg r =>
ImplementationType
-> StateT DrasilState Identity (Maybe (MS (r (Method r))))
mainFunc (ImplementationType -> GenState (Maybe (SMethod r)))
-> ImplementationType -> GenState (Maybe (SMethod r))
forall a b. (a -> b) -> a -> b
$ DrasilState -> ImplementationType
implType DrasilState
g
getInputDecl :: (OOProg r) => GenState (Maybe (MSStatement r))
getInputDecl :: GenState (Maybe (MSStatement r))
getInputDecl = do
DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
VS (r (Variable r))
v_params <- CodeVarChunk -> GenState (VS (r (Variable r)))
forall (r :: * -> *).
OOProg r =>
CodeVarChunk -> GenState (SVariable r)
mkVar (QuantityDict -> CodeVarChunk
forall c. (Quantity c, MayHaveUnit c) => c -> CodeVarChunk
quantvar QuantityDict
inParams)
[CodeVarChunk]
constrParams <- GenState [CodeVarChunk]
getInConstructorParams
[VS (r (Value r))]
cps <- (CodeVarChunk -> StateT DrasilState Identity (VS (r (Value r))))
-> [CodeVarChunk] -> StateT DrasilState Identity [VS (r (Value r))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM CodeVarChunk -> StateT DrasilState Identity (VS (r (Value r)))
forall (r :: * -> *).
OOProg r =>
CodeVarChunk -> GenState (SValue r)
mkVal [CodeVarChunk]
constrParams
let cname :: Name
cname = "InputParameters"
getDecl :: ([CodeVarChunk], [CodeVarChunk])
-> GenState (Maybe (MSStatement r))
getDecl ([],[]) = ([CodeVarChunk], [CodeVarChunk])
-> ConstantRepr
-> ConstantStructure
-> GenState (Maybe (MSStatement r))
constIns ((CodeVarChunk -> Bool)
-> [CodeVarChunk] -> ([CodeVarChunk], [CodeVarChunk])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ((Name -> Map Name Name -> Bool) -> Map Name Name -> Name -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Name -> Map Name Name -> Bool
forall k a. Ord k => k -> Map k a -> Bool
member (DrasilState -> Map Name Name
eMap DrasilState
g) (Name -> Bool) -> (CodeVarChunk -> Name) -> CodeVarChunk -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
CodeVarChunk -> Name
forall c. CodeIdea c => c -> Name
codeName) ((CodeDefinition -> CodeVarChunk)
-> [CodeDefinition] -> [CodeVarChunk]
forall a b. (a -> b) -> [a] -> [b]
map CodeDefinition -> CodeVarChunk
forall c. (Quantity c, MayHaveUnit c) => c -> CodeVarChunk
quantvar ([CodeDefinition] -> [CodeVarChunk])
-> [CodeDefinition] -> [CodeVarChunk]
forall a b. (a -> b) -> a -> b
$ CodeSpec -> [CodeDefinition]
constants (CodeSpec -> [CodeDefinition]) -> CodeSpec -> [CodeDefinition]
forall a b. (a -> b) -> a -> b
$ DrasilState -> CodeSpec
codeSpec DrasilState
g)) (DrasilState -> ConstantRepr
conRepr DrasilState
g)
(DrasilState -> ConstantStructure
conStruct DrasilState
g)
getDecl ([],ins :: [CodeVarChunk]
ins) = do
[VS (r (Variable r))]
vars <- (CodeVarChunk -> GenState (VS (r (Variable r))))
-> [CodeVarChunk]
-> StateT DrasilState Identity [VS (r (Variable r))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM CodeVarChunk -> GenState (VS (r (Variable r)))
forall (r :: * -> *).
OOProg r =>
CodeVarChunk -> GenState (SVariable r)
mkVar [CodeVarChunk]
ins
Maybe (MSStatement r) -> GenState (Maybe (MSStatement r))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MSStatement r) -> GenState (Maybe (MSStatement r)))
-> Maybe (MSStatement r) -> GenState (Maybe (MSStatement r))
forall a b. (a -> b) -> a -> b
$ MSStatement r -> Maybe (MSStatement r)
forall a. a -> Maybe a
Just (MSStatement r -> Maybe (MSStatement r))
-> MSStatement r -> Maybe (MSStatement r)
forall a b. (a -> b) -> a -> b
$ [MSStatement r] -> MSStatement r
forall (r :: * -> *).
StatementSym r =>
[MSStatement r] -> MSStatement r
multi ([MSStatement r] -> MSStatement r)
-> [MSStatement r] -> MSStatement r
forall a b. (a -> b) -> a -> b
$ (VS (r (Variable r)) -> MSStatement r)
-> [VS (r (Variable r))] -> [MSStatement r]
forall a b. (a -> b) -> [a] -> [b]
map VS (r (Variable r)) -> MSStatement r
forall (r :: * -> *).
DeclStatement r =>
SVariable r -> MSStatement r
varDec [VS (r (Variable r))]
vars
getDecl (i :: CodeVarChunk
i:_,[]) = Maybe (MSStatement r) -> GenState (Maybe (MSStatement r))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MSStatement r) -> GenState (Maybe (MSStatement r)))
-> Maybe (MSStatement r) -> GenState (Maybe (MSStatement r))
forall a b. (a -> b) -> a -> b
$ MSStatement r -> Maybe (MSStatement r)
forall a. a -> Maybe a
Just (MSStatement r -> Maybe (MSStatement r))
-> MSStatement r -> Maybe (MSStatement r)
forall a b. (a -> b) -> a -> b
$ (if DrasilState -> Name
currentModule DrasilState
g Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
==
DrasilState -> Map Name Name
eMap DrasilState
g Map Name Name -> Name -> Name
forall k a. Ord k => Map k a -> k -> a
! CodeVarChunk -> Name
forall c. CodeIdea c => c -> Name
codeName CodeVarChunk
i then VS (r (Variable r)) -> [VS (r (Value r))] -> MSStatement r
forall (r :: * -> *).
DeclStatement r =>
SVariable r -> [SValue r] -> MSStatement r
objDecNew
else Name -> VS (r (Variable r)) -> [VS (r (Value r))] -> MSStatement r
forall (r :: * -> *).
DeclStatement r =>
Name -> SVariable r -> [SValue r] -> MSStatement r
extObjDecNew Name
cname) VS (r (Variable r))
v_params [VS (r (Value r))]
cps
getDecl _ = Name -> GenState (Maybe (MSStatement r))
forall a. HasCallStack => Name -> a
error ("Inputs or constants are only partially contained in "
Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ "a class")
constIns :: ([CodeVarChunk], [CodeVarChunk])
-> ConstantRepr
-> ConstantStructure
-> GenState (Maybe (MSStatement r))
constIns ([],[]) _ _ = Maybe (MSStatement r) -> GenState (Maybe (MSStatement r))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MSStatement r)
forall a. Maybe a
Nothing
constIns cs :: ([CodeVarChunk], [CodeVarChunk])
cs Var WithInputs = ([CodeVarChunk], [CodeVarChunk])
-> GenState (Maybe (MSStatement r))
getDecl ([CodeVarChunk], [CodeVarChunk])
cs
constIns _ _ _ = Maybe (MSStatement r) -> GenState (Maybe (MSStatement r))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MSStatement r)
forall a. Maybe a
Nothing
([CodeVarChunk], [CodeVarChunk])
-> GenState (Maybe (MSStatement r))
getDecl ((CodeVarChunk -> Bool)
-> [CodeVarChunk] -> ([CodeVarChunk], [CodeVarChunk])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ((Name -> Map Name Name -> Bool) -> Map Name Name -> Name -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Name -> Map Name Name -> Bool
forall k a. Ord k => k -> Map k a -> Bool
member (DrasilState -> Map Name Name
eMap DrasilState
g) (Name -> Bool) -> (CodeVarChunk -> Name) -> CodeVarChunk -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CodeVarChunk -> Name
forall c. CodeIdea c => c -> Name
codeName)
(CodeSpec -> [CodeVarChunk]
inputs (CodeSpec -> [CodeVarChunk]) -> CodeSpec -> [CodeVarChunk]
forall a b. (a -> b) -> a -> b
$ DrasilState -> CodeSpec
codeSpec DrasilState
g))
initConsts :: (OOProg r) => GenState (Maybe (MSStatement r))
initConsts :: GenState (Maybe (MSStatement r))
initConsts = do
DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
VS (r (Variable r))
v_consts <- CodeVarChunk -> GenState (VS (r (Variable r)))
forall (r :: * -> *).
OOProg r =>
CodeVarChunk -> GenState (SVariable r)
mkVar (QuantityDict -> CodeVarChunk
forall c. (Quantity c, MayHaveUnit c) => c -> CodeVarChunk
quantvar QuantityDict
consts)
let cname :: Name
cname = "Constants"
cs :: [CodeDefinition]
cs = CodeSpec -> [CodeDefinition]
constants (CodeSpec -> [CodeDefinition]) -> CodeSpec -> [CodeDefinition]
forall a b. (a -> b) -> a -> b
$ DrasilState -> CodeSpec
codeSpec DrasilState
g
getDecl :: ConstantStructure -> Structure -> GenState (Maybe (MSStatement r))
getDecl (Store Unbundled) _ = GenState (Maybe (MSStatement r))
declVars
getDecl (Store Bundled) _ = (DrasilState -> Maybe (MSStatement r))
-> GenState (Maybe (MSStatement r))
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ([CodeDefinition] -> ConstantRepr -> Maybe (MSStatement r)
forall c.
CodeIdea c =>
[c] -> ConstantRepr -> Maybe (MSStatement r)
declObj [CodeDefinition]
cs (ConstantRepr -> Maybe (MSStatement r))
-> (DrasilState -> ConstantRepr)
-> DrasilState
-> Maybe (MSStatement r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DrasilState -> ConstantRepr
conRepr)
getDecl WithInputs Unbundled = GenState (Maybe (MSStatement r))
declVars
getDecl WithInputs Bundled = Maybe (MSStatement r) -> GenState (Maybe (MSStatement r))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MSStatement r)
forall a. Maybe a
Nothing
getDecl Inline _ = Maybe (MSStatement r) -> GenState (Maybe (MSStatement r))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MSStatement r)
forall a. Maybe a
Nothing
declVars :: GenState (Maybe (MSStatement r))
declVars = do
[VS (r (Variable r))]
vars <- (CodeDefinition -> GenState (VS (r (Variable r))))
-> [CodeDefinition]
-> StateT DrasilState Identity [VS (r (Variable r))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (CodeVarChunk -> GenState (VS (r (Variable r)))
forall (r :: * -> *).
OOProg r =>
CodeVarChunk -> GenState (SVariable r)
mkVar (CodeVarChunk -> GenState (VS (r (Variable r))))
-> (CodeDefinition -> CodeVarChunk)
-> CodeDefinition
-> GenState (VS (r (Variable r)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CodeDefinition -> CodeVarChunk
forall c. (Quantity c, MayHaveUnit c) => c -> CodeVarChunk
quantvar) [CodeDefinition]
cs
[VS (r (Value r))]
vals <- (CodeDefinition -> StateT DrasilState Identity (VS (r (Value r))))
-> [CodeDefinition]
-> StateT DrasilState Identity [VS (r (Value r))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (CodeExpr -> StateT DrasilState Identity (VS (r (Value r)))
forall (r :: * -> *). OOProg r => CodeExpr -> GenState (SValue r)
convExpr (CodeExpr -> StateT DrasilState Identity (VS (r (Value r))))
-> (CodeDefinition -> CodeExpr)
-> CodeDefinition
-> StateT DrasilState Identity (VS (r (Value r)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CodeDefinition
-> Getting CodeExpr CodeDefinition CodeExpr -> CodeExpr
forall s a. s -> Getting a s a -> a
^. Getting CodeExpr CodeDefinition CodeExpr
forall c. DefiningCodeExpr c => Lens' c CodeExpr
codeExpr)) [CodeDefinition]
cs
[[MSStatement r]]
logs <- (VS (r (Variable r))
-> StateT DrasilState Identity [MSStatement r])
-> [VS (r (Variable r))]
-> StateT DrasilState Identity [[MSStatement r]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM VS (r (Variable r)) -> StateT DrasilState Identity [MSStatement r]
forall (r :: * -> *).
OOProg r =>
SVariable r -> GenState [MSStatement r]
maybeLog [VS (r (Variable r))]
vars
Maybe (MSStatement r) -> GenState (Maybe (MSStatement r))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MSStatement r) -> GenState (Maybe (MSStatement r)))
-> Maybe (MSStatement r) -> GenState (Maybe (MSStatement r))
forall a b. (a -> b) -> a -> b
$ MSStatement r -> Maybe (MSStatement r)
forall a. a -> Maybe a
Just (MSStatement r -> Maybe (MSStatement r))
-> MSStatement r -> Maybe (MSStatement r)
forall a b. (a -> b) -> a -> b
$ [MSStatement r] -> MSStatement r
forall (r :: * -> *).
StatementSym r =>
[MSStatement r] -> MSStatement r
multi ([MSStatement r] -> MSStatement r)
-> [MSStatement r] -> MSStatement r
forall a b. (a -> b) -> a -> b
$ (VS (r (Variable r)) -> VS (r (Value r)) -> MSStatement r)
-> [VS (r (Variable r))] -> [VS (r (Value r))] -> [MSStatement r]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (ConstantRepr
-> VS (r (Variable r)) -> VS (r (Value r)) -> MSStatement r
forall (r :: * -> *).
DeclStatement r =>
ConstantRepr
-> VS (r (Variable r)) -> VS (r (Value r)) -> MS (r (Statement r))
defFunc (ConstantRepr
-> VS (r (Variable r)) -> VS (r (Value r)) -> MSStatement r)
-> ConstantRepr
-> VS (r (Variable r))
-> VS (r (Value r))
-> MSStatement r
forall a b. (a -> b) -> a -> b
$ DrasilState -> ConstantRepr
conRepr DrasilState
g) [VS (r (Variable r))]
vars [VS (r (Value r))]
vals [MSStatement r] -> [MSStatement r] -> [MSStatement r]
forall a. [a] -> [a] -> [a]
++
[[MSStatement r]] -> [MSStatement r]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[MSStatement r]]
logs
defFunc :: ConstantRepr
-> VS (r (Variable r)) -> VS (r (Value r)) -> MS (r (Statement r))
defFunc Var = VS (r (Variable r)) -> VS (r (Value r)) -> MS (r (Statement r))
forall (r :: * -> *).
DeclStatement r =>
SVariable r -> SValue r -> MSStatement r
varDecDef
defFunc Const = VS (r (Variable r)) -> VS (r (Value r)) -> MS (r (Statement r))
forall (r :: * -> *).
DeclStatement r =>
SVariable r -> SValue r -> MSStatement r
constDecDef
declObj :: [c] -> ConstantRepr -> Maybe (MSStatement r)
declObj [] _ = Maybe (MSStatement r)
forall a. Maybe a
Nothing
declObj (c :: c
c:_) Var = MSStatement r -> Maybe (MSStatement r)
forall a. a -> Maybe a
Just (MSStatement r -> Maybe (MSStatement r))
-> MSStatement r -> Maybe (MSStatement r)
forall a b. (a -> b) -> a -> b
$ (if DrasilState -> Name
currentModule DrasilState
g Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== DrasilState -> Map Name Name
eMap DrasilState
g Map Name Name -> Name -> Name
forall k a. Ord k => Map k a -> k -> a
! c -> Name
forall c. CodeIdea c => c -> Name
codeName c
c
then VS (r (Variable r)) -> MSStatement r
forall (r :: * -> *).
DeclStatement r =>
SVariable r -> MSStatement r
objDecNewNoParams else Name -> VS (r (Variable r)) -> MSStatement r
forall (r :: * -> *).
DeclStatement r =>
Name -> SVariable r -> MSStatement r
extObjDecNewNoParams Name
cname) VS (r (Variable r))
v_consts
declObj _ Const = Maybe (MSStatement r)
forall a. Maybe a
Nothing
ConstantStructure -> Structure -> GenState (Maybe (MSStatement r))
getDecl (DrasilState -> ConstantStructure
conStruct DrasilState
g) (DrasilState -> Structure
inStruct DrasilState
g)
initLogFileVar :: (OOProg r) => [Logging] -> [MSStatement r]
initLogFileVar :: [Logging] -> [MSStatement r]
initLogFileVar l :: [Logging]
l = [SVariable r -> MSStatement r
forall (r :: * -> *).
DeclStatement r =>
SVariable r -> MSStatement r
varDec SVariable r
forall (r :: * -> *). OOProg r => SVariable r
varLogFile | Logging
LogVar Logging -> [Logging] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Logging]
l]
chooseInModule :: (OOProg r) => InputModule -> GenState [SFile r]
chooseInModule :: InputModule -> GenState [SFile r]
chooseInModule Combined = GenState [SFile r]
forall (r :: * -> *). OOProg r => GenState [SFile r]
genInputModCombined
chooseInModule Separated = GenState [SFile r]
forall (r :: * -> *). OOProg r => GenState [SFile r]
genInputModSeparated
genInputModSeparated :: (OOProg r) => GenState [SFile r]
genInputModSeparated :: GenState [SFile r]
genInputModSeparated = do
Name
ipDesc <- GenState [Name] -> GenState Name
modDesc GenState [Name]
inputParametersDesc
Name
ifDesc <- GenState [Name] -> GenState Name
modDesc (GenState Name -> GenState [Name]
forall a b. State a b -> State a [b]
liftS GenState Name
inputFormatDesc)
Name
dvDesc <- GenState [Name] -> GenState Name
modDesc (GenState Name -> GenState [Name]
forall a b. State a b -> State a [b]
liftS GenState Name
derivedValuesDesc)
Name
icDesc <- GenState [Name] -> GenState Name
modDesc (GenState Name -> GenState [Name]
forall a b. State a b -> State a [b]
liftS GenState Name
inputConstraintsDesc)
[StateT DrasilState Identity (SFile r)] -> GenState [SFile r]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
[Name
-> Name
-> [GenState (Maybe (SMethod r))]
-> [GenState (Maybe (SClass r))]
-> StateT DrasilState Identity (SFile r)
forall (r :: * -> *).
OOProg r =>
Name
-> Name
-> [GenState (Maybe (SMethod r))]
-> [GenState (Maybe (SClass r))]
-> GenState (SFile r)
genModule "InputParameters" Name
ipDesc [] [ClassType -> GenState (Maybe (SClass r))
forall (r :: * -> *).
OOProg r =>
ClassType -> GenState (Maybe (SClass r))
genInputClass ClassType
Primary],
Name
-> Name
-> [GenState (Maybe (SMethod r))]
-> [GenState (Maybe (SClass r))]
-> StateT DrasilState Identity (SFile r)
forall (r :: * -> *).
OOProg r =>
Name
-> Name
-> [GenState (Maybe (SMethod r))]
-> [GenState (Maybe (SClass r))]
-> GenState (SFile r)
genModule "InputFormat" Name
ifDesc [ScopeTag -> GenState (Maybe (SMethod r))
forall (r :: * -> *).
OOProg r =>
ScopeTag -> GenState (Maybe (SMethod r))
genInputFormat ScopeTag
Pub] [],
Name
-> Name
-> [GenState (Maybe (SMethod r))]
-> [GenState (Maybe (SClass r))]
-> StateT DrasilState Identity (SFile r)
forall (r :: * -> *).
OOProg r =>
Name
-> Name
-> [GenState (Maybe (SMethod r))]
-> [GenState (Maybe (SClass r))]
-> GenState (SFile r)
genModule "DerivedValues" Name
dvDesc [ScopeTag -> GenState (Maybe (SMethod r))
forall (r :: * -> *).
OOProg r =>
ScopeTag -> GenState (Maybe (SMethod r))
genInputDerived ScopeTag
Pub] [],
Name
-> Name
-> [GenState (Maybe (SMethod r))]
-> [GenState (Maybe (SClass r))]
-> StateT DrasilState Identity (SFile r)
forall (r :: * -> *).
OOProg r =>
Name
-> Name
-> [GenState (Maybe (SMethod r))]
-> [GenState (Maybe (SClass r))]
-> GenState (SFile r)
genModule "InputConstraints" Name
icDesc [ScopeTag -> GenState (Maybe (SMethod r))
forall (r :: * -> *).
OOProg r =>
ScopeTag -> GenState (Maybe (SMethod r))
genInputConstraints ScopeTag
Pub] []]
genInputModCombined :: (OOProg r) => GenState [SFile r]
genInputModCombined :: GenState [SFile r]
genInputModCombined = do
Name
ipDesc <- GenState [Name] -> GenState Name
modDesc GenState [Name]
inputParametersDesc
let cname :: Name
cname = "InputParameters"
genMod :: (OOProg r) => Maybe (SClass r) ->
GenState (SFile r)
genMod :: Maybe (SClass r) -> GenState (SFile r)
genMod Nothing = Name
-> Name
-> [GenState (Maybe (SMethod r))]
-> [GenState (Maybe (SClass r))]
-> GenState (SFile r)
forall (r :: * -> *).
OOProg r =>
Name
-> Name
-> [GenState (Maybe (SMethod r))]
-> [GenState (Maybe (SClass r))]
-> GenState (SFile r)
genModule Name
cname Name
ipDesc [ScopeTag -> GenState (Maybe (SMethod r))
forall (r :: * -> *).
OOProg r =>
ScopeTag -> GenState (Maybe (SMethod r))
genInputFormat ScopeTag
Pub,
ScopeTag -> GenState (Maybe (SMethod r))
forall (r :: * -> *).
OOProg r =>
ScopeTag -> GenState (Maybe (SMethod r))
genInputDerived ScopeTag
Pub, ScopeTag -> GenState (Maybe (SMethod r))
forall (r :: * -> *).
OOProg r =>
ScopeTag -> GenState (Maybe (SMethod r))
genInputConstraints ScopeTag
Pub] []
genMod _ = Name
-> Name
-> [GenState (Maybe (SMethod r))]
-> [GenState (Maybe (SClass r))]
-> GenState (SFile r)
forall (r :: * -> *).
OOProg r =>
Name
-> Name
-> [GenState (Maybe (SMethod r))]
-> [GenState (Maybe (SClass r))]
-> GenState (SFile r)
genModule Name
cname Name
ipDesc [] [ClassType -> GenState (Maybe (SClass r))
forall (r :: * -> *).
OOProg r =>
ClassType -> GenState (Maybe (SClass r))
genInputClass ClassType
Primary]
Maybe (CS (r (Class r)))
ic <- ClassType -> GenState (Maybe (CS (r (Class r))))
forall (r :: * -> *).
OOProg r =>
ClassType -> GenState (Maybe (SClass r))
genInputClass ClassType
Primary
State DrasilState (SFile r) -> GenState [SFile r]
forall a b. State a b -> State a [b]
liftS (State DrasilState (SFile r) -> GenState [SFile r])
-> State DrasilState (SFile r) -> GenState [SFile r]
forall a b. (a -> b) -> a -> b
$ Maybe (CS (r (Class r))) -> State DrasilState (SFile r)
forall (r :: * -> *).
OOProg r =>
Maybe (SClass r) -> GenState (SFile r)
genMod Maybe (CS (r (Class r)))
ic
constVarFunc :: (OOProg r) => ConstantRepr ->
(SVariable r -> SValue r -> CSStateVar r)
constVarFunc :: ConstantRepr -> SVariable r -> SValue r -> CSStateVar r
constVarFunc Var = r (Scope r)
-> r (Permanence r) -> SVariable r -> SValue r -> CSStateVar r
forall (r :: * -> *).
StateVarSym r =>
r (Scope r)
-> r (Permanence r) -> SVariable r -> SValue r -> CSStateVar r
stateVarDef r (Scope r)
forall (r :: * -> *). ScopeSym r => r (Scope r)
public r (Permanence r)
forall (r :: * -> *). PermanenceSym r => r (Permanence r)
dynamic
constVarFunc Const = r (Scope r) -> SVariable r -> SValue r -> CSStateVar r
forall (r :: * -> *).
StateVarSym r =>
r (Scope r) -> SVariable r -> SValue r -> CSStateVar r
constVar r (Scope r)
forall (r :: * -> *). ScopeSym r => r (Scope r)
public
genInputClass :: (OOProg r) => ClassType ->
GenState (Maybe (SClass r))
genInputClass :: ClassType -> GenState (Maybe (SClass r))
genInputClass scp :: ClassType
scp = do
DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
let ins :: [CodeVarChunk]
ins = CodeSpec -> [CodeVarChunk]
inputs (CodeSpec -> [CodeVarChunk]) -> CodeSpec -> [CodeVarChunk]
forall a b. (a -> b) -> a -> b
$ DrasilState -> CodeSpec
codeSpec DrasilState
g
cs :: [CodeDefinition]
cs = CodeSpec -> [CodeDefinition]
constants (CodeSpec -> [CodeDefinition]) -> CodeSpec -> [CodeDefinition]
forall a b. (a -> b) -> a -> b
$ DrasilState -> CodeSpec
codeSpec DrasilState
g
filt :: (CodeIdea c) => [c] -> [c]
filt :: [c] -> [c]
filt = (c -> Bool) -> [c] -> [c]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Name -> Maybe Name
forall a. a -> Maybe a
Just Name
cname Maybe Name -> Maybe Name -> Bool
forall a. Eq a => a -> a -> Bool
==) (Maybe Name -> Bool) -> (c -> Maybe Name) -> c -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name -> Map Name Name -> Maybe Name)
-> Map Name Name -> Name -> Maybe Name
forall a b c. (a -> b -> c) -> b -> a -> c
flip Name -> Map Name Name -> Maybe Name
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (DrasilState -> Map Name Name
clsMap DrasilState
g) (Name -> Maybe Name) -> (c -> Name) -> c -> Maybe Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> Name
forall c. CodeIdea c => c -> Name
codeName)
methods :: (OOProg r) => GenState [SMethod r]
methods :: GenState [SMethod r]
methods = if Name
cname Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` DrasilState -> [Name]
defList DrasilState
g
then [[SMethod r]] -> [SMethod r]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[SMethod r]] -> [SMethod r])
-> StateT DrasilState Identity [[SMethod r]]
-> GenState [SMethod r]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (StateT DrasilState Identity (Maybe (SMethod r))
-> GenState [SMethod r])
-> [StateT DrasilState Identity (Maybe (SMethod r))]
-> StateT DrasilState Identity [[SMethod r]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Maybe (SMethod r) -> [SMethod r])
-> StateT DrasilState Identity (Maybe (SMethod r))
-> GenState [SMethod r]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe (SMethod r) -> [SMethod r]
forall a. Maybe a -> [a]
maybeToList) [StateT DrasilState Identity (Maybe (SMethod r))
forall (r :: * -> *). OOProg r => GenState (Maybe (SMethod r))
genInputConstructor,
ScopeTag -> StateT DrasilState Identity (Maybe (SMethod r))
forall (r :: * -> *).
OOProg r =>
ScopeTag -> GenState (Maybe (SMethod r))
genInputFormat ScopeTag
Priv, ScopeTag -> StateT DrasilState Identity (Maybe (SMethod r))
forall (r :: * -> *).
OOProg r =>
ScopeTag -> GenState (Maybe (SMethod r))
genInputDerived ScopeTag
Priv, ScopeTag -> StateT DrasilState Identity (Maybe (SMethod r))
forall (r :: * -> *).
OOProg r =>
ScopeTag -> GenState (Maybe (SMethod r))
genInputConstraints ScopeTag
Priv]
else [SMethod r] -> GenState [SMethod r]
forall (m :: * -> *) a. Monad m => a -> m a
return []
genClass :: (OOProg r) => [CodeVarChunk] -> [CodeDefinition] ->
GenState (Maybe (SClass r))
genClass :: [CodeVarChunk] -> [CodeDefinition] -> GenState (Maybe (SClass r))
genClass [] [] = Maybe (SClass r) -> GenState (Maybe (SClass r))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (SClass r)
forall a. Maybe a
Nothing
genClass inps :: [CodeVarChunk]
inps csts :: [CodeDefinition]
csts = do
[VS (r (Value r))]
vals <- (CodeDefinition -> StateT DrasilState Identity (VS (r (Value r))))
-> [CodeDefinition]
-> StateT DrasilState Identity [VS (r (Value r))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (CodeExpr -> StateT DrasilState Identity (VS (r (Value r)))
forall (r :: * -> *). OOProg r => CodeExpr -> GenState (SValue r)
convExpr (CodeExpr -> StateT DrasilState Identity (VS (r (Value r))))
-> (CodeDefinition -> CodeExpr)
-> CodeDefinition
-> StateT DrasilState Identity (VS (r (Value r)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CodeDefinition
-> Getting CodeExpr CodeDefinition CodeExpr -> CodeExpr
forall s a. s -> Getting a s a -> a
^. Getting CodeExpr CodeDefinition CodeExpr
forall c. DefiningCodeExpr c => Lens' c CodeExpr
codeExpr)) [CodeDefinition]
csts
[CS (r (StateVar r))]
inputVars <- (CodeVarChunk -> StateT DrasilState Identity (CS (r (StateVar r))))
-> [CodeVarChunk]
-> StateT DrasilState Identity [CS (r (StateVar r))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\x :: CodeVarChunk
x -> (CodeType -> CS (r (StateVar r)))
-> StateT DrasilState Identity CodeType
-> StateT DrasilState Identity (CS (r (StateVar r)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SVariable r -> CS (r (StateVar r))
forall (r :: * -> *). StateVarSym r => SVariable r -> CSStateVar r
pubDVar (SVariable r -> CS (r (StateVar r)))
-> (CodeType -> SVariable r) -> CodeType -> CS (r (StateVar r))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> VSType r -> SVariable r
forall (r :: * -> *).
VariableSym r =>
Name -> VSType r -> SVariable r
var (CodeVarChunk -> Name
forall c. CodeIdea c => c -> Name
codeName CodeVarChunk
x) (VSType r -> SVariable r)
-> (CodeType -> VSType r) -> CodeType -> SVariable r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CodeType -> VSType r
forall (r :: * -> *). TypeSym r => CodeType -> VSType r
convType)
(CodeVarChunk -> StateT DrasilState Identity CodeType
forall c. HasSpace c => c -> StateT DrasilState Identity CodeType
codeType CodeVarChunk
x)) [CodeVarChunk]
inps
[CS (r (StateVar r))]
constVars <- (CodeDefinition
-> VS (r (Value r))
-> StateT DrasilState Identity (CS (r (StateVar r))))
-> [CodeDefinition]
-> [VS (r (Value r))]
-> StateT DrasilState Identity [CS (r (StateVar r))]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (\c :: CodeDefinition
c vl :: VS (r (Value r))
vl -> (CodeType -> CS (r (StateVar r)))
-> StateT DrasilState Identity CodeType
-> StateT DrasilState Identity (CS (r (StateVar r)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\t :: CodeType
t -> ConstantRepr
-> SVariable r -> VS (r (Value r)) -> CS (r (StateVar r))
forall (r :: * -> *).
OOProg r =>
ConstantRepr -> SVariable r -> SValue r -> CSStateVar r
constVarFunc (DrasilState -> ConstantRepr
conRepr DrasilState
g)
(Name -> VSType r -> SVariable r
forall (r :: * -> *).
VariableSym r =>
Name -> VSType r -> SVariable r
var (CodeDefinition -> Name
forall c. CodeIdea c => c -> Name
codeName CodeDefinition
c) (CodeType -> VSType r
forall (r :: * -> *). TypeSym r => CodeType -> VSType r
convType CodeType
t)) VS (r (Value r))
vl) (CodeDefinition -> StateT DrasilState Identity CodeType
forall c. HasSpace c => c -> StateT DrasilState Identity CodeType
codeType CodeDefinition
c))
[CodeDefinition]
csts [VS (r (Value r))]
vals
let getFunc :: ClassType
-> Name
-> Maybe Name
-> Name
-> [CS (r (StateVar r))]
-> GenState [MS (r (Method r))]
-> GenState (CS (r (Class r)))
getFunc Primary = Name
-> Maybe Name
-> Name
-> [CS (r (StateVar r))]
-> GenState [MS (r (Method r))]
-> GenState (CS (r (Class r)))
forall (r :: * -> *).
OOProg r =>
Name
-> Maybe Name
-> Name
-> [CSStateVar r]
-> GenState [SMethod r]
-> GenState (SClass r)
primaryClass
getFunc Auxiliary = Name
-> Maybe Name
-> Name
-> [CS (r (StateVar r))]
-> GenState [MS (r (Method r))]
-> GenState (CS (r (Class r)))
forall (r :: * -> *).
OOProg r =>
Name
-> Maybe Name
-> Name
-> [CSStateVar r]
-> GenState [SMethod r]
-> GenState (SClass r)
auxClass
f :: Name
-> Maybe Name
-> Name
-> [CS (r (StateVar r))]
-> GenState [MS (r (Method r))]
-> GenState (SClass r)
f = ClassType
-> Name
-> Maybe Name
-> Name
-> [CS (r (StateVar r))]
-> GenState [MS (r (Method r))]
-> GenState (SClass r)
forall (r :: * -> *).
OOProg r =>
ClassType
-> Name
-> Maybe Name
-> Name
-> [CS (r (StateVar r))]
-> GenState [MS (r (Method r))]
-> GenState (CS (r (Class r)))
getFunc ClassType
scp
Name
icDesc <- GenState Name
inputClassDesc
SClass r
c <- Name
-> Maybe Name
-> Name
-> [CS (r (StateVar r))]
-> GenState [MS (r (Method r))]
-> GenState (SClass r)
f Name
cname Maybe Name
forall a. Maybe a
Nothing Name
icDesc ([CS (r (StateVar r))]
inputVars [CS (r (StateVar r))]
-> [CS (r (StateVar r))] -> [CS (r (StateVar r))]
forall a. [a] -> [a] -> [a]
++ [CS (r (StateVar r))]
constVars) GenState [MS (r (Method r))]
forall (r :: * -> *). OOProg r => GenState [SMethod r]
methods
Maybe (SClass r) -> GenState (Maybe (SClass r))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (SClass r) -> GenState (Maybe (SClass r)))
-> Maybe (SClass r) -> GenState (Maybe (SClass r))
forall a b. (a -> b) -> a -> b
$ SClass r -> Maybe (SClass r)
forall a. a -> Maybe a
Just SClass r
c
[CodeVarChunk] -> [CodeDefinition] -> GenState (Maybe (SClass r))
forall (r :: * -> *).
OOProg r =>
[CodeVarChunk] -> [CodeDefinition] -> GenState (Maybe (SClass r))
genClass ([CodeVarChunk] -> [CodeVarChunk]
forall c. CodeIdea c => [c] -> [c]
filt [CodeVarChunk]
ins) ([CodeDefinition] -> [CodeDefinition]
forall c. CodeIdea c => [c] -> [c]
filt [CodeDefinition]
cs)
where cname :: Name
cname = "InputParameters"
genInputConstructor :: (OOProg r) => GenState (Maybe (SMethod r))
genInputConstructor :: GenState (Maybe (SMethod r))
genInputConstructor = do
DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
let dl :: [Name]
dl = DrasilState -> [Name]
defList DrasilState
g
genCtor :: Bool -> StateT DrasilState Identity (Maybe (MS (r (Method r))))
genCtor False = Maybe (MS (r (Method r)))
-> StateT DrasilState Identity (Maybe (MS (r (Method r))))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MS (r (Method r)))
forall a. Maybe a
Nothing
genCtor True = do
Name
cdesc <- GenState Name
inputConstructorDesc
[CodeVarChunk]
cparams <- GenState [CodeVarChunk]
getInConstructorParams
[MS (r (Statement r))]
ics <- GenState [MS (r (Statement r))]
forall (r :: * -> *). OOProg r => GenState [MSStatement r]
getAllInputCalls
MS (r (Method r))
ctor <- Name
-> Name
-> [ParameterChunk]
-> [MSBlock r]
-> GenState (MS (r (Method r)))
forall (r :: * -> *).
OOProg r =>
Name
-> Name -> [ParameterChunk] -> [MSBlock r] -> GenState (SMethod r)
genConstructor "InputParameters" Name
cdesc ((CodeVarChunk -> ParameterChunk)
-> [CodeVarChunk] -> [ParameterChunk]
forall a b. (a -> b) -> [a] -> [b]
map CodeVarChunk -> ParameterChunk
forall c. CodeIdea c => c -> ParameterChunk
pcAuto [CodeVarChunk]
cparams)
[[MS (r (Statement r))] -> MSBlock r
forall (r :: * -> *). BlockSym r => [MSStatement r] -> MSBlock r
block [MS (r (Statement r))]
ics]
Maybe (MS (r (Method r)))
-> StateT DrasilState Identity (Maybe (MS (r (Method r))))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MS (r (Method r)))
-> StateT DrasilState Identity (Maybe (MS (r (Method r)))))
-> Maybe (MS (r (Method r)))
-> StateT DrasilState Identity (Maybe (MS (r (Method r))))
forall a b. (a -> b) -> a -> b
$ MS (r (Method r)) -> Maybe (MS (r (Method r)))
forall a. a -> Maybe a
Just MS (r (Method r))
ctor
Bool -> GenState (Maybe (SMethod r))
forall (r :: * -> *).
OOProg r =>
Bool -> StateT DrasilState Identity (Maybe (MS (r (Method r))))
genCtor (Bool -> GenState (Maybe (SMethod r)))
-> Bool -> GenState (Maybe (SMethod r))
forall a b. (a -> b) -> a -> b
$ (Name -> Bool) -> [Name] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
dl) ["get_input", "derived_values",
"input_constraints"]
genInputDerived :: (OOProg r) => ScopeTag ->
GenState (Maybe (SMethod r))
genInputDerived :: ScopeTag -> GenState (Maybe (SMethod r))
genInputDerived s :: ScopeTag
s = do
DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
let dvals :: [CodeDefinition]
dvals = CodeSpec -> [CodeDefinition]
derivedInputs (CodeSpec -> [CodeDefinition]) -> CodeSpec -> [CodeDefinition]
forall a b. (a -> b) -> a -> b
$ DrasilState -> CodeSpec
codeSpec DrasilState
g
getFunc :: ScopeTag
-> Name
-> Name
-> [CodeVarChunk]
-> [CodeVarChunk]
-> [MS (r (Block r))]
-> GenState (MS (r (Method r)))
getFunc Pub = Name
-> Name
-> [CodeVarChunk]
-> [CodeVarChunk]
-> [MS (r (Block r))]
-> GenState (MS (r (Method r)))
forall (r :: * -> *).
OOProg r =>
Name
-> Name
-> [CodeVarChunk]
-> [CodeVarChunk]
-> [MSBlock r]
-> GenState (SMethod r)
publicInOutFunc
getFunc Priv = Name
-> Name
-> [CodeVarChunk]
-> [CodeVarChunk]
-> [MS (r (Block r))]
-> GenState (MS (r (Method r)))
forall (r :: * -> *).
OOProg r =>
Name
-> Name
-> [CodeVarChunk]
-> [CodeVarChunk]
-> [MSBlock r]
-> GenState (SMethod r)
privateInOutMethod
genDerived :: (OOProg r) => Bool -> GenState
(Maybe (SMethod r))
genDerived :: Bool -> GenState (Maybe (SMethod r))
genDerived False = Maybe (SMethod r) -> GenState (Maybe (SMethod r))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (SMethod r)
forall a. Maybe a
Nothing
genDerived _ = do
[CodeVarChunk]
ins <- GenState [CodeVarChunk]
getDerivedIns
[CodeVarChunk]
outs <- GenState [CodeVarChunk]
getDerivedOuts
[MS (r (Block r))]
bod <- (CodeDefinition -> StateT DrasilState Identity (MS (r (Block r))))
-> [CodeDefinition]
-> StateT DrasilState Identity [MS (r (Block r))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\x :: CodeDefinition
x -> CalcType
-> CodeDefinition
-> CodeExpr
-> StateT DrasilState Identity (MS (r (Block r)))
forall (r :: * -> *).
OOProg r =>
CalcType -> CodeDefinition -> CodeExpr -> GenState (MSBlock r)
genCalcBlock CalcType
CalcAssign CodeDefinition
x (CodeDefinition
x CodeDefinition
-> Getting CodeExpr CodeDefinition CodeExpr -> CodeExpr
forall s a. s -> Getting a s a -> a
^. Getting CodeExpr CodeDefinition CodeExpr
forall c. DefiningCodeExpr c => Lens' c CodeExpr
codeExpr)) [CodeDefinition]
dvals
Name
desc <- GenState Name
dvFuncDesc
SMethod r
mthd <- ScopeTag
-> Name
-> Name
-> [CodeVarChunk]
-> [CodeVarChunk]
-> [MS (r (Block r))]
-> GenState (SMethod r)
forall (r :: * -> *).
OOProg r =>
ScopeTag
-> Name
-> Name
-> [CodeVarChunk]
-> [CodeVarChunk]
-> [MS (r (Block r))]
-> GenState (MS (r (Method r)))
getFunc ScopeTag
s "derived_values" Name
desc [CodeVarChunk]
ins [CodeVarChunk]
outs [MS (r (Block r))]
bod
Maybe (SMethod r) -> GenState (Maybe (SMethod r))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (SMethod r) -> GenState (Maybe (SMethod r)))
-> Maybe (SMethod r) -> GenState (Maybe (SMethod r))
forall a b. (a -> b) -> a -> b
$ SMethod r -> Maybe (SMethod r)
forall a. a -> Maybe a
Just SMethod r
mthd
Bool -> GenState (Maybe (SMethod r))
forall (r :: * -> *).
OOProg r =>
Bool -> StateT DrasilState Identity (Maybe (MS (r (Method r))))
genDerived (Bool -> GenState (Maybe (SMethod r)))
-> Bool -> GenState (Maybe (SMethod r))
forall a b. (a -> b) -> a -> b
$ "derived_values" Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` DrasilState -> [Name]
defList DrasilState
g
genInputConstraints :: (OOProg r) => ScopeTag ->
GenState (Maybe (SMethod r))
genInputConstraints :: ScopeTag -> GenState (Maybe (SMethod r))
genInputConstraints s :: ScopeTag
s = do
DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
let cm :: ConstraintCEMap
cm = CodeSpec -> ConstraintCEMap
cMap (CodeSpec -> ConstraintCEMap) -> CodeSpec -> ConstraintCEMap
forall a b. (a -> b) -> a -> b
$ DrasilState -> CodeSpec
codeSpec DrasilState
g
getFunc :: ScopeTag
-> Name
-> VS (r (Type r))
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MS (r (Block r))]
-> GenState (MS (r (Method r)))
getFunc Pub = Name
-> VS (r (Type r))
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MS (r (Block r))]
-> GenState (MS (r (Method r)))
forall (r :: * -> *).
OOProg r =>
Name
-> VSType r
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MSBlock r]
-> GenState (SMethod r)
publicFunc
getFunc Priv = Name
-> VS (r (Type r))
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MS (r (Block r))]
-> GenState (MS (r (Method r)))
forall (r :: * -> *).
OOProg r =>
Name
-> VSType r
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MSBlock r]
-> GenState (SMethod r)
privateMethod
genConstraints :: (OOProg r) => Bool -> GenState
(Maybe (SMethod r))
genConstraints :: Bool -> GenState (Maybe (SMethod r))
genConstraints False = Maybe (SMethod r) -> GenState (Maybe (SMethod r))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (SMethod r)
forall a. Maybe a
Nothing
genConstraints _ = do
[CodeVarChunk]
parms <- GenState [CodeVarChunk]
getConstraintParams
let varsList :: [CodeVarChunk]
varsList = (CodeVarChunk -> Bool) -> [CodeVarChunk] -> [CodeVarChunk]
forall a. (a -> Bool) -> [a] -> [a]
filter (\i :: CodeVarChunk
i -> UID -> ConstraintCEMap -> Bool
forall k a. Ord k => k -> Map k a -> Bool
member (CodeVarChunk
i CodeVarChunk -> Getting UID CodeVarChunk UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID CodeVarChunk UID
forall c. HasUID c => Lens' c UID
uid) ConstraintCEMap
cm) (CodeSpec -> [CodeVarChunk]
inputs (CodeSpec -> [CodeVarChunk]) -> CodeSpec -> [CodeVarChunk]
forall a b. (a -> b) -> a -> b
$ DrasilState -> CodeSpec
codeSpec DrasilState
g)
sfwrCs :: [(CodeVarChunk, [ConstraintCE])]
sfwrCs = (CodeVarChunk -> (CodeVarChunk, [ConstraintCE]))
-> [CodeVarChunk] -> [(CodeVarChunk, [ConstraintCE])]
forall a b. (a -> b) -> [a] -> [b]
map (ConstraintCEMap -> CodeVarChunk -> (CodeVarChunk, [ConstraintCE])
forall q. HasUID q => ConstraintCEMap -> q -> (q, [ConstraintCE])
sfwrLookup ConstraintCEMap
cm) [CodeVarChunk]
varsList
physCs :: [(CodeVarChunk, [ConstraintCE])]
physCs = (CodeVarChunk -> (CodeVarChunk, [ConstraintCE]))
-> [CodeVarChunk] -> [(CodeVarChunk, [ConstraintCE])]
forall a b. (a -> b) -> [a] -> [b]
map (ConstraintCEMap -> CodeVarChunk -> (CodeVarChunk, [ConstraintCE])
forall q. HasUID q => ConstraintCEMap -> q -> (q, [ConstraintCE])
physLookup ConstraintCEMap
cm) [CodeVarChunk]
varsList
[MS (r (Statement r))]
sf <- [(CodeVarChunk, [ConstraintCE])] -> GenState [MS (r (Statement r))]
forall (r :: * -> *).
OOProg r =>
[(CodeVarChunk, [ConstraintCE])] -> GenState [MSStatement r]
sfwrCBody [(CodeVarChunk, [ConstraintCE])]
sfwrCs
[MS (r (Statement r))]
ph <- [(CodeVarChunk, [ConstraintCE])] -> GenState [MS (r (Statement r))]
forall (r :: * -> *).
OOProg r =>
[(CodeVarChunk, [ConstraintCE])] -> GenState [MSStatement r]
physCBody [(CodeVarChunk, [ConstraintCE])]
physCs
Name
desc <- GenState Name
inConsFuncDesc
SMethod r
mthd <- ScopeTag
-> Name
-> VS (r (Type r))
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MS (r (Block r))]
-> GenState (SMethod r)
forall (r :: * -> *).
OOProg r =>
ScopeTag
-> Name
-> VS (r (Type r))
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MS (r (Block r))]
-> GenState (MS (r (Method r)))
getFunc ScopeTag
s "input_constraints" VS (r (Type r))
forall (r :: * -> *). TypeSym r => VSType r
void Name
desc ((CodeVarChunk -> ParameterChunk)
-> [CodeVarChunk] -> [ParameterChunk]
forall a b. (a -> b) -> [a] -> [b]
map CodeVarChunk -> ParameterChunk
forall c. CodeIdea c => c -> ParameterChunk
pcAuto [CodeVarChunk]
parms)
Maybe Name
forall a. Maybe a
Nothing [[MS (r (Statement r))] -> MS (r (Block r))
forall (r :: * -> *). BlockSym r => [MSStatement r] -> MSBlock r
block [MS (r (Statement r))]
sf, [MS (r (Statement r))] -> MS (r (Block r))
forall (r :: * -> *). BlockSym r => [MSStatement r] -> MSBlock r
block [MS (r (Statement r))]
ph]
Maybe (SMethod r) -> GenState (Maybe (SMethod r))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (SMethod r) -> GenState (Maybe (SMethod r)))
-> Maybe (SMethod r) -> GenState (Maybe (SMethod r))
forall a b. (a -> b) -> a -> b
$ SMethod r -> Maybe (SMethod r)
forall a. a -> Maybe a
Just SMethod r
mthd
Bool -> GenState (Maybe (SMethod r))
forall (r :: * -> *).
OOProg r =>
Bool -> StateT DrasilState Identity (Maybe (MS (r (Method r))))
genConstraints (Bool -> GenState (Maybe (SMethod r)))
-> Bool -> GenState (Maybe (SMethod r))
forall a b. (a -> b) -> a -> b
$ "input_constraints" Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` DrasilState -> [Name]
defList DrasilState
g
sfwrCBody :: (OOProg r) => [(CodeVarChunk, [ConstraintCE])] ->
GenState [MSStatement r]
sfwrCBody :: [(CodeVarChunk, [ConstraintCE])] -> GenState [MSStatement r]
sfwrCBody cs :: [(CodeVarChunk, [ConstraintCE])]
cs = do
DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
let cb :: ConstraintBehaviour
cb = DrasilState -> ConstraintBehaviour
onSfwrC DrasilState
g
ConstraintBehaviour
-> [(CodeVarChunk, [ConstraintCE])] -> GenState [MSStatement r]
forall (r :: * -> *).
OOProg r =>
ConstraintBehaviour
-> [(CodeVarChunk, [ConstraintCE])] -> GenState [MSStatement r]
chooseConstr ConstraintBehaviour
cb [(CodeVarChunk, [ConstraintCE])]
cs
physCBody :: (OOProg r) => [(CodeVarChunk, [ConstraintCE])] ->
GenState [MSStatement r]
physCBody :: [(CodeVarChunk, [ConstraintCE])] -> GenState [MSStatement r]
physCBody cs :: [(CodeVarChunk, [ConstraintCE])]
cs = do
DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
let cb :: ConstraintBehaviour
cb = DrasilState -> ConstraintBehaviour
onPhysC DrasilState
g
ConstraintBehaviour
-> [(CodeVarChunk, [ConstraintCE])] -> GenState [MSStatement r]
forall (r :: * -> *).
OOProg r =>
ConstraintBehaviour
-> [(CodeVarChunk, [ConstraintCE])] -> GenState [MSStatement r]
chooseConstr ConstraintBehaviour
cb [(CodeVarChunk, [ConstraintCE])]
cs
chooseConstr :: (OOProg r) => ConstraintBehaviour ->
[(CodeVarChunk, [ConstraintCE])] -> GenState [MSStatement r]
chooseConstr :: ConstraintBehaviour
-> [(CodeVarChunk, [ConstraintCE])] -> GenState [MSStatement r]
chooseConstr cb :: ConstraintBehaviour
cb cs :: [(CodeVarChunk, [ConstraintCE])]
cs = do
[[VS (r (Value r))]]
conds <- ((CodeVarChunk, [ConstraintCE])
-> StateT DrasilState Identity [VS (r (Value r))])
-> [(CodeVarChunk, [ConstraintCE])]
-> StateT DrasilState Identity [[VS (r (Value r))]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(q :: CodeVarChunk
q,cns :: [ConstraintCE]
cns) -> (ConstraintCE -> StateT DrasilState Identity (VS (r (Value r))))
-> [ConstraintCE] -> StateT DrasilState Identity [VS (r (Value r))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (CodeExpr -> StateT DrasilState Identity (VS (r (Value r)))
forall (r :: * -> *). OOProg r => CodeExpr -> GenState (SValue r)
convExpr (CodeExpr -> StateT DrasilState Identity (VS (r (Value r))))
-> (ConstraintCE -> CodeExpr)
-> ConstraintCE
-> StateT DrasilState Identity (VS (r (Value r)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CodeVarChunk -> ConstraintCE -> CodeExpr
forall c. (HasUID c, HasSymbol c) => c -> ConstraintCE -> CodeExpr
renderC CodeVarChunk
q) [ConstraintCE]
cns) [(CodeVarChunk, [ConstraintCE])]
cs
[[MS (r (Body r))]]
bods <- ((CodeVarChunk, [ConstraintCE])
-> StateT DrasilState Identity [MS (r (Body r))])
-> [(CodeVarChunk, [ConstraintCE])]
-> StateT DrasilState Identity [[MS (r (Body r))]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ConstraintBehaviour
-> (CodeVarChunk, [ConstraintCE])
-> StateT DrasilState Identity [MS (r (Body r))]
forall (r :: * -> *).
OOProg r =>
ConstraintBehaviour
-> (CodeVarChunk, [ConstraintCE]) -> GenState [MS (r (Body r))]
chooseCB ConstraintBehaviour
cb) [(CodeVarChunk, [ConstraintCE])]
cs
[MSStatement r] -> GenState [MSStatement r]
forall (m :: * -> *) a. Monad m => a -> m a
return ([MSStatement r] -> GenState [MSStatement r])
-> [MSStatement r] -> GenState [MSStatement r]
forall a b. (a -> b) -> a -> b
$ [[MSStatement r]] -> [MSStatement r]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[MSStatement r]] -> [MSStatement r])
-> [[MSStatement r]] -> [MSStatement r]
forall a b. (a -> b) -> a -> b
$ ([VS (r (Value r))] -> [MS (r (Body r))] -> [MSStatement r])
-> [[VS (r (Value r))]] -> [[MS (r (Body r))]] -> [[MSStatement r]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ((VS (r (Value r)) -> MS (r (Body r)) -> MSStatement r)
-> [VS (r (Value r))] -> [MS (r (Body r))] -> [MSStatement r]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\cond :: VS (r (Value r))
cond bod :: MS (r (Body r))
bod -> [(VS (r (Value r)), MS (r (Body r)))] -> MSStatement r
forall (r :: * -> *).
ControlStatement r =>
[(SValue r, MSBody r)] -> MSStatement r
ifNoElse [(VS (r (Value r)) -> VS (r (Value r))
forall (r :: * -> *). BooleanExpression r => SValue r -> SValue r
(?!) VS (r (Value r))
cond, MS (r (Body r))
bod)]))
[[VS (r (Value r))]]
conds [[MS (r (Body r))]]
bods
where chooseCB :: ConstraintBehaviour
-> (CodeVarChunk, [ConstraintCE]) -> GenState [MS (r (Body r))]
chooseCB Warning = (CodeVarChunk, [ConstraintCE]) -> GenState [MS (r (Body r))]
forall (r :: * -> *).
OOProg r =>
(CodeVarChunk, [ConstraintCE]) -> GenState [MSBody r]
constrWarn
chooseCB Exception = (CodeVarChunk, [ConstraintCE]) -> GenState [MS (r (Body r))]
forall (r :: * -> *).
OOProg r =>
(CodeVarChunk, [ConstraintCE]) -> GenState [MSBody r]
constrExc
constrWarn :: (OOProg r) => (CodeVarChunk, [ConstraintCE]) ->
GenState [MSBody r]
constrWarn :: (CodeVarChunk, [ConstraintCE]) -> GenState [MSBody r]
constrWarn c :: (CodeVarChunk, [ConstraintCE])
c = do
let q :: CodeVarChunk
q = (CodeVarChunk, [ConstraintCE]) -> CodeVarChunk
forall a b. (a, b) -> a
fst (CodeVarChunk, [ConstraintCE])
c
cs :: [ConstraintCE]
cs = (CodeVarChunk, [ConstraintCE]) -> [ConstraintCE]
forall a b. (a, b) -> b
snd (CodeVarChunk, [ConstraintCE])
c
[[MS (r (Statement r))]]
msgs <- (ConstraintCE
-> StateT DrasilState Identity [MS (r (Statement r))])
-> [ConstraintCE]
-> StateT DrasilState Identity [[MS (r (Statement r))]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (CodeVarChunk
-> Name
-> ConstraintCE
-> StateT DrasilState Identity [MS (r (Statement r))]
forall (r :: * -> *).
OOProg r =>
CodeVarChunk -> Name -> ConstraintCE -> GenState [MSStatement r]
constraintViolatedMsg CodeVarChunk
q "suggested") [ConstraintCE]
cs
[MSBody r] -> GenState [MSBody r]
forall (m :: * -> *) a. Monad m => a -> m a
return ([MSBody r] -> GenState [MSBody r])
-> [MSBody r] -> GenState [MSBody r]
forall a b. (a -> b) -> a -> b
$ ([MS (r (Statement r))] -> MSBody r)
-> [[MS (r (Statement r))]] -> [MSBody r]
forall a b. (a -> b) -> [a] -> [b]
map ([MS (r (Statement r))] -> MSBody r
forall (r :: * -> *). BodySym r => [MSStatement r] -> MSBody r
bodyStatements ([MS (r (Statement r))] -> MSBody r)
-> ([MS (r (Statement r))] -> [MS (r (Statement r))])
-> [MS (r (Statement r))]
-> MSBody r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name -> MS (r (Statement r))
forall (r :: * -> *). IOStatement r => Name -> MSStatement r
printStr "Warning: " MS (r (Statement r))
-> [MS (r (Statement r))] -> [MS (r (Statement r))]
forall a. a -> [a] -> [a]
:)) [[MS (r (Statement r))]]
msgs
constrExc :: (OOProg r) => (CodeVarChunk, [ConstraintCE]) ->
GenState [MSBody r]
constrExc :: (CodeVarChunk, [ConstraintCE]) -> GenState [MSBody r]
constrExc c :: (CodeVarChunk, [ConstraintCE])
c = do
let q :: CodeVarChunk
q = (CodeVarChunk, [ConstraintCE]) -> CodeVarChunk
forall a b. (a, b) -> a
fst (CodeVarChunk, [ConstraintCE])
c
cs :: [ConstraintCE]
cs = (CodeVarChunk, [ConstraintCE]) -> [ConstraintCE]
forall a b. (a, b) -> b
snd (CodeVarChunk, [ConstraintCE])
c
[[MS (r (Statement r))]]
msgs <- (ConstraintCE
-> StateT DrasilState Identity [MS (r (Statement r))])
-> [ConstraintCE]
-> StateT DrasilState Identity [[MS (r (Statement r))]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (CodeVarChunk
-> Name
-> ConstraintCE
-> StateT DrasilState Identity [MS (r (Statement r))]
forall (r :: * -> *).
OOProg r =>
CodeVarChunk -> Name -> ConstraintCE -> GenState [MSStatement r]
constraintViolatedMsg CodeVarChunk
q "expected") [ConstraintCE]
cs
[MSBody r] -> GenState [MSBody r]
forall (m :: * -> *) a. Monad m => a -> m a
return ([MSBody r] -> GenState [MSBody r])
-> [MSBody r] -> GenState [MSBody r]
forall a b. (a -> b) -> a -> b
$ ([MS (r (Statement r))] -> MSBody r)
-> [[MS (r (Statement r))]] -> [MSBody r]
forall a b. (a -> b) -> [a] -> [b]
map ([MS (r (Statement r))] -> MSBody r
forall (r :: * -> *). BodySym r => [MSStatement r] -> MSBody r
bodyStatements ([MS (r (Statement r))] -> MSBody r)
-> ([MS (r (Statement r))] -> [MS (r (Statement r))])
-> [MS (r (Statement r))]
-> MSBody r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([MS (r (Statement r))]
-> [MS (r (Statement r))] -> [MS (r (Statement r))]
forall a. [a] -> [a] -> [a]
++ [Name -> MS (r (Statement r))
forall (r :: * -> *). ControlStatement r => Name -> MSStatement r
throw "InputError"])) [[MS (r (Statement r))]]
msgs
constraintViolatedMsg :: (OOProg r) => CodeVarChunk -> String ->
ConstraintCE -> GenState [MSStatement r]
constraintViolatedMsg :: CodeVarChunk -> Name -> ConstraintCE -> GenState [MSStatement r]
constraintViolatedMsg q :: CodeVarChunk
q s :: Name
s c :: ConstraintCE
c = do
[MSStatement r]
pc <- ConstraintCE -> GenState [MSStatement r]
forall (r :: * -> *).
OOProg r =>
ConstraintCE -> GenState [MSStatement r]
printConstraint ConstraintCE
c
VS (r (Value r))
v <- CodeVarChunk -> GenState (VS (r (Value r)))
forall (r :: * -> *).
OOProg r =>
CodeVarChunk -> GenState (SValue r)
mkVal (CodeVarChunk -> CodeVarChunk
forall c. (Quantity c, MayHaveUnit c) => c -> CodeVarChunk
quantvar CodeVarChunk
q)
[MSStatement r] -> GenState [MSStatement r]
forall (m :: * -> *) a. Monad m => a -> m a
return ([MSStatement r] -> GenState [MSStatement r])
-> [MSStatement r] -> GenState [MSStatement r]
forall a b. (a -> b) -> a -> b
$ [Name -> MSStatement r
forall (r :: * -> *). IOStatement r => Name -> MSStatement r
printStr (Name -> MSStatement r) -> Name -> MSStatement r
forall a b. (a -> b) -> a -> b
$ CodeVarChunk -> Name
forall c. CodeIdea c => c -> Name
codeName CodeVarChunk
q Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ " has value ",
VS (r (Value r)) -> MSStatement r
forall (r :: * -> *). IOStatement r => SValue r -> MSStatement r
print VS (r (Value r))
v,
Name -> MSStatement r
forall (r :: * -> *). IOStatement r => Name -> MSStatement r
printStr (Name -> MSStatement r) -> Name -> MSStatement r
forall a b. (a -> b) -> a -> b
$ ", but is " Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Name
s Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ " to be "] [MSStatement r] -> [MSStatement r] -> [MSStatement r]
forall a. [a] -> [a] -> [a]
++ [MSStatement r]
pc
printConstraint :: (OOProg r) => ConstraintCE ->
GenState [MSStatement r]
printConstraint :: ConstraintCE -> GenState [MSStatement r]
printConstraint c :: ConstraintCE
c = do
DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
let db :: ChunkDB
db = CodeSpec -> ChunkDB
sysinfodb (CodeSpec -> ChunkDB) -> CodeSpec -> ChunkDB
forall a b. (a -> b) -> a -> b
$ DrasilState -> CodeSpec
codeSpec DrasilState
g
printConstraint' :: (OOProg r) => ConstraintCE -> GenState
[MSStatement r]
printConstraint' :: ConstraintCE -> GenState [MSStatement r]
printConstraint' (Range _ (Bounded (_, e1 :: CodeExpr
e1) (_, e2 :: CodeExpr
e2))) = do
VS (r (Value r))
lb <- CodeExpr -> GenState (VS (r (Value r)))
forall (r :: * -> *). OOProg r => CodeExpr -> GenState (SValue r)
convExpr CodeExpr
e1
VS (r (Value r))
ub <- CodeExpr -> GenState (VS (r (Value r)))
forall (r :: * -> *). OOProg r => CodeExpr -> GenState (SValue r)
convExpr CodeExpr
e2
[MSStatement r] -> GenState [MSStatement r]
forall (m :: * -> *) a. Monad m => a -> m a
return ([MSStatement r] -> GenState [MSStatement r])
-> [MSStatement r] -> GenState [MSStatement r]
forall a b. (a -> b) -> a -> b
$ [Name -> MSStatement r
forall (r :: * -> *). IOStatement r => Name -> MSStatement r
printStr "between ", VS (r (Value r)) -> MSStatement r
forall (r :: * -> *). IOStatement r => SValue r -> MSStatement r
print VS (r (Value r))
lb] [MSStatement r] -> [MSStatement r] -> [MSStatement r]
forall a. [a] -> [a] -> [a]
++ CodeExpr -> ChunkDB -> [MSStatement r]
forall (r :: * -> *).
OOProg r =>
CodeExpr -> ChunkDB -> [MSStatement r]
printExpr CodeExpr
e1 ChunkDB
db [MSStatement r] -> [MSStatement r] -> [MSStatement r]
forall a. [a] -> [a] -> [a]
++
[Name -> MSStatement r
forall (r :: * -> *). IOStatement r => Name -> MSStatement r
printStr " and ", VS (r (Value r)) -> MSStatement r
forall (r :: * -> *). IOStatement r => SValue r -> MSStatement r
print VS (r (Value r))
ub] [MSStatement r] -> [MSStatement r] -> [MSStatement r]
forall a. [a] -> [a] -> [a]
++ CodeExpr -> ChunkDB -> [MSStatement r]
forall (r :: * -> *).
OOProg r =>
CodeExpr -> ChunkDB -> [MSStatement r]
printExpr CodeExpr
e2 ChunkDB
db [MSStatement r] -> [MSStatement r] -> [MSStatement r]
forall a. [a] -> [a] -> [a]
++ [Name -> MSStatement r
forall (r :: * -> *). IOStatement r => Name -> MSStatement r
printStrLn "."]
printConstraint' (Range _ (UpTo (_, e :: CodeExpr
e))) = do
VS (r (Value r))
ub <- CodeExpr -> GenState (VS (r (Value r)))
forall (r :: * -> *). OOProg r => CodeExpr -> GenState (SValue r)
convExpr CodeExpr
e
[MSStatement r] -> GenState [MSStatement r]
forall (m :: * -> *) a. Monad m => a -> m a
return ([MSStatement r] -> GenState [MSStatement r])
-> [MSStatement r] -> GenState [MSStatement r]
forall a b. (a -> b) -> a -> b
$ [Name -> MSStatement r
forall (r :: * -> *). IOStatement r => Name -> MSStatement r
printStr "below ", VS (r (Value r)) -> MSStatement r
forall (r :: * -> *). IOStatement r => SValue r -> MSStatement r
print VS (r (Value r))
ub] [MSStatement r] -> [MSStatement r] -> [MSStatement r]
forall a. [a] -> [a] -> [a]
++ CodeExpr -> ChunkDB -> [MSStatement r]
forall (r :: * -> *).
OOProg r =>
CodeExpr -> ChunkDB -> [MSStatement r]
printExpr CodeExpr
e ChunkDB
db [MSStatement r] -> [MSStatement r] -> [MSStatement r]
forall a. [a] -> [a] -> [a]
++
[Name -> MSStatement r
forall (r :: * -> *). IOStatement r => Name -> MSStatement r
printStrLn "."]
printConstraint' (Range _ (UpFrom (_, e :: CodeExpr
e))) = do
VS (r (Value r))
lb <- CodeExpr -> GenState (VS (r (Value r)))
forall (r :: * -> *). OOProg r => CodeExpr -> GenState (SValue r)
convExpr CodeExpr
e
[MSStatement r] -> GenState [MSStatement r]
forall (m :: * -> *) a. Monad m => a -> m a
return ([MSStatement r] -> GenState [MSStatement r])
-> [MSStatement r] -> GenState [MSStatement r]
forall a b. (a -> b) -> a -> b
$ [Name -> MSStatement r
forall (r :: * -> *). IOStatement r => Name -> MSStatement r
printStr "above ", VS (r (Value r)) -> MSStatement r
forall (r :: * -> *). IOStatement r => SValue r -> MSStatement r
print VS (r (Value r))
lb] [MSStatement r] -> [MSStatement r] -> [MSStatement r]
forall a. [a] -> [a] -> [a]
++ CodeExpr -> ChunkDB -> [MSStatement r]
forall (r :: * -> *).
OOProg r =>
CodeExpr -> ChunkDB -> [MSStatement r]
printExpr CodeExpr
e ChunkDB
db [MSStatement r] -> [MSStatement r] -> [MSStatement r]
forall a. [a] -> [a] -> [a]
++ [Name -> MSStatement r
forall (r :: * -> *). IOStatement r => Name -> MSStatement r
printStrLn "."]
ConstraintCE -> GenState [MSStatement r]
forall (r :: * -> *).
OOProg r =>
ConstraintCE -> GenState [MSStatement r]
printConstraint' ConstraintCE
c
printExpr :: (OOProg r) => CodeExpr -> ChunkDB -> [MSStatement r]
printExpr :: CodeExpr -> ChunkDB -> [MSStatement r]
printExpr Lit{} _ = []
printExpr e :: CodeExpr
e db :: ChunkDB
db = [Name -> MSStatement r
forall (r :: * -> *). IOStatement r => Name -> MSStatement r
printStr (Name -> MSStatement r) -> Name -> MSStatement r
forall a b. (a -> b) -> a -> b
$ " (" Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Doc -> Name
render (ChunkDB -> Stage -> Linearity -> CodeExpr -> Doc
codeExprDoc ChunkDB
db Stage
Implementation Linearity
Linear CodeExpr
e) Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ ")"]
genInputFormat :: (OOProg r) => ScopeTag ->
GenState (Maybe (SMethod r))
genInputFormat :: ScopeTag -> GenState (Maybe (SMethod r))
genInputFormat s :: ScopeTag
s = do
DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
DataDesc
dd <- GenState DataDesc
genDataDesc
let getFunc :: ScopeTag
-> Name
-> Name
-> [CodeVarChunk]
-> [CodeVarChunk]
-> [MS (r (Block r))]
-> GenState (MS (r (Method r)))
getFunc Pub = Name
-> Name
-> [CodeVarChunk]
-> [CodeVarChunk]
-> [MS (r (Block r))]
-> GenState (MS (r (Method r)))
forall (r :: * -> *).
OOProg r =>
Name
-> Name
-> [CodeVarChunk]
-> [CodeVarChunk]
-> [MSBlock r]
-> GenState (SMethod r)
publicInOutFunc
getFunc Priv = Name
-> Name
-> [CodeVarChunk]
-> [CodeVarChunk]
-> [MS (r (Block r))]
-> GenState (MS (r (Method r)))
forall (r :: * -> *).
OOProg r =>
Name
-> Name
-> [CodeVarChunk]
-> [CodeVarChunk]
-> [MSBlock r]
-> GenState (SMethod r)
privateInOutMethod
genInFormat :: (OOProg r) => Bool -> GenState
(Maybe (SMethod r))
genInFormat :: Bool -> GenState (Maybe (SMethod r))
genInFormat False = Maybe (SMethod r) -> GenState (Maybe (SMethod r))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (SMethod r)
forall a. Maybe a
Nothing
genInFormat _ = do
[CodeVarChunk]
ins <- GenState [CodeVarChunk]
getInputFormatIns
[CodeVarChunk]
outs <- GenState [CodeVarChunk]
getInputFormatOuts
[MS (r (Block r))]
bod <- DataDesc -> GenState [MS (r (Block r))]
forall (r :: * -> *). OOProg r => DataDesc -> GenState [MSBlock r]
readData DataDesc
dd
Name
desc <- GenState Name
inFmtFuncDesc
SMethod r
mthd <- ScopeTag
-> Name
-> Name
-> [CodeVarChunk]
-> [CodeVarChunk]
-> [MS (r (Block r))]
-> GenState (SMethod r)
forall (r :: * -> *).
OOProg r =>
ScopeTag
-> Name
-> Name
-> [CodeVarChunk]
-> [CodeVarChunk]
-> [MS (r (Block r))]
-> GenState (MS (r (Method r)))
getFunc ScopeTag
s "get_input" Name
desc [CodeVarChunk]
ins [CodeVarChunk]
outs [MS (r (Block r))]
bod
Maybe (SMethod r) -> GenState (Maybe (SMethod r))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (SMethod r) -> GenState (Maybe (SMethod r)))
-> Maybe (SMethod r) -> GenState (Maybe (SMethod r))
forall a b. (a -> b) -> a -> b
$ SMethod r -> Maybe (SMethod r)
forall a. a -> Maybe a
Just SMethod r
mthd
Bool -> GenState (Maybe (SMethod r))
forall (r :: * -> *).
OOProg r =>
Bool -> StateT DrasilState Identity (Maybe (MS (r (Method r))))
genInFormat (Bool -> GenState (Maybe (SMethod r)))
-> Bool -> GenState (Maybe (SMethod r))
forall a b. (a -> b) -> a -> b
$ "get_input" Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` DrasilState -> [Name]
defList DrasilState
g
genDataDesc :: GenState DataDesc
genDataDesc :: GenState DataDesc
genDataDesc = do
DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
DataDesc -> GenState DataDesc
forall (m :: * -> *) a. Monad m => a -> m a
return (DataDesc -> GenState DataDesc) -> DataDesc -> GenState DataDesc
forall a b. (a -> b) -> a -> b
$ Data
junkLine Data -> DataDesc -> DataDesc
forall a. a -> [a] -> [a]
:
Data -> DataDesc -> DataDesc
forall a. a -> [a] -> [a]
intersperse Data
junkLine ((CodeVarChunk -> Data) -> [CodeVarChunk] -> DataDesc
forall a b. (a -> b) -> [a] -> [b]
map CodeVarChunk -> Data
singleton (CodeSpec -> [CodeVarChunk]
extInputs (CodeSpec -> [CodeVarChunk]) -> CodeSpec -> [CodeVarChunk]
forall a b. (a -> b) -> a -> b
$ DrasilState -> CodeSpec
codeSpec DrasilState
g))
genSampleInput :: (AuxiliarySym r) => GenState (Maybe (r (Auxiliary r)))
genSampleInput :: GenState (Maybe (r (Auxiliary r)))
genSampleInput = do
DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
DataDesc
dd <- GenState DataDesc
genDataDesc
if [AuxFile] -> Bool
hasSampleInput (DrasilState -> [AuxFile]
auxiliaries DrasilState
g) then (Maybe (r (Auxiliary r)) -> GenState (Maybe (r (Auxiliary r)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (r (Auxiliary r)) -> GenState (Maybe (r (Auxiliary r))))
-> (r (Auxiliary r) -> Maybe (r (Auxiliary r)))
-> r (Auxiliary r)
-> GenState (Maybe (r (Auxiliary r)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r (Auxiliary r) -> Maybe (r (Auxiliary r))
forall a. a -> Maybe a
Just) (r (Auxiliary r) -> GenState (Maybe (r (Auxiliary r))))
-> r (Auxiliary r) -> GenState (Maybe (r (Auxiliary r)))
forall a b. (a -> b) -> a -> b
$ ChunkDB -> DataDesc -> [Expr] -> r (Auxiliary r)
forall (r :: * -> *).
AuxiliarySym r =>
ChunkDB -> DataDesc -> [Expr] -> r (Auxiliary r)
sampleInput
(CodeSpec -> ChunkDB
sysinfodb (CodeSpec -> ChunkDB) -> CodeSpec -> ChunkDB
forall a b. (a -> b) -> a -> b
$ DrasilState -> CodeSpec
codeSpec DrasilState
g) DataDesc
dd (DrasilState -> [Expr]
sampleData DrasilState
g) else Maybe (r (Auxiliary r)) -> GenState (Maybe (r (Auxiliary r)))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (r (Auxiliary r))
forall a. Maybe a
Nothing
genConstMod :: (OOProg r) => GenState [SFile r]
genConstMod :: GenState [SFile r]
genConstMod = do
Name
cDesc <- GenState [Name] -> GenState Name
modDesc (GenState [Name] -> GenState Name)
-> GenState [Name] -> GenState Name
forall a b. (a -> b) -> a -> b
$ GenState Name -> GenState [Name]
forall a b. State a b -> State a [b]
liftS GenState Name
constModDesc
State DrasilState (SFile r) -> GenState [SFile r]
forall a b. State a b -> State a [b]
liftS (State DrasilState (SFile r) -> GenState [SFile r])
-> State DrasilState (SFile r) -> GenState [SFile r]
forall a b. (a -> b) -> a -> b
$ Name
-> Name
-> [GenState (Maybe (SMethod r))]
-> [GenState (Maybe (SClass r))]
-> State DrasilState (SFile r)
forall (r :: * -> *).
OOProg r =>
Name
-> Name
-> [GenState (Maybe (SMethod r))]
-> [GenState (Maybe (SClass r))]
-> GenState (SFile r)
genModule "Constants" Name
cDesc [] [ClassType -> GenState (Maybe (SClass r))
forall (r :: * -> *).
OOProg r =>
ClassType -> GenState (Maybe (SClass r))
genConstClass ClassType
Primary]
genConstClass :: (OOProg r) => ClassType ->
GenState (Maybe (SClass r))
genConstClass :: ClassType -> GenState (Maybe (SClass r))
genConstClass scp :: ClassType
scp = do
DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
let cs :: [CodeDefinition]
cs = CodeSpec -> [CodeDefinition]
constants (CodeSpec -> [CodeDefinition]) -> CodeSpec -> [CodeDefinition]
forall a b. (a -> b) -> a -> b
$ DrasilState -> CodeSpec
codeSpec DrasilState
g
genClass :: (OOProg r) => [CodeDefinition] -> GenState
(Maybe (SClass r))
genClass :: [CodeDefinition] -> GenState (Maybe (SClass r))
genClass [] = Maybe (SClass r) -> GenState (Maybe (SClass r))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (SClass r)
forall a. Maybe a
Nothing
genClass vs :: [CodeDefinition]
vs = do
[VS (r (Value r))]
vals <- (CodeDefinition -> StateT DrasilState Identity (VS (r (Value r))))
-> [CodeDefinition]
-> StateT DrasilState Identity [VS (r (Value r))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (CodeExpr -> StateT DrasilState Identity (VS (r (Value r)))
forall (r :: * -> *). OOProg r => CodeExpr -> GenState (SValue r)
convExpr (CodeExpr -> StateT DrasilState Identity (VS (r (Value r))))
-> (CodeDefinition -> CodeExpr)
-> CodeDefinition
-> StateT DrasilState Identity (VS (r (Value r)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CodeDefinition
-> Getting CodeExpr CodeDefinition CodeExpr -> CodeExpr
forall s a. s -> Getting a s a -> a
^. Getting CodeExpr CodeDefinition CodeExpr
forall c. DefiningCodeExpr c => Lens' c CodeExpr
codeExpr)) [CodeDefinition]
vs
[VS (r (Variable r))]
vars <- (CodeDefinition
-> StateT DrasilState Identity (VS (r (Variable r))))
-> [CodeDefinition]
-> StateT DrasilState Identity [VS (r (Variable r))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\x :: CodeDefinition
x -> (CodeType -> VS (r (Variable r)))
-> StateT DrasilState Identity CodeType
-> StateT DrasilState Identity (VS (r (Variable r)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Name -> VSType r -> VS (r (Variable r))
forall (r :: * -> *).
VariableSym r =>
Name -> VSType r -> SVariable r
var (CodeDefinition -> Name
forall c. CodeIdea c => c -> Name
codeName CodeDefinition
x) (VSType r -> VS (r (Variable r)))
-> (CodeType -> VSType r) -> CodeType -> VS (r (Variable r))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CodeType -> VSType r
forall (r :: * -> *). TypeSym r => CodeType -> VSType r
convType) (CodeDefinition -> StateT DrasilState Identity CodeType
forall c. HasSpace c => c -> StateT DrasilState Identity CodeType
codeType CodeDefinition
x)) [CodeDefinition]
vs
let constVars :: [CS (r (StateVar r))]
constVars = (VS (r (Variable r)) -> VS (r (Value r)) -> CS (r (StateVar r)))
-> [VS (r (Variable r))]
-> [VS (r (Value r))]
-> [CS (r (StateVar r))]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (ConstantRepr
-> VS (r (Variable r)) -> VS (r (Value r)) -> CS (r (StateVar r))
forall (r :: * -> *).
OOProg r =>
ConstantRepr -> SVariable r -> SValue r -> CSStateVar r
constVarFunc (DrasilState -> ConstantRepr
conRepr DrasilState
g)) [VS (r (Variable r))]
vars [VS (r (Value r))]
vals
getFunc :: ClassType
-> Name
-> Maybe Name
-> Name
-> [CS (r (StateVar r))]
-> GenState [MS (r (Method r))]
-> GenState (CS (r (Class r)))
getFunc Primary = Name
-> Maybe Name
-> Name
-> [CS (r (StateVar r))]
-> GenState [MS (r (Method r))]
-> GenState (CS (r (Class r)))
forall (r :: * -> *).
OOProg r =>
Name
-> Maybe Name
-> Name
-> [CSStateVar r]
-> GenState [SMethod r]
-> GenState (SClass r)
primaryClass
getFunc Auxiliary = Name
-> Maybe Name
-> Name
-> [CS (r (StateVar r))]
-> GenState [MS (r (Method r))]
-> GenState (CS (r (Class r)))
forall (r :: * -> *).
OOProg r =>
Name
-> Maybe Name
-> Name
-> [CSStateVar r]
-> GenState [SMethod r]
-> GenState (SClass r)
auxClass
f :: Name
-> Maybe Name
-> Name
-> [CS (r (StateVar r))]
-> GenState [MS (r (Method r))]
-> GenState (SClass r)
f = ClassType
-> Name
-> Maybe Name
-> Name
-> [CS (r (StateVar r))]
-> GenState [MS (r (Method r))]
-> GenState (SClass r)
forall (r :: * -> *).
OOProg r =>
ClassType
-> Name
-> Maybe Name
-> Name
-> [CS (r (StateVar r))]
-> GenState [MS (r (Method r))]
-> GenState (CS (r (Class r)))
getFunc ClassType
scp
Name
cDesc <- GenState Name
constClassDesc
SClass r
cls <- Name
-> Maybe Name
-> Name
-> [CS (r (StateVar r))]
-> GenState [MS (r (Method r))]
-> GenState (SClass r)
f Name
cname Maybe Name
forall a. Maybe a
Nothing Name
cDesc [CS (r (StateVar r))]
constVars ([MS (r (Method r))] -> GenState [MS (r (Method r))]
forall (m :: * -> *) a. Monad m => a -> m a
return [])
Maybe (SClass r) -> GenState (Maybe (SClass r))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (SClass r) -> GenState (Maybe (SClass r)))
-> Maybe (SClass r) -> GenState (Maybe (SClass r))
forall a b. (a -> b) -> a -> b
$ SClass r -> Maybe (SClass r)
forall a. a -> Maybe a
Just SClass r
cls
[CodeDefinition] -> GenState (Maybe (SClass r))
forall (r :: * -> *).
OOProg r =>
[CodeDefinition] -> GenState (Maybe (SClass r))
genClass ([CodeDefinition] -> GenState (Maybe (SClass r)))
-> [CodeDefinition] -> GenState (Maybe (SClass r))
forall a b. (a -> b) -> a -> b
$ (CodeDefinition -> Bool) -> [CodeDefinition] -> [CodeDefinition]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Name -> Map Name Name -> Bool) -> Map Name Name -> Name -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Name -> Map Name Name -> Bool
forall k a. Ord k => k -> Map k a -> Bool
member ((Name -> Bool) -> Map Name Name -> Map Name Name
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (Name
cname Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
==) (DrasilState -> Map Name Name
clsMap DrasilState
g))
(Name -> Bool)
-> (CodeDefinition -> Name) -> CodeDefinition -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CodeDefinition -> Name
forall c. CodeIdea c => c -> Name
codeName) [CodeDefinition]
cs
where cname :: Name
cname = "Constants"
genCalcMod :: (OOProg r) => GenState (SFile r)
genCalcMod :: GenState (SFile r)
genCalcMod = do
DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
let elmap :: ExtLibMap
elmap = DrasilState -> ExtLibMap
extLibMap DrasilState
g
Name
-> Name
-> [Name]
-> [GenState (Maybe (SMethod r))]
-> [GenState (Maybe (SClass r))]
-> GenState (SFile r)
forall (r :: * -> *).
OOProg r =>
Name
-> Name
-> [Name]
-> [GenState (Maybe (SMethod r))]
-> [GenState (Maybe (SClass r))]
-> GenState (SFile r)
genModuleWithImports "Calculations" Name
calcModDesc ((ExtLibState -> [Name]) -> [ExtLibState] -> [Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (ExtLibState -> Getting [Name] ExtLibState [Name] -> [Name]
forall s a. s -> Getting a s a -> a
^. Getting [Name] ExtLibState [Name]
Lens' ExtLibState [Name]
imports) ([ExtLibState] -> [Name]) -> [ExtLibState] -> [Name]
forall a b. (a -> b) -> a -> b
$
ExtLibMap -> [ExtLibState]
forall k a. Map k a -> [a]
elems ExtLibMap
elmap) ((CodeDefinition -> GenState (Maybe (SMethod r)))
-> [CodeDefinition] -> [GenState (Maybe (SMethod r))]
forall a b. (a -> b) -> [a] -> [b]
map ((SMethod r -> Maybe (SMethod r))
-> StateT DrasilState Identity (SMethod r)
-> GenState (Maybe (SMethod r))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SMethod r -> Maybe (SMethod r)
forall a. a -> Maybe a
Just (StateT DrasilState Identity (SMethod r)
-> GenState (Maybe (SMethod r)))
-> (CodeDefinition -> StateT DrasilState Identity (SMethod r))
-> CodeDefinition
-> GenState (Maybe (SMethod r))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CodeDefinition -> StateT DrasilState Identity (SMethod r)
forall (r :: * -> *).
OOProg r =>
CodeDefinition -> GenState (SMethod r)
genCalcFunc) (CodeSpec -> [CodeDefinition]
execOrder (CodeSpec -> [CodeDefinition]) -> CodeSpec -> [CodeDefinition]
forall a b. (a -> b) -> a -> b
$ DrasilState -> CodeSpec
codeSpec DrasilState
g)) []
genCalcFunc :: (OOProg r) => CodeDefinition ->
GenState (SMethod r)
genCalcFunc :: CodeDefinition -> GenState (SMethod r)
genCalcFunc cdef :: CodeDefinition
cdef = do
DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
[CodeVarChunk]
parms <- CodeDefinition -> GenState [CodeVarChunk]
getCalcParams CodeDefinition
cdef
let nm :: Name
nm = CodeDefinition -> Name
forall c. CodeIdea c => c -> Name
codeName CodeDefinition
cdef
CodeType
tp <- CodeDefinition -> StateT DrasilState Identity CodeType
forall c. HasSpace c => c -> StateT DrasilState Identity CodeType
codeType CodeDefinition
cdef
VS (r (Variable r))
v <- CodeVarChunk -> GenState (VS (r (Variable r)))
forall (r :: * -> *).
OOProg r =>
CodeVarChunk -> GenState (SVariable r)
mkVar (CodeDefinition -> CodeVarChunk
forall c. (Quantity c, MayHaveUnit c) => c -> CodeVarChunk
quantvar CodeDefinition
cdef)
[MS (r (Block r))]
blcks <- case CodeDefinition
cdef CodeDefinition
-> Getting DefinitionType CodeDefinition DefinitionType
-> DefinitionType
forall s a. s -> Getting a s a -> a
^. Getting DefinitionType CodeDefinition DefinitionType
Lens' CodeDefinition DefinitionType
defType
of Definition -> State DrasilState (MS (r (Block r)))
-> State DrasilState [MS (r (Block r))]
forall a b. State a b -> State a [b]
liftS (State DrasilState (MS (r (Block r)))
-> State DrasilState [MS (r (Block r))])
-> State DrasilState (MS (r (Block r)))
-> State DrasilState [MS (r (Block r))]
forall a b. (a -> b) -> a -> b
$ CalcType
-> CodeDefinition
-> CodeExpr
-> State DrasilState (MS (r (Block r)))
forall (r :: * -> *).
OOProg r =>
CalcType -> CodeDefinition -> CodeExpr -> GenState (MSBlock r)
genCalcBlock CalcType
CalcReturn CodeDefinition
cdef
(CodeDefinition
cdef CodeDefinition
-> Getting CodeExpr CodeDefinition CodeExpr -> CodeExpr
forall s a. s -> Getting a s a -> a
^. Getting CodeExpr CodeDefinition CodeExpr
forall c. DefiningCodeExpr c => Lens' c CodeExpr
codeExpr)
ODE -> State DrasilState [MS (r (Block r))]
-> (ExtLibState -> State DrasilState [MS (r (Block r))])
-> Maybe ExtLibState
-> State DrasilState [MS (r (Block r))]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Name -> State DrasilState [MS (r (Block r))]
forall a. HasCallStack => Name -> a
error (Name -> State DrasilState [MS (r (Block r))])
-> Name -> State DrasilState [MS (r (Block r))]
forall a b. (a -> b) -> a -> b
$ Name
nm Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ " missing from ExtLibMap")
(\el :: ExtLibState
el -> do
[MS (r (Statement r))]
defStmts <- (FuncStmt -> StateT DrasilState Identity (MS (r (Statement r))))
-> [FuncStmt] -> StateT DrasilState Identity [MS (r (Statement r))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM FuncStmt -> StateT DrasilState Identity (MS (r (Statement r)))
forall (r :: * -> *).
OOProg r =>
FuncStmt -> GenState (MSStatement r)
convStmt (ExtLibState
el ExtLibState
-> Getting [FuncStmt] ExtLibState [FuncStmt] -> [FuncStmt]
forall s a. s -> Getting a s a -> a
^. Getting [FuncStmt] ExtLibState [FuncStmt]
Lens' ExtLibState [FuncStmt]
defs)
[MS (r (Statement r))]
stepStmts <- (FuncStmt -> StateT DrasilState Identity (MS (r (Statement r))))
-> [FuncStmt] -> StateT DrasilState Identity [MS (r (Statement r))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM FuncStmt -> StateT DrasilState Identity (MS (r (Statement r)))
forall (r :: * -> *).
OOProg r =>
FuncStmt -> GenState (MSStatement r)
convStmt (ExtLibState
el ExtLibState
-> Getting [FuncStmt] ExtLibState [FuncStmt] -> [FuncStmt]
forall s a. s -> Getting a s a -> a
^. Getting [FuncStmt] ExtLibState [FuncStmt]
Lens' ExtLibState [FuncStmt]
steps)
[MS (r (Block r))] -> State DrasilState [MS (r (Block r))]
forall (m :: * -> *) a. Monad m => a -> m a
return [[MS (r (Statement r))] -> MS (r (Block r))
forall (r :: * -> *). BlockSym r => [MSStatement r] -> MSBlock r
block (VS (r (Variable r)) -> MS (r (Statement r))
forall (r :: * -> *).
DeclStatement r =>
SVariable r -> MSStatement r
varDec VS (r (Variable r))
v MS (r (Statement r))
-> [MS (r (Statement r))] -> [MS (r (Statement r))]
forall a. a -> [a] -> [a]
: [MS (r (Statement r))]
defStmts),
[MS (r (Statement r))] -> MS (r (Block r))
forall (r :: * -> *). BlockSym r => [MSStatement r] -> MSBlock r
block [MS (r (Statement r))]
stepStmts,
[MS (r (Statement r))] -> MS (r (Block r))
forall (r :: * -> *). BlockSym r => [MSStatement r] -> MSBlock r
block [SValue r -> MS (r (Statement r))
forall (r :: * -> *).
ControlStatement r =>
SValue r -> MSStatement r
returnStmt (SValue r -> MS (r (Statement r)))
-> SValue r -> MS (r (Statement r))
forall a b. (a -> b) -> a -> b
$ VS (r (Variable r)) -> SValue r
forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
valueOf VS (r (Variable r))
v]])
(Name -> ExtLibMap -> Maybe ExtLibState
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
nm (DrasilState -> ExtLibMap
extLibMap DrasilState
g))
Name
desc <- CodeDefinition -> GenState Name
forall c. CodeIdea c => c -> GenState Name
getComment CodeDefinition
cdef
Name
-> VSType r
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MS (r (Block r))]
-> GenState (SMethod r)
forall (r :: * -> *).
OOProg r =>
Name
-> VSType r
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MSBlock r]
-> GenState (SMethod r)
publicFunc
Name
nm
(CodeType -> VSType r
forall (r :: * -> *). TypeSym r => CodeType -> VSType r
convType CodeType
tp)
("Calculates " Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Name
desc)
((CodeVarChunk -> ParameterChunk)
-> [CodeVarChunk] -> [ParameterChunk]
forall a b. (a -> b) -> [a] -> [b]
map CodeVarChunk -> ParameterChunk
forall c. CodeIdea c => c -> ParameterChunk
pcAuto [CodeVarChunk]
parms)
(Name -> Maybe Name
forall a. a -> Maybe a
Just Name
desc)
[MS (r (Block r))]
blcks
data CalcType = CalcAssign | CalcReturn deriving CalcType -> CalcType -> Bool
(CalcType -> CalcType -> Bool)
-> (CalcType -> CalcType -> Bool) -> Eq CalcType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CalcType -> CalcType -> Bool
$c/= :: CalcType -> CalcType -> Bool
== :: CalcType -> CalcType -> Bool
$c== :: CalcType -> CalcType -> Bool
Eq
genCalcBlock :: (OOProg r) => CalcType -> CodeDefinition -> CodeExpr ->
GenState (MSBlock r)
genCalcBlock :: CalcType -> CodeDefinition -> CodeExpr -> GenState (MSBlock r)
genCalcBlock t :: CalcType
t v :: CodeDefinition
v (Case c :: Completeness
c e :: [(CodeExpr, CodeExpr)]
e) = CalcType
-> CodeDefinition
-> Completeness
-> [(CodeExpr, CodeExpr)]
-> GenState (MSBlock r)
forall (r :: * -> *).
OOProg r =>
CalcType
-> CodeDefinition
-> Completeness
-> [(CodeExpr, CodeExpr)]
-> GenState (MSBlock r)
genCaseBlock CalcType
t CodeDefinition
v Completeness
c [(CodeExpr, CodeExpr)]
e
genCalcBlock CalcAssign v :: CodeDefinition
v e :: CodeExpr
e = do
VS (r (Variable r))
vv <- CodeVarChunk -> GenState (VS (r (Variable r)))
forall (r :: * -> *).
OOProg r =>
CodeVarChunk -> GenState (SVariable r)
mkVar (CodeDefinition -> CodeVarChunk
forall c. (Quantity c, MayHaveUnit c) => c -> CodeVarChunk
quantvar CodeDefinition
v)
VS (r (Value r))
ee <- CodeExpr -> GenState (VS (r (Value r)))
forall (r :: * -> *). OOProg r => CodeExpr -> GenState (SValue r)
convExpr CodeExpr
e
[MS (r (Statement r))]
l <- VS (r (Variable r)) -> GenState [MS (r (Statement r))]
forall (r :: * -> *).
OOProg r =>
SVariable r -> GenState [MSStatement r]
maybeLog VS (r (Variable r))
vv
MSBlock r -> GenState (MSBlock r)
forall (m :: * -> *) a. Monad m => a -> m a
return (MSBlock r -> GenState (MSBlock r))
-> MSBlock r -> GenState (MSBlock r)
forall a b. (a -> b) -> a -> b
$ [MS (r (Statement r))] -> MSBlock r
forall (r :: * -> *). BlockSym r => [MSStatement r] -> MSBlock r
block ([MS (r (Statement r))] -> MSBlock r)
-> [MS (r (Statement r))] -> MSBlock r
forall a b. (a -> b) -> a -> b
$ VS (r (Variable r)) -> VS (r (Value r)) -> MS (r (Statement r))
forall (r :: * -> *).
AssignStatement r =>
SVariable r -> SValue r -> MSStatement r
assign VS (r (Variable r))
vv VS (r (Value r))
ee MS (r (Statement r))
-> [MS (r (Statement r))] -> [MS (r (Statement r))]
forall a. a -> [a] -> [a]
: [MS (r (Statement r))]
l
genCalcBlock CalcReturn _ e :: CodeExpr
e = [MS (r (Statement r))] -> MSBlock r
forall (r :: * -> *). BlockSym r => [MSStatement r] -> MSBlock r
block ([MS (r (Statement r))] -> MSBlock r)
-> GenState [MS (r (Statement r))] -> GenState (MSBlock r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> State DrasilState (MS (r (Statement r)))
-> GenState [MS (r (Statement r))]
forall a b. State a b -> State a [b]
liftS (VS (r (Value r)) -> MS (r (Statement r))
forall (r :: * -> *).
ControlStatement r =>
SValue r -> MSStatement r
returnStmt (VS (r (Value r)) -> MS (r (Statement r)))
-> GenState (VS (r (Value r)))
-> State DrasilState (MS (r (Statement r)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CodeExpr -> GenState (VS (r (Value r)))
forall (r :: * -> *). OOProg r => CodeExpr -> GenState (SValue r)
convExpr CodeExpr
e)
genCaseBlock :: (OOProg r) => CalcType -> CodeDefinition -> Completeness
-> [(CodeExpr, CodeExpr)] -> GenState (MSBlock r)
genCaseBlock :: CalcType
-> CodeDefinition
-> Completeness
-> [(CodeExpr, CodeExpr)]
-> GenState (MSBlock r)
genCaseBlock _ _ _ [] = Name -> GenState (MSBlock r)
forall a. HasCallStack => Name -> a
error (Name -> GenState (MSBlock r)) -> Name -> GenState (MSBlock r)
forall a b. (a -> b) -> a -> b
$ "Case expression with no cases encountered" Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++
" in code generator"
genCaseBlock t :: CalcType
t v :: CodeDefinition
v c :: Completeness
c cs :: [(CodeExpr, CodeExpr)]
cs = do
[(VS (r (Value r)), MS (r (Body r)))]
ifs <- ((CodeExpr, CodeExpr)
-> StateT DrasilState Identity (VS (r (Value r)), MS (r (Body r))))
-> [(CodeExpr, CodeExpr)]
-> StateT
DrasilState Identity [(VS (r (Value r)), MS (r (Body r)))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(e :: CodeExpr
e,r :: CodeExpr
r) -> (VS (r (Value r))
-> MS (r (Body r)) -> (VS (r (Value r)), MS (r (Body r))))
-> StateT DrasilState Identity (VS (r (Value r)))
-> StateT DrasilState Identity (MS (r (Body r)))
-> StateT DrasilState Identity (VS (r (Value r)), MS (r (Body r)))
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) (CodeExpr -> StateT DrasilState Identity (VS (r (Value r)))
forall (r :: * -> *). OOProg r => CodeExpr -> GenState (SValue r)
convExpr CodeExpr
r) (CodeExpr -> StateT DrasilState Identity (MS (r (Body r)))
forall (r :: * -> *).
OOProg r =>
CodeExpr -> StateT DrasilState Identity (MS (r (Body r)))
calcBody CodeExpr
e)) (Completeness -> [(CodeExpr, CodeExpr)]
ifEs Completeness
c)
MS (r (Body r))
els <- Completeness -> StateT DrasilState Identity (MS (r (Body r)))
forall (r :: * -> *).
OOProg r =>
Completeness -> StateT DrasilState Identity (MS (r (Body r)))
elseE Completeness
c
MSBlock r -> GenState (MSBlock r)
forall (m :: * -> *) a. Monad m => a -> m a
return (MSBlock r -> GenState (MSBlock r))
-> MSBlock r -> GenState (MSBlock r)
forall a b. (a -> b) -> a -> b
$ [MSStatement r] -> MSBlock r
forall (r :: * -> *). BlockSym r => [MSStatement r] -> MSBlock r
block [[(VS (r (Value r)), MS (r (Body r)))]
-> MS (r (Body r)) -> MSStatement r
forall (r :: * -> *).
ControlStatement r =>
[(SValue r, MSBody r)] -> MSBody r -> MSStatement r
ifCond [(VS (r (Value r)), MS (r (Body r)))]
ifs MS (r (Body r))
els]
where calcBody :: CodeExpr -> StateT DrasilState Identity (MS (r (Body r)))
calcBody e :: CodeExpr
e = ([MS (r (Block r))] -> MS (r (Body r)))
-> StateT DrasilState Identity [MS (r (Block r))]
-> StateT DrasilState Identity (MS (r (Body r)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [MS (r (Block r))] -> MS (r (Body r))
forall (r :: * -> *). BodySym r => [MSBlock r] -> MSBody r
body (StateT DrasilState Identity [MS (r (Block r))]
-> StateT DrasilState Identity (MS (r (Body r))))
-> StateT DrasilState Identity [MS (r (Block r))]
-> StateT DrasilState Identity (MS (r (Body r)))
forall a b. (a -> b) -> a -> b
$ State DrasilState (MS (r (Block r)))
-> StateT DrasilState Identity [MS (r (Block r))]
forall a b. State a b -> State a [b]
liftS (State DrasilState (MS (r (Block r)))
-> StateT DrasilState Identity [MS (r (Block r))])
-> State DrasilState (MS (r (Block r)))
-> StateT DrasilState Identity [MS (r (Block r))]
forall a b. (a -> b) -> a -> b
$ CalcType
-> CodeDefinition
-> CodeExpr
-> State DrasilState (MS (r (Block r)))
forall (r :: * -> *).
OOProg r =>
CalcType -> CodeDefinition -> CodeExpr -> GenState (MSBlock r)
genCalcBlock CalcType
t CodeDefinition
v CodeExpr
e
ifEs :: Completeness -> [(CodeExpr, CodeExpr)]
ifEs Complete = [(CodeExpr, CodeExpr)] -> [(CodeExpr, CodeExpr)]
forall a. [a] -> [a]
init [(CodeExpr, CodeExpr)]
cs
ifEs Incomplete = [(CodeExpr, CodeExpr)]
cs
elseE :: Completeness -> StateT DrasilState Identity (MS (r (Body r)))
elseE Complete = CodeExpr -> StateT DrasilState Identity (MS (r (Body r)))
forall (r :: * -> *).
OOProg r =>
CodeExpr -> StateT DrasilState Identity (MS (r (Body r)))
calcBody (CodeExpr -> StateT DrasilState Identity (MS (r (Body r))))
-> CodeExpr -> StateT DrasilState Identity (MS (r (Body r)))
forall a b. (a -> b) -> a -> b
$ (CodeExpr, CodeExpr) -> CodeExpr
forall a b. (a, b) -> a
fst ((CodeExpr, CodeExpr) -> CodeExpr)
-> (CodeExpr, CodeExpr) -> CodeExpr
forall a b. (a -> b) -> a -> b
$ [(CodeExpr, CodeExpr)] -> (CodeExpr, CodeExpr)
forall a. [a] -> a
last [(CodeExpr, CodeExpr)]
cs
elseE Incomplete = MS (r (Body r)) -> StateT DrasilState Identity (MS (r (Body r)))
forall (m :: * -> *) a. Monad m => a -> m a
return (MS (r (Body r)) -> StateT DrasilState Identity (MS (r (Body r))))
-> MS (r (Body r)) -> StateT DrasilState Identity (MS (r (Body r)))
forall a b. (a -> b) -> a -> b
$ MSStatement r -> MS (r (Body r))
forall (r :: * -> *). BodySym r => MSStatement r -> MSBody r
oneLiner (MSStatement r -> MS (r (Body r)))
-> MSStatement r -> MS (r (Body r))
forall a b. (a -> b) -> a -> b
$ Name -> MSStatement r
forall (r :: * -> *). ControlStatement r => Name -> MSStatement r
throw (Name -> MSStatement r) -> Name -> MSStatement r
forall a b. (a -> b) -> a -> b
$
"Undefined case encountered in function " Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ CodeDefinition -> Name
forall c. CodeIdea c => c -> Name
codeName CodeDefinition
v
genOutputMod :: (OOProg r) => GenState [SFile r]
genOutputMod :: GenState [SFile r]
genOutputMod = do
Name
ofDesc <- GenState [Name] -> GenState Name
modDesc (GenState [Name] -> GenState Name)
-> GenState [Name] -> GenState Name
forall a b. (a -> b) -> a -> b
$ GenState Name -> GenState [Name]
forall a b. State a b -> State a [b]
liftS GenState Name
outputFormatDesc
State DrasilState (SFile r) -> GenState [SFile r]
forall a b. State a b -> State a [b]
liftS (State DrasilState (SFile r) -> GenState [SFile r])
-> State DrasilState (SFile r) -> GenState [SFile r]
forall a b. (a -> b) -> a -> b
$ Name
-> Name
-> [GenState (Maybe (SMethod r))]
-> [GenState (Maybe (SClass r))]
-> State DrasilState (SFile r)
forall (r :: * -> *).
OOProg r =>
Name
-> Name
-> [GenState (Maybe (SMethod r))]
-> [GenState (Maybe (SClass r))]
-> GenState (SFile r)
genModule "OutputFormat" Name
ofDesc [GenState (Maybe (SMethod r))
forall (r :: * -> *). OOProg r => GenState (Maybe (SMethod r))
genOutputFormat] []
genOutputFormat :: (OOProg r) => GenState (Maybe (SMethod r))
genOutputFormat :: GenState (Maybe (SMethod r))
genOutputFormat = do
DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
let genOutput :: (OOProg r) => Maybe String -> GenState
(Maybe (SMethod r))
genOutput :: Maybe Name -> GenState (Maybe (SMethod r))
genOutput Nothing = Maybe (SMethod r) -> GenState (Maybe (SMethod r))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (SMethod r)
forall a. Maybe a
Nothing
genOutput (Just _) = do
let l_outfile :: Name
l_outfile = "outputfile"
var_outfile :: SVariable r
var_outfile = Name -> VSType r -> SVariable r
forall (r :: * -> *).
VariableSym r =>
Name -> VSType r -> SVariable r
var Name
l_outfile VSType r
forall (r :: * -> *). TypeSym r => VSType r
outfile
v_outfile :: SValue r
v_outfile = SVariable r -> SValue r
forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
valueOf SVariable r
var_outfile
[CodeVarChunk]
parms <- GenState [CodeVarChunk]
getOutputParams
[[MS (r (Statement r))]]
outp <- (CodeVarChunk
-> StateT DrasilState Identity [MS (r (Statement r))])
-> [CodeVarChunk]
-> StateT DrasilState Identity [[MS (r (Statement r))]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\x :: CodeVarChunk
x -> do
SValue r
v <- CodeVarChunk -> GenState (SValue r)
forall (r :: * -> *).
OOProg r =>
CodeVarChunk -> GenState (SValue r)
mkVal CodeVarChunk
x
[MS (r (Statement r))]
-> StateT DrasilState Identity [MS (r (Statement r))]
forall (m :: * -> *) a. Monad m => a -> m a
return [ SValue r -> Name -> MS (r (Statement r))
forall (r :: * -> *).
IOStatement r =>
SValue r -> Name -> MSStatement r
printFileStr SValue r
v_outfile (CodeVarChunk -> Name
forall c. CodeIdea c => c -> Name
codeName CodeVarChunk
x Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ " = "),
SValue r -> SValue r -> MS (r (Statement r))
forall (r :: * -> *).
IOStatement r =>
SValue r -> SValue r -> MSStatement r
printFileLn SValue r
v_outfile SValue r
v
] ) (CodeSpec -> [CodeVarChunk]
outputs (CodeSpec -> [CodeVarChunk]) -> CodeSpec -> [CodeVarChunk]
forall a b. (a -> b) -> a -> b
$ DrasilState -> CodeSpec
codeSpec DrasilState
g)
Name
desc <- GenState Name
woFuncDesc
SMethod r
mthd <- Name
-> VSType r
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MSBlock r]
-> GenState (SMethod r)
forall (r :: * -> *).
OOProg r =>
Name
-> VSType r
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MSBlock r]
-> GenState (SMethod r)
publicFunc "write_output" VSType r
forall (r :: * -> *). TypeSym r => VSType r
void Name
desc ((CodeVarChunk -> ParameterChunk)
-> [CodeVarChunk] -> [ParameterChunk]
forall a b. (a -> b) -> [a] -> [b]
map CodeVarChunk -> ParameterChunk
forall c. CodeIdea c => c -> ParameterChunk
pcAuto [CodeVarChunk]
parms) Maybe Name
forall a. Maybe a
Nothing
[[MS (r (Statement r))] -> MSBlock r
forall (r :: * -> *). BlockSym r => [MSStatement r] -> MSBlock r
block ([MS (r (Statement r))] -> MSBlock r)
-> [MS (r (Statement r))] -> MSBlock r
forall a b. (a -> b) -> a -> b
$ [
SVariable r -> MS (r (Statement r))
forall (r :: * -> *).
DeclStatement r =>
SVariable r -> MSStatement r
varDec SVariable r
var_outfile,
SVariable r -> SValue r -> MS (r (Statement r))
forall (r :: * -> *).
IOStatement r =>
SVariable r -> SValue r -> MSStatement r
openFileW SVariable r
var_outfile (Name -> SValue r
forall (r :: * -> *). Literal r => Name -> SValue r
litString "output.txt") ] [MS (r (Statement r))]
-> [MS (r (Statement r))] -> [MS (r (Statement r))]
forall a. [a] -> [a] -> [a]
++
[[MS (r (Statement r))]] -> [MS (r (Statement r))]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[MS (r (Statement r))]]
outp [MS (r (Statement r))]
-> [MS (r (Statement r))] -> [MS (r (Statement r))]
forall a. [a] -> [a] -> [a]
++ [ SValue r -> MS (r (Statement r))
forall (r :: * -> *). IOStatement r => SValue r -> MSStatement r
closeFile SValue r
v_outfile ]]
Maybe (SMethod r) -> GenState (Maybe (SMethod r))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (SMethod r) -> GenState (Maybe (SMethod r)))
-> Maybe (SMethod r) -> GenState (Maybe (SMethod r))
forall a b. (a -> b) -> a -> b
$ SMethod r -> Maybe (SMethod r)
forall a. a -> Maybe a
Just SMethod r
mthd
Maybe Name -> GenState (Maybe (SMethod r))
forall (r :: * -> *).
OOProg r =>
Maybe Name -> GenState (Maybe (SMethod r))
genOutput (Maybe Name -> GenState (Maybe (SMethod r)))
-> Maybe Name -> GenState (Maybe (SMethod r))
forall a b. (a -> b) -> a -> b
$ Name -> Map Name Name -> Maybe Name
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup "write_output" (DrasilState -> Map Name Name
eMap DrasilState
g)