{-# LANGUAGE LambdaCase, FlexibleContexts #-}

module Language.Drasil.Code.Imperative.Modules (
  genMain, genMainProc, genMainFunc, genMainFuncProc, genInputClass,
  genInputDerived, genInputDerivedProc, genInputMod, genInputModProc,
  genInputConstraints, genInputConstraintsProc, genInputFormat,
  genInputFormatProc, genConstMod, checkConstClass, genConstClass, genCalcMod,
  genCalcModProc, genCalcFunc, genCalcFuncProc, genOutputMod, genOutputModProc,
  genOutputFormat, genOutputFormatProc, genSampleInput
) where

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, modify)
import Control.Lens ((^.))
import Text.PrettyPrint.HughesPJ (render, parens)
import Data.Deriving.Internal (interleave)

import Drasil.FileHandling (FileLayout)
import Drasil.Database (HasUID(..))
import Language.Drasil (Constraint(..), RealInterval(..), HasSpace(typ),
  Space(..))
import Language.Drasil.Printers (showHasSymbImpl, PrintingInformation,
  oneLineCodeExprDoc)
import Drasil.GOOL (Body, Block, SVariable, SValue, File, CS, FS, MS, CSStateVar,
  Class, SharedProg, OOProg, BodySym(..), bodyStatements, oneLiner, BlockSym(..),
  AttachmentSym(..), TypeSym(..), VariableSym(..), ScopeSym(..), ScopeData,
  Literal(..), VariableValue(..), CommandLineArgs(..), NumericExpression(..),
  BooleanExpression(..), Comparison(..), List(..), StatementSym(..),
  AssignStatement(..), DeclStatement(..), OODeclStatement(..), objDecNewNoParams,
  extObjDecNewNoParams, IOStatement(..), ControlStatement(..), ifNoElse,
  VisibilitySym(..), MethodSym(..), StateVarSym(..), pubDVar, convType,
  convTypeOO, VisibilityTag(..), SharedStatement, TypeElim, VariableElim,
  OOStatement)
import Drasil.GProc (ProcProg, NativeVector)

import Drasil.Code.CodeExpr.Development
import Drasil.Code.CodeVar (CodeIdea(codeName), CodeVarChunk, quantvar,
  DefiningCodeExpr(..))
import Language.Drasil.Code.Imperative.Comments (getCommentBrief)
import Language.Drasil.Code.Imperative.Descriptions (constClassDesc,
  constModDesc, dvFuncDesc, inConsFuncDesc, inFmtFuncDesc, inputClassDesc,
  inputConstructorDesc, inputParametersDesc, modDesc, outputFormatDesc,
  woFuncDesc, calcModDesc)
import Language.Drasil.Code.Imperative.FunctionCalls (genCalcCall,
  genCalcCallProc, genAllInputCalls, genAllInputCallsProc, genOutputCall,
  genOutputCallProc)
import Language.Drasil.Code.Imperative.GenerateGOOL (ClassType(..), genModule,
  genModuleProc, genModuleWithImports, genModuleWithImportsProc, primaryClass,
  auxClass)
import Language.Drasil.Code.Imperative.Helpers (liftS, convScope)
import Language.Drasil.Code.Imperative.Import (codeType, convExpr, convExprProc,
  convStmt, convStmtProc, genConstructor, mkVal, mkValProc, mkVar, mkVarProc,
  privateInOutMethod, privateMethod, privateFuncProc, publicFunc, publicFuncProc,
  publicInOutFunc, publicInOutFuncProc, privateInOutFuncProc, readData,
  readDataProc, renderC)
import Language.Drasil.Code.Imperative.Logging (varLogFile)
import Language.Drasil.Code.Imperative.Parameters (getConstraintParams,
  getDerivedIns, getDerivedOuts, getInConstructorParams, getInputFormatIns,
  getInputFormatOuts, getCalcParams, getOutputParams, resolveOutputDefType)
import Language.Drasil.Code.Imperative.DrasilState (GenState, DrasilState(..),
  ScopeType(..), genICName, getSoftwareDossierFiles, getSampleData,
  HasChoices(..))
import Language.Drasil.SoftwareDossier.SoftwareDossierSym (sampleInput)
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(..),
  Logging(..), Structure(..), hasSampleInput, InternalConcept(..))
import Language.Drasil.CodeSpec (HasCodeSpec(..))
import Language.Drasil.Expr.Development (Completeness(..))

type ConstraintCE = Constraint CodeExpr

---- MAIN ---

-- | Generates a controller module.
genMain :: (OOProg r vis smt md svr att prg) => GenState (FS (r File))
genMain :: forall (r :: * -> *) vis smt md svr att prg.
OOProg r vis smt md svr att prg =>
GenState (FS (r File))
genMain = String
-> String
-> [GenState (Maybe (MS (r md)))]
-> [GenState (Maybe (CS (r Class)))]
-> GenState (FS (r File))
forall (r :: * -> *) vis smt md svr att prg.
OOProg r vis smt md svr att prg =>
String
-> String
-> [GenState (Maybe (MS (r md)))]
-> [GenState (Maybe (CS (r Class)))]
-> GenState (FS (r File))
genModule String
"Control" String
"Controls the flow of the program"
  [GenState (Maybe (MS (r md)))
forall (r :: * -> *) vis smt md svr att prg.
OOProg r vis smt md svr att prg =>
GenState (Maybe (MS (r md)))
genMainFunc] []

-- | Generates a main function, to act as the controller for an SCS program.
-- The controller declares input and constant variables, then calls the
-- functions for reading input values, calculating derived inputs, checking
-- constraints, calculating outputs, and printing outputs.
-- Returns Nothing if the user chose to generate a library.
genMainFunc :: (OOProg r vis smt md svr att prg) => GenState (Maybe (MS (r md)))
genMainFunc :: forall (r :: * -> *) vis smt md svr att prg.
OOProg r vis smt md svr att prg =>
GenState (Maybe (MS (r md)))
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 md)))
mainFunc ImplementationType
Library = Maybe (MS (r md))
-> StateT DrasilState Identity (Maybe (MS (r md)))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MS (r md))
forall a. Maybe a
Nothing
        mainFunc ImplementationType
Program = do
          (DrasilState -> DrasilState) -> StateT DrasilState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\DrasilState
st -> DrasilState
st {currentScope = MainFn})
          SVariable r
v_filename <- CodeVarChunk -> GenState (SVariable r)
forall (r :: * -> *).
(SelfSym r, VariableElim r, VariableValue r) =>
CodeVarChunk -> GenState (SVariable r)
mkVar (DefinedQuantityDict -> CodeVarChunk
forall c.
(Quantity c, MayHaveUnit c, Concept c) =>
c -> CodeVarChunk
quantvar DefinedQuantityDict
inFileName)
          Maybe (MS (r smt))
co <- GenState (Maybe (MS (r smt)))
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
GenState (Maybe (MS (r smt)))
initConsts
          Maybe (MS (r smt))
ip <- GenState (Maybe (MS (r smt)))
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
GenState (Maybe (MS (r smt)))
getInputDecl
          [MS (r smt)]
ics <- GenState [MS (r smt)]
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
GenState [MS (r smt)]
genAllInputCalls
          [Maybe (MS (r smt))]
varDef <- (CodeDefinition -> GenState (Maybe (MS (r smt))))
-> [CodeDefinition]
-> StateT DrasilState Identity [Maybe (MS (r smt))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM CodeDefinition -> GenState (Maybe (MS (r smt)))
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
CodeDefinition -> GenState (Maybe (MS (r smt)))
genCalcCall (DrasilState
g DrasilState
-> Getting [CodeDefinition] DrasilState [CodeDefinition]
-> [CodeDefinition]
forall s a. s -> Getting a s a -> a
^. Getting [CodeDefinition] DrasilState [CodeDefinition]
forall c. HasCodeSpec c => Lens' c [CodeDefinition]
Lens' DrasilState [CodeDefinition]
execOrder)
          Maybe (MS (r smt))
wo <- GenState (Maybe (MS (r smt)))
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
GenState (Maybe (MS (r smt)))
genOutputCall
          Maybe (MS (r md))
-> StateT DrasilState Identity (Maybe (MS (r md)))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MS (r md))
 -> StateT DrasilState Identity (Maybe (MS (r md))))
-> Maybe (MS (r md))
-> StateT DrasilState Identity (Maybe (MS (r md)))
forall a b. (a -> b) -> a -> b
$ MS (r md) -> Maybe (MS (r md))
forall a. a -> Maybe a
Just (MS (r md) -> Maybe (MS (r md))) -> MS (r md) -> Maybe (MS (r md))
forall a b. (a -> b) -> a -> b
$
            (if Comments
CommentFunc Comments -> [Comments] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` DrasilState
g DrasilState
-> Getting [Comments] DrasilState [Comments] -> [Comments]
forall s a. s -> Getting a s a -> a
^. Getting [Comments] DrasilState [Comments]
forall a. HasChoices a => Lens' a [Comments]
Lens' DrasilState [Comments]
commented
              then MS (r Class) -> MS (r md)
forall (r :: * -> *) vis smt md.
MethodSym r vis smt md =>
MS (r Class) -> MS (r md)
docMain
              else MS (r Class) -> MS (r md)
forall (r :: * -> *) vis smt md.
MethodSym r vis smt md =>
MS (r Class) -> MS (r md)
mainFunction)
            (MS (r Class) -> MS (r md)) -> MS (r Class) -> MS (r md)
forall a b. (a -> b) -> a -> b
$ [MS (r smt)] -> MS (r Class)
forall (r :: * -> *) smt.
BodySym r smt =>
[MS (r smt)] -> MS (r Class)
bodyStatements ([MS (r smt)] -> MS (r Class)) -> [MS (r smt)] -> MS (r Class)
forall a b. (a -> b) -> a -> b
$ [Logging] -> r ScopeData -> [MS (r smt)]
forall (r :: * -> *) smt.
DeclStatement r smt =>
[Logging] -> r ScopeData -> [MS (r smt)]
initLogFileVar (DrasilState
g DrasilState -> Getting [Logging] DrasilState [Logging] -> [Logging]
forall s a. s -> Getting a s a -> a
^. Getting [Logging] DrasilState [Logging]
forall a. HasChoices a => Lens' a [Logging]
Lens' DrasilState [Logging]
logKind) r ScopeData
forall (r :: * -> *). ScopeSym r => r ScopeData
mainFn
              [MS (r smt)] -> [MS (r smt)] -> [MS (r smt)]
forall a. [a] -> [a] -> [a]
++ [SVariable r -> r ScopeData -> SValue r -> MS (r smt)
forall (r :: * -> *) smt.
DeclStatement r smt =>
SVariable r -> r ScopeData -> SValue r -> MS (r smt)
varDecDef SVariable r
v_filename r ScopeData
forall (r :: * -> *). ScopeSym r => r ScopeData
mainFn (Integer -> SValue r
forall (r :: * -> *). CommandLineArgs r => Integer -> SValue r
arg Integer
0)]
              -- Constants must be declared before inputs because some derived
              -- input definitions or input constraints may use the constants
              [MS (r smt)] -> [MS (r smt)] -> [MS (r smt)]
forall a. [a] -> [a] -> [a]
++ [Maybe (MS (r smt))] -> [MS (r smt)]
forall a. [Maybe a] -> [a]
catMaybes [Maybe (MS (r smt))
co, Maybe (MS (r smt))
ip] [MS (r smt)] -> [MS (r smt)] -> [MS (r smt)]
forall a. [a] -> [a] -> [a]
++ [MS (r smt)]
ics [MS (r smt)] -> [MS (r smt)] -> [MS (r smt)]
forall a. [a] -> [a] -> [a]
++ [Maybe (MS (r smt))] -> [MS (r smt)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (MS (r smt))]
varDef [Maybe (MS (r smt))]
-> [Maybe (MS (r smt))] -> [Maybe (MS (r smt))]
forall a. [a] -> [a] -> [a]
++ [Maybe (MS (r smt))
wo])
    ImplementationType -> GenState (Maybe (MS (r md)))
forall {r :: * -> *} {vis} {smt} {md}.
(OOStatement r smt, MethodSym r vis smt md, TypeElim r,
 VariableElim r) =>
ImplementationType
-> StateT DrasilState Identity (Maybe (MS (r md)))
mainFunc (ImplementationType -> GenState (Maybe (MS (r md))))
-> ImplementationType -> GenState (Maybe (MS (r md)))
forall a b. (a -> b) -> a -> b
$ DrasilState
g DrasilState
-> Getting ImplementationType DrasilState ImplementationType
-> ImplementationType
forall s a. s -> Getting a s a -> a
^. Getting ImplementationType DrasilState ImplementationType
forall a. HasChoices a => Lens' a ImplementationType
Lens' DrasilState ImplementationType
implType

-- | If there are no inputs, the 'inParams' object still needs to be declared
-- if inputs are 'Bundled', constants are stored 'WithInputs', and constant
-- representation is 'Var'.
-- If there are inputs and they are not exported by any module, then they are
-- 'Unbundled' and are declared individually using 'varDec'.
-- If there are inputs and they are exported by a module, they are 'Bundled' in
-- the InputParameters class, so 'inParams' should be declared and constructed,
-- using 'objDecNew' if the inputs are exported by the current module, and
-- 'extObjDecNew' if they are exported by a different module.
getInputDecl
  :: (OOStatement r smt, TypeElim r, VariableElim r)
  => GenState (Maybe (MS (r smt)))
getInputDecl :: forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
GenState (Maybe (MS (r smt)))
getInputDecl = do
  DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  let scp :: r ScopeData
scp = ScopeType -> r ScopeData
forall (r :: * -> *). ScopeSym r => ScopeType -> r ScopeData
convScope (ScopeType -> r ScopeData) -> ScopeType -> r ScopeData
forall a b. (a -> b) -> a -> b
$ DrasilState -> ScopeType
currentScope DrasilState
g
  SVariable r
v_params <- CodeVarChunk -> GenState (SVariable r)
forall (r :: * -> *).
(SelfSym r, VariableElim r, VariableValue r) =>
CodeVarChunk -> GenState (SVariable r)
mkVar (DefinedQuantityDict -> CodeVarChunk
forall c.
(Quantity c, MayHaveUnit c, Concept c) =>
c -> CodeVarChunk
quantvar DefinedQuantityDict
inParams)
  [CodeVarChunk]
constrParams <- GenState [CodeVarChunk]
getInConstructorParams
  [SValue r]
cps <- (CodeVarChunk -> StateT DrasilState Identity (SValue r))
-> [CodeVarChunk] -> StateT DrasilState Identity [SValue r]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM CodeVarChunk -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
CodeVarChunk -> GenState (SValue r)
mkVal [CodeVarChunk]
constrParams
  String
cname <- InternalConcept -> GenState String
genICName InternalConcept
InputParameters
  let getDecl :: ([CodeVarChunk], [CodeVarChunk]) -> GenState (Maybe (MS (r smt)))
getDecl ([],[]) = ([CodeVarChunk], [CodeVarChunk])
-> ConstantRepr
-> ConstantStructure
-> GenState (Maybe (MS (r smt)))
constIns ((CodeVarChunk -> Bool)
-> [CodeVarChunk] -> ([CodeVarChunk], [CodeVarChunk])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ((String -> Map String String -> Bool)
-> Map String String -> String -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> Map String String -> Bool
forall k a. Ord k => k -> Map k a -> Bool
member (DrasilState -> Map String String
eMap DrasilState
g) (String -> Bool)
-> (CodeVarChunk -> String) -> CodeVarChunk -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        CodeVarChunk -> String
forall c. CodeIdea c => c -> String
codeName) ((CodeDefinition -> CodeVarChunk)
-> [CodeDefinition] -> [CodeVarChunk]
forall a b. (a -> b) -> [a] -> [b]
map CodeDefinition -> CodeVarChunk
forall c.
(Quantity c, MayHaveUnit c, Concept c) =>
c -> CodeVarChunk
quantvar ([CodeDefinition] -> [CodeVarChunk])
-> [CodeDefinition] -> [CodeVarChunk]
forall a b. (a -> b) -> a -> b
$ DrasilState
g DrasilState
-> Getting [CodeDefinition] DrasilState [CodeDefinition]
-> [CodeDefinition]
forall s a. s -> Getting a s a -> a
^. Getting [CodeDefinition] DrasilState [CodeDefinition]
forall c. HasCodeSpec c => Lens' c [CodeDefinition]
Lens' DrasilState [CodeDefinition]
constDefns)) (DrasilState
g DrasilState
-> Getting ConstantRepr DrasilState ConstantRepr -> ConstantRepr
forall s a. s -> Getting a s a -> a
^. Getting ConstantRepr DrasilState ConstantRepr
forall a. HasChoices a => Lens' a ConstantRepr
Lens' DrasilState ConstantRepr
conRepr)
        (DrasilState
g DrasilState
-> Getting ConstantStructure DrasilState ConstantStructure
-> ConstantStructure
forall s a. s -> Getting a s a -> a
^. Getting ConstantStructure DrasilState ConstantStructure
forall a. HasChoices a => Lens' a ConstantStructure
Lens' DrasilState ConstantStructure
conStruct)
      getDecl ([],[CodeVarChunk]
ins) = do
        [SVariable r]
vars <- (CodeVarChunk -> GenState (SVariable r))
-> [CodeVarChunk] -> StateT DrasilState Identity [SVariable r]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM CodeVarChunk -> GenState (SVariable r)
forall (r :: * -> *).
(SelfSym r, VariableElim r, VariableValue r) =>
CodeVarChunk -> GenState (SVariable r)
mkVar [CodeVarChunk]
ins
        Maybe (MS (r smt)) -> GenState (Maybe (MS (r smt)))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MS (r smt)) -> GenState (Maybe (MS (r smt))))
-> Maybe (MS (r smt)) -> GenState (Maybe (MS (r smt)))
forall a b. (a -> b) -> a -> b
$ MS (r smt) -> Maybe (MS (r smt))
forall a. a -> Maybe a
Just (MS (r smt) -> Maybe (MS (r smt)))
-> MS (r smt) -> Maybe (MS (r smt))
forall a b. (a -> b) -> a -> b
$ [MS (r smt)] -> MS (r smt)
forall (r :: * -> *) smt.
StatementSym r smt =>
[MS (r smt)] -> MS (r smt)
multi ([MS (r smt)] -> MS (r smt)) -> [MS (r smt)] -> MS (r smt)
forall a b. (a -> b) -> a -> b
$ (SVariable r -> MS (r smt)) -> [SVariable r] -> [MS (r smt)]
forall a b. (a -> b) -> [a] -> [b]
map (SVariable r -> r ScopeData -> MS (r smt)
forall (r :: * -> *) smt.
DeclStatement r smt =>
SVariable r -> r ScopeData -> MS (r smt)
`varDec` r ScopeData
scp) [SVariable r]
vars
      getDecl (CodeVarChunk
i:[CodeVarChunk]
_,[]) = Maybe (MS (r smt)) -> GenState (Maybe (MS (r smt)))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MS (r smt)) -> GenState (Maybe (MS (r smt))))
-> Maybe (MS (r smt)) -> GenState (Maybe (MS (r smt)))
forall a b. (a -> b) -> a -> b
$ MS (r smt) -> Maybe (MS (r smt))
forall a. a -> Maybe a
Just (MS (r smt) -> Maybe (MS (r smt)))
-> MS (r smt) -> Maybe (MS (r smt))
forall a b. (a -> b) -> a -> b
$ (if DrasilState -> String
currentModule DrasilState
g String -> String -> Bool
forall a. Eq a => a -> a -> Bool
==
        DrasilState -> Map String String
eMap DrasilState
g Map String String -> String -> String
forall k a. Ord k => Map k a -> k -> a
! CodeVarChunk -> String
forall c. CodeIdea c => c -> String
codeName CodeVarChunk
i then SVariable r -> r ScopeData -> [SValue r] -> MS (r smt)
forall (r :: * -> *) smt.
OODeclStatement r smt =>
SVariable r -> r ScopeData -> [SValue r] -> MS (r smt)
objDecNew
        else String -> SVariable r -> r ScopeData -> [SValue r] -> MS (r smt)
forall (r :: * -> *) smt.
OODeclStatement r smt =>
String -> SVariable r -> r ScopeData -> [SValue r] -> MS (r smt)
extObjDecNew String
cname) SVariable r
v_params r ScopeData
scp [SValue r]
cps
      getDecl ([CodeVarChunk], [CodeVarChunk])
_ = String -> GenState (Maybe (MS (r smt)))
forall a. HasCallStack => String -> a
error (String
"Inputs or constants are only partially contained in "
        String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"a class")
      constIns :: ([CodeVarChunk], [CodeVarChunk])
-> ConstantRepr
-> ConstantStructure
-> GenState (Maybe (MS (r smt)))
constIns ([],[]) ConstantRepr
_ ConstantStructure
_ = Maybe (MS (r smt)) -> GenState (Maybe (MS (r smt)))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MS (r smt))
forall a. Maybe a
Nothing
      -- If Const is chosen, don't declare an object because constants are static and accessed through class
      constIns ([CodeVarChunk], [CodeVarChunk])
cs ConstantRepr
Var ConstantStructure
WithInputs = ([CodeVarChunk], [CodeVarChunk]) -> GenState (Maybe (MS (r smt)))
getDecl ([CodeVarChunk], [CodeVarChunk])
cs
      constIns ([CodeVarChunk], [CodeVarChunk])
_ ConstantRepr
_ ConstantStructure
_ = Maybe (MS (r smt)) -> GenState (Maybe (MS (r smt)))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MS (r smt))
forall a. Maybe a
Nothing
  ([CodeVarChunk], [CodeVarChunk]) -> GenState (Maybe (MS (r smt)))
getDecl ((CodeVarChunk -> Bool)
-> [CodeVarChunk] -> ([CodeVarChunk], [CodeVarChunk])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ((String -> Map String String -> Bool)
-> Map String String -> String -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> Map String String -> Bool
forall k a. Ord k => k -> Map k a -> Bool
member (DrasilState -> Map String String
eMap DrasilState
g) (String -> Bool)
-> (CodeVarChunk -> String) -> CodeVarChunk -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CodeVarChunk -> String
forall c. CodeIdea c => c -> String
codeName)
    (DrasilState
g DrasilState
-> Getting [CodeVarChunk] DrasilState [CodeVarChunk]
-> [CodeVarChunk]
forall s a. s -> Getting a s a -> a
^. Getting [CodeVarChunk] DrasilState [CodeVarChunk]
forall c. HasCodeSpec c => Lens' c [CodeVarChunk]
Lens' DrasilState [CodeVarChunk]
inputs))

-- | If constants are 'Unbundled', declare them individually using 'varDecDef' if
-- representation is 'Var' and 'constDecDef' if representation is 'Const'.
-- If constants are 'Bundled' independently and representation is 'Var', declare
-- the consts object. If representation is 'Const', no object needs to be
-- declared because the constants will be accessed directly through the
-- Constants class.
-- If constants are 'Bundled' 'WithInputs', do 'Nothing'; declaration of the 'inParams'
-- object is handled by 'getInputDecl'.
-- If constants are 'Inlined', nothing needs to be declared.
initConsts
  :: (OOStatement r smt, TypeElim r, VariableElim r)
  => GenState (Maybe (MS (r smt)))
initConsts :: forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
GenState (Maybe (MS (r smt)))
initConsts = do
  DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  let scp :: r ScopeData
scp = ScopeType -> r ScopeData
forall (r :: * -> *). ScopeSym r => ScopeType -> r ScopeData
convScope (ScopeType -> r ScopeData) -> ScopeType -> r ScopeData
forall a b. (a -> b) -> a -> b
$ DrasilState -> ScopeType
currentScope DrasilState
g
  SVariable r
v_consts <- CodeVarChunk -> GenState (SVariable r)
forall (r :: * -> *).
(SelfSym r, VariableElim r, VariableValue r) =>
CodeVarChunk -> GenState (SVariable r)
mkVar (DefinedQuantityDict -> CodeVarChunk
forall c.
(Quantity c, MayHaveUnit c, Concept c) =>
c -> CodeVarChunk
quantvar DefinedQuantityDict
consts)
  String
cname <- InternalConcept -> GenState String
genICName InternalConcept
Constants
  let cs :: [CodeDefinition]
cs = DrasilState
g DrasilState
-> Getting [CodeDefinition] DrasilState [CodeDefinition]
-> [CodeDefinition]
forall s a. s -> Getting a s a -> a
^. Getting [CodeDefinition] DrasilState [CodeDefinition]
forall c. HasCodeSpec c => Lens' c [CodeDefinition]
Lens' DrasilState [CodeDefinition]
constDefns
      getDecl :: ConstantStructure -> Structure -> GenState (Maybe (MS (r smt)))
getDecl (Store Structure
Unbundled) Structure
_ = GenState (Maybe (MS (r smt)))
declVars
      getDecl (Store Structure
Bundled) Structure
_ = (DrasilState -> Maybe (MS (r smt)))
-> GenState (Maybe (MS (r smt)))
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (\DrasilState
s -> [CodeDefinition] -> ConstantRepr -> Maybe (MS (r smt))
forall {c}. CodeIdea c => [c] -> ConstantRepr -> Maybe (MS (r smt))
declObj [CodeDefinition]
cs (DrasilState
s DrasilState
-> Getting ConstantRepr DrasilState ConstantRepr -> ConstantRepr
forall s a. s -> Getting a s a -> a
^. Getting ConstantRepr DrasilState ConstantRepr
forall a. HasChoices a => Lens' a ConstantRepr
Lens' DrasilState ConstantRepr
conRepr))
      getDecl ConstantStructure
WithInputs Structure
Unbundled = GenState (Maybe (MS (r smt)))
declVars
      getDecl ConstantStructure
WithInputs Structure
Bundled = Maybe (MS (r smt)) -> GenState (Maybe (MS (r smt)))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MS (r smt))
forall a. Maybe a
Nothing
      getDecl ConstantStructure
Inline Structure
_ = Maybe (MS (r smt)) -> GenState (Maybe (MS (r smt)))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MS (r smt))
forall a. Maybe a
Nothing
      declVars :: GenState (Maybe (MS (r smt)))
declVars = do
        [SVariable r]
vars <- (CodeDefinition -> GenState (SVariable r))
-> [CodeDefinition] -> StateT DrasilState Identity [SVariable r]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (CodeVarChunk -> GenState (SVariable r)
forall (r :: * -> *).
(SelfSym r, VariableElim r, VariableValue r) =>
CodeVarChunk -> GenState (SVariable r)
mkVar (CodeVarChunk -> GenState (SVariable r))
-> (CodeDefinition -> CodeVarChunk)
-> CodeDefinition
-> GenState (SVariable r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CodeDefinition -> CodeVarChunk
forall c.
(Quantity c, MayHaveUnit c, Concept c) =>
c -> CodeVarChunk
quantvar) [CodeDefinition]
cs
        [SValue r]
vals <- (CodeDefinition -> StateT DrasilState Identity (SValue r))
-> [CodeDefinition] -> StateT DrasilState Identity [SValue r]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (CodeExpr -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr (CodeExpr -> StateT DrasilState Identity (SValue r))
-> (CodeDefinition -> CodeExpr)
-> CodeDefinition
-> StateT DrasilState Identity (SValue 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
Lens' CodeDefinition CodeExpr
codeExpr)) [CodeDefinition]
cs
        Maybe (MS (r smt)) -> GenState (Maybe (MS (r smt)))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MS (r smt)) -> GenState (Maybe (MS (r smt))))
-> Maybe (MS (r smt)) -> GenState (Maybe (MS (r smt)))
forall a b. (a -> b) -> a -> b
$ MS (r smt) -> Maybe (MS (r smt))
forall a. a -> Maybe a
Just (MS (r smt) -> Maybe (MS (r smt)))
-> MS (r smt) -> Maybe (MS (r smt))
forall a b. (a -> b) -> a -> b
$ [MS (r smt)] -> MS (r smt)
forall (r :: * -> *) smt.
StatementSym r smt =>
[MS (r smt)] -> MS (r smt)
multi ([MS (r smt)] -> MS (r smt)) -> [MS (r smt)] -> MS (r smt)
forall a b. (a -> b) -> a -> b
$
          (SVariable r -> SValue r -> MS (r smt))
-> [SVariable r] -> [SValue r] -> [MS (r smt)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\SVariable r
vr -> ConstantRepr
-> SVariable r -> r ScopeData -> SValue r -> MS (r smt)
forall {r :: * -> *} {smt}.
DeclStatement r smt =>
ConstantRepr
-> SVariable r -> r ScopeData -> SValue r -> MS (r smt)
defFunc (DrasilState
g DrasilState
-> Getting ConstantRepr DrasilState ConstantRepr -> ConstantRepr
forall s a. s -> Getting a s a -> a
^. Getting ConstantRepr DrasilState ConstantRepr
forall a. HasChoices a => Lens' a ConstantRepr
Lens' DrasilState ConstantRepr
conRepr) SVariable r
vr r ScopeData
scp) [SVariable r]
vars [SValue r]
vals
      defFunc :: ConstantRepr
-> SVariable r -> r ScopeData -> SValue r -> MS (r smt)
defFunc ConstantRepr
Var = SVariable r -> r ScopeData -> SValue r -> MS (r smt)
forall (r :: * -> *) smt.
DeclStatement r smt =>
SVariable r -> r ScopeData -> SValue r -> MS (r smt)
varDecDef
      defFunc ConstantRepr
Const = SVariable r -> r ScopeData -> SValue r -> MS (r smt)
forall (r :: * -> *) smt.
DeclStatement r smt =>
SVariable r -> r ScopeData -> SValue r -> MS (r smt)
constDecDef
      declObj :: [c] -> ConstantRepr -> Maybe (MS (r smt))
declObj [] ConstantRepr
_ = Maybe (MS (r smt))
forall a. Maybe a
Nothing
      declObj (c
c:[c]
_) ConstantRepr
Var = MS (r smt) -> Maybe (MS (r smt))
forall a. a -> Maybe a
Just (MS (r smt) -> Maybe (MS (r smt)))
-> MS (r smt) -> Maybe (MS (r smt))
forall a b. (a -> b) -> a -> b
$ (if DrasilState -> String
currentModule DrasilState
g String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== DrasilState -> Map String String
eMap DrasilState
g Map String String -> String -> String
forall k a. Ord k => Map k a -> k -> a
! c -> String
forall c. CodeIdea c => c -> String
codeName c
c
        then SVariable r -> r ScopeData -> MS (r smt)
forall (r :: * -> *) smt.
OODeclStatement r smt =>
SVariable r -> r ScopeData -> MS (r smt)
objDecNewNoParams else String -> SVariable r -> r ScopeData -> MS (r smt)
forall (r :: * -> *) smt.
OODeclStatement r smt =>
String -> SVariable r -> r ScopeData -> MS (r smt)
extObjDecNewNoParams String
cname) SVariable r
v_consts r ScopeData
scp
      declObj [c]
_ ConstantRepr
Const = Maybe (MS (r smt))
forall a. Maybe a
Nothing
  ConstantStructure -> Structure -> GenState (Maybe (MS (r smt)))
getDecl (DrasilState
g DrasilState
-> Getting ConstantStructure DrasilState ConstantStructure
-> ConstantStructure
forall s a. s -> Getting a s a -> a
^. Getting ConstantStructure DrasilState ConstantStructure
forall a. HasChoices a => Lens' a ConstantStructure
Lens' DrasilState ConstantStructure
conStruct) (DrasilState
g DrasilState -> Getting Structure DrasilState Structure -> Structure
forall s a. s -> Getting a s a -> a
^. Getting Structure DrasilState Structure
forall a. HasChoices a => Lens' a Structure
Lens' DrasilState Structure
inStruct)

-- | Generates a statement to declare the variable representing the log file,
-- if the user chose to turn on logs for variable assignments.
initLogFileVar :: (DeclStatement r smt) => [Logging] -> r ScopeData -> [MS (r smt)]
initLogFileVar :: forall (r :: * -> *) smt.
DeclStatement r smt =>
[Logging] -> r ScopeData -> [MS (r smt)]
initLogFileVar [Logging]
l r ScopeData
scp = [SVariable r -> r ScopeData -> MS (r smt)
forall (r :: * -> *) smt.
DeclStatement r smt =>
SVariable r -> r ScopeData -> MS (r smt)
varDec SVariable r
forall (r :: * -> *). VariableSym r => SVariable r
varLogFile r ScopeData
scp | Logging
LogVar Logging -> [Logging] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Logging]
l]

------- INPUT ----------

-- | Generates a single module containing all input-related components.
genInputMod :: (OOProg r vis smt md svr att prg) => GenState [FS (r File)]
genInputMod :: forall (r :: * -> *) vis smt md svr att prg.
OOProg r vis smt md svr att prg =>
GenState [FS (r File)]
genInputMod = do
  String
ipDesc <- GenState [String] -> GenState String
modDesc GenState [String]
inputParametersDesc
  String
cname <- InternalConcept -> GenState String
genICName InternalConcept
InputParameters
  let genMod :: (OOProg r vis smt md svr att prg) => Maybe (CS (r Class)) -> GenState (FS (r File))
      genMod :: forall (r :: * -> *) vis smt md svr att prg.
OOProg r vis smt md svr att prg =>
Maybe (CS (r Class)) -> GenState (FS (r File))
genMod Maybe (CS (r Class))
Nothing = String
-> String
-> [GenState (Maybe (MS (r md)))]
-> [GenState (Maybe (CS (r Class)))]
-> GenState (FS (r File))
forall (r :: * -> *) vis smt md svr att prg.
OOProg r vis smt md svr att prg =>
String
-> String
-> [GenState (Maybe (MS (r md)))]
-> [GenState (Maybe (CS (r Class)))]
-> GenState (FS (r File))
genModule String
cname String
ipDesc [VisibilityTag -> GenState (Maybe (MS (r md)))
forall (r :: * -> *) vis smt md svr att prg.
OOProg r vis smt md svr att prg =>
VisibilityTag -> GenState (Maybe (MS (r md)))
genInputFormat VisibilityTag
Pub,
        VisibilityTag -> GenState (Maybe (MS (r md)))
forall (r :: * -> *) vis smt md svr att prg.
OOProg r vis smt md svr att prg =>
VisibilityTag -> GenState (Maybe (MS (r md)))
genInputDerived VisibilityTag
Pub, VisibilityTag -> GenState (Maybe (MS (r md)))
forall (r :: * -> *) vis smt md svr att prg.
OOProg r vis smt md svr att prg =>
VisibilityTag -> GenState (Maybe (MS (r md)))
genInputConstraints VisibilityTag
Pub] []
      genMod Maybe (CS (r Class))
_ = String
-> String
-> [GenState (Maybe (MS (r md)))]
-> [GenState (Maybe (CS (r Class)))]
-> GenState (FS (r File))
forall (r :: * -> *) vis smt md svr att prg.
OOProg r vis smt md svr att prg =>
String
-> String
-> [GenState (Maybe (MS (r md)))]
-> [GenState (Maybe (CS (r Class)))]
-> GenState (FS (r File))
genModule String
cname String
ipDesc [] [ClassType -> GenState (Maybe (CS (r Class)))
forall (r :: * -> *) vis smt md svr att prg.
OOProg r vis smt md svr att prg =>
ClassType -> GenState (Maybe (CS (r Class)))
genInputClass ClassType
Primary]
  Maybe (CS (r Class))
ic <- ClassType -> GenState (Maybe (CS (r Class)))
forall (r :: * -> *) vis smt md svr att prg.
OOProg r vis smt md svr att prg =>
ClassType -> GenState (Maybe (CS (r Class)))
genInputClass ClassType
Primary
  State DrasilState (FS (r File)) -> GenState [FS (r File)]
forall a b. State a b -> State a [b]
liftS (State DrasilState (FS (r File)) -> GenState [FS (r File)])
-> State DrasilState (FS (r File)) -> GenState [FS (r File)]
forall a b. (a -> b) -> a -> b
$ Maybe (CS (r Class)) -> State DrasilState (FS (r File))
forall (r :: * -> *) vis smt md svr att prg.
OOProg r vis smt md svr att prg =>
Maybe (CS (r Class)) -> GenState (FS (r File))
genMod Maybe (CS (r Class))
ic

-- | Returns a function for generating a state variable for a constant.
-- Either generates a declare-define statement for a regular state variable
-- (if user chose 'Var'),
-- or a declare-define statement for a constant variable (if user chose 'Const').
constVarFunc :: (StateVarSym r vis svr att) => ConstantRepr ->
  (SVariable r -> SValue r -> CSStateVar r svr)
constVarFunc :: forall (r :: * -> *) vis svr att.
StateVarSym r vis svr att =>
ConstantRepr -> SVariable r -> SValue r -> CSStateVar r svr
constVarFunc ConstantRepr
Var = r vis -> r att -> SVariable r -> SValue r -> CSStateVar r svr
forall (r :: * -> *) vis svr att.
StateVarSym r vis svr att =>
r vis -> r att -> SVariable r -> SValue r -> CSStateVar r svr
stateVarDef r vis
forall (r :: * -> *) vis. VisibilitySym r vis => r vis
public r att
forall (r :: * -> *) att. AttachmentSym r att => r att
instanceLevel
constVarFunc ConstantRepr
Const = r vis -> SVariable r -> SValue r -> CSStateVar r svr
forall (r :: * -> *) vis svr att.
StateVarSym r vis svr att =>
r vis -> SVariable r -> SValue r -> CSStateVar r svr
constVar r vis
forall (r :: * -> *) vis. VisibilitySym r vis => r vis
public

-- | Returns 'Nothing' if no inputs or constants are mapped to InputParameters in
-- the class definition map.
-- If any inputs or constants are defined in InputParameters, this generates
-- the InputParameters class containing the inputs and constants as state
-- variables. If the InputParameters constructor is also exported, then the
-- generated class also contains the input-related functions as private methods.
genInputClass
  :: (OOProg r vis smt md svr att prg)
  => ClassType -> GenState (Maybe (CS (r Class)))
genInputClass :: forall (r :: * -> *) vis smt md svr att prg.
OOProg r vis smt md svr att prg =>
ClassType -> GenState (Maybe (CS (r Class)))
genInputClass ClassType
scp = do
  DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  (DrasilState -> DrasilState) -> StateT DrasilState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\DrasilState
st -> DrasilState
st {currentScope = Local})
  String
cname <- InternalConcept -> GenState String
genICName InternalConcept
InputParameters
  let ins :: [CodeVarChunk]
ins = DrasilState
g DrasilState
-> Getting [CodeVarChunk] DrasilState [CodeVarChunk]
-> [CodeVarChunk]
forall s a. s -> Getting a s a -> a
^. Getting [CodeVarChunk] DrasilState [CodeVarChunk]
forall c. HasCodeSpec c => Lens' c [CodeVarChunk]
Lens' DrasilState [CodeVarChunk]
inputs
      cs :: [CodeDefinition]
cs = DrasilState
g DrasilState
-> Getting [CodeDefinition] DrasilState [CodeDefinition]
-> [CodeDefinition]
forall s a. s -> Getting a s a -> a
^. Getting [CodeDefinition] DrasilState [CodeDefinition]
forall c. HasCodeSpec c => Lens' c [CodeDefinition]
Lens' DrasilState [CodeDefinition]
constDefns
      filt :: (CodeIdea c) => [c] -> [c]
      filt :: forall c. CodeIdea c => [c] -> [c]
filt = (c -> Bool) -> [c] -> [c]
forall a. (a -> Bool) -> [a] -> [a]
filter ((String -> Maybe String
forall a. a -> Maybe a
Just String
cname Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
==) (Maybe String -> Bool) -> (c -> Maybe String) -> c -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Map String String -> Maybe String)
-> Map String String -> String -> Maybe String
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> Map String String -> Maybe String
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (DrasilState -> Map String String
clsMap DrasilState
g) (String -> Maybe String) -> (c -> String) -> c -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> String
forall c. CodeIdea c => c -> String
codeName)
      constructors :: (OOProg r vis smt md svr att prg) => GenState [MS (r md)]
      constructors :: forall (r :: * -> *) vis smt md svr att prg.
OOProg r vis smt md svr att prg =>
GenState [MS (r md)]
constructors = if String
cname String -> Set String -> Bool
forall a. Eq a => a -> Set a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` DrasilState -> Set String
defSet DrasilState
g
        then [[MS (r md)]] -> [MS (r md)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[MS (r md)]] -> [MS (r md)])
-> StateT DrasilState Identity [[MS (r md)]]
-> StateT DrasilState Identity [MS (r md)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (StateT DrasilState Identity (Maybe (MS (r md)))
 -> StateT DrasilState Identity [MS (r md)])
-> [StateT DrasilState Identity (Maybe (MS (r md)))]
-> StateT DrasilState Identity [[MS (r md)]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((Maybe (MS (r md)) -> [MS (r md)])
-> StateT DrasilState Identity (Maybe (MS (r md)))
-> StateT DrasilState Identity [MS (r md)]
forall a b.
(a -> b)
-> StateT DrasilState Identity a -> StateT DrasilState Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe (MS (r md)) -> [MS (r md)]
forall a. Maybe a -> [a]
maybeToList) [StateT DrasilState Identity (Maybe (MS (r md)))
forall (r :: * -> *) vis smt md svr att prg.
OOProg r vis smt md svr att prg =>
GenState (Maybe (MS (r md)))
genInputConstructor]
        else [MS (r md)] -> StateT DrasilState Identity [MS (r md)]
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return []
      methods :: (OOProg r vis smt md svr att prg) => GenState [MS (r md)]
      methods :: forall (r :: * -> *) vis smt md svr att prg.
OOProg r vis smt md svr att prg =>
GenState [MS (r md)]
methods = if String
cname String -> Set String -> Bool
forall a. Eq a => a -> Set a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` DrasilState -> Set String
defSet DrasilState
g
        then [[MS (r md)]] -> [MS (r md)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[MS (r md)]] -> [MS (r md)])
-> StateT DrasilState Identity [[MS (r md)]]
-> StateT DrasilState Identity [MS (r md)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (StateT DrasilState Identity (Maybe (MS (r md)))
 -> StateT DrasilState Identity [MS (r md)])
-> [StateT DrasilState Identity (Maybe (MS (r md)))]
-> StateT DrasilState Identity [[MS (r md)]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((Maybe (MS (r md)) -> [MS (r md)])
-> StateT DrasilState Identity (Maybe (MS (r md)))
-> StateT DrasilState Identity [MS (r md)]
forall a b.
(a -> b)
-> StateT DrasilState Identity a -> StateT DrasilState Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe (MS (r md)) -> [MS (r md)]
forall a. Maybe a -> [a]
maybeToList) [VisibilityTag -> StateT DrasilState Identity (Maybe (MS (r md)))
forall (r :: * -> *) vis smt md svr att prg.
OOProg r vis smt md svr att prg =>
VisibilityTag -> GenState (Maybe (MS (r md)))
genInputFormat VisibilityTag
Priv,
        VisibilityTag -> StateT DrasilState Identity (Maybe (MS (r md)))
forall (r :: * -> *) vis smt md svr att prg.
OOProg r vis smt md svr att prg =>
VisibilityTag -> GenState (Maybe (MS (r md)))
genInputDerived VisibilityTag
Priv, VisibilityTag -> StateT DrasilState Identity (Maybe (MS (r md)))
forall (r :: * -> *) vis smt md svr att prg.
OOProg r vis smt md svr att prg =>
VisibilityTag -> GenState (Maybe (MS (r md)))
genInputConstraints VisibilityTag
Priv]
        else [MS (r md)] -> StateT DrasilState Identity [MS (r md)]
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return []
      genClass
        :: (OOProg r vis smt md svr att prg)
        => [CodeVarChunk] -> [CodeDefinition] -> GenState (Maybe (CS (r Class)))
      genClass :: forall (r :: * -> *) vis smt md svr att prg.
OOProg r vis smt md svr att prg =>
[CodeVarChunk]
-> [CodeDefinition] -> GenState (Maybe (CS (r Class)))
genClass [] [] = Maybe (CS (r Class))
-> StateT DrasilState Identity (Maybe (CS (r Class)))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (CS (r Class))
forall a. Maybe a
Nothing
      genClass [CodeVarChunk]
inps [CodeDefinition]
csts = do
        [SValue r]
vals <- (CodeDefinition -> StateT DrasilState Identity (SValue r))
-> [CodeDefinition] -> StateT DrasilState Identity [SValue r]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (CodeExpr -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr (CodeExpr -> StateT DrasilState Identity (SValue r))
-> (CodeDefinition -> CodeExpr)
-> CodeDefinition
-> StateT DrasilState Identity (SValue 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
Lens' CodeDefinition CodeExpr
codeExpr)) [CodeDefinition]
csts
        [CSStateVar r svr]
inputVars <- (CodeVarChunk -> StateT DrasilState Identity (CSStateVar r svr))
-> [CodeVarChunk] -> StateT DrasilState Identity [CSStateVar r svr]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\CodeVarChunk
x -> (CodeType -> CSStateVar r svr)
-> StateT DrasilState Identity CodeType
-> StateT DrasilState Identity (CSStateVar r svr)
forall a b.
(a -> b)
-> StateT DrasilState Identity a -> StateT DrasilState Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SVariable r -> CSStateVar r svr
forall (r :: * -> *) vis svr att.
StateVarSym r vis svr att =>
SVariable r -> CSStateVar r svr
pubDVar (SVariable r -> CSStateVar r svr)
-> (CodeType -> SVariable r) -> CodeType -> CSStateVar r svr
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
          String -> VS (r TypeData) -> SVariable r
forall (r :: * -> *).
VariableSym r =>
String -> VS (r TypeData) -> SVariable r
var (CodeVarChunk -> String
forall c. CodeIdea c => c -> String
codeName CodeVarChunk
x) (VS (r TypeData) -> SVariable r)
-> (CodeType -> VS (r TypeData)) -> CodeType -> SVariable r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CodeType -> VS (r TypeData)
forall (r :: * -> *). OOTypeSym r => CodeType -> VS (r TypeData)
convTypeOO) (CodeVarChunk -> StateT DrasilState Identity CodeType
forall c. HasSpace c => c -> StateT DrasilState Identity CodeType
codeType CodeVarChunk
x)) [CodeVarChunk]
inps
        [CSStateVar r svr]
constVars <- (CodeDefinition
 -> SValue r -> StateT DrasilState Identity (CSStateVar r svr))
-> [CodeDefinition]
-> [SValue r]
-> StateT DrasilState Identity [CSStateVar r svr]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (\CodeDefinition
c SValue r
vl -> (CodeType -> CSStateVar r svr)
-> StateT DrasilState Identity CodeType
-> StateT DrasilState Identity (CSStateVar r svr)
forall a b.
(a -> b)
-> StateT DrasilState Identity a -> StateT DrasilState Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\CodeType
t -> ConstantRepr -> SVariable r -> SValue r -> CSStateVar r svr
forall (r :: * -> *) vis svr att.
StateVarSym r vis svr att =>
ConstantRepr -> SVariable r -> SValue r -> CSStateVar r svr
constVarFunc (DrasilState
g DrasilState
-> Getting ConstantRepr DrasilState ConstantRepr -> ConstantRepr
forall s a. s -> Getting a s a -> a
^. Getting ConstantRepr DrasilState ConstantRepr
forall a. HasChoices a => Lens' a ConstantRepr
Lens' DrasilState ConstantRepr
conRepr)
          (String -> VS (r TypeData) -> SVariable r
forall (r :: * -> *).
VariableSym r =>
String -> VS (r TypeData) -> SVariable r
var (CodeDefinition -> String
forall c. CodeIdea c => c -> String
codeName CodeDefinition
c) (CodeType -> VS (r TypeData)
forall (r :: * -> *). OOTypeSym r => CodeType -> VS (r TypeData)
convTypeOO CodeType
t)) SValue r
vl) (CodeDefinition -> StateT DrasilState Identity CodeType
forall c. HasSpace c => c -> StateT DrasilState Identity CodeType
codeType CodeDefinition
c))
          [CodeDefinition]
csts [SValue r]
vals
        let getFunc :: ClassType
-> String
-> Maybe String
-> String
-> [CSStateVar r svr]
-> GenState [MS (r md)]
-> GenState [MS (r md)]
-> GenState (CS (r Class))
getFunc ClassType
Primary = String
-> Maybe String
-> String
-> [CSStateVar r svr]
-> GenState [MS (r md)]
-> GenState [MS (r md)]
-> GenState (CS (r Class))
forall (r :: * -> *) vis smt md svr att.
ClassSym r vis smt md svr att =>
String
-> Maybe String
-> String
-> [CSStateVar r svr]
-> GenState [MS (r md)]
-> GenState [MS (r md)]
-> GenState (CS (r Class))
primaryClass
            getFunc ClassType
Auxiliary = String
-> Maybe String
-> String
-> [CSStateVar r svr]
-> GenState [MS (r md)]
-> GenState [MS (r md)]
-> GenState (CS (r Class))
forall (r :: * -> *) vis smt md svr att.
ClassSym r vis smt md svr att =>
String
-> Maybe String
-> String
-> [CSStateVar r svr]
-> GenState [MS (r md)]
-> GenState [MS (r md)]
-> GenState (CS (r Class))
auxClass
            f :: String
-> Maybe String
-> String
-> [CSStateVar r svr]
-> GenState [MS (r md)]
-> GenState [MS (r md)]
-> GenState (CS (r Class))
f = ClassType
-> String
-> Maybe String
-> String
-> [CSStateVar r svr]
-> GenState [MS (r md)]
-> GenState [MS (r md)]
-> GenState (CS (r Class))
forall {r :: * -> *} {vis} {smt} {md} {att} {svr}.
ClassSym r vis smt md svr att =>
ClassType
-> String
-> Maybe String
-> String
-> [CSStateVar r svr]
-> GenState [MS (r md)]
-> GenState [MS (r md)]
-> GenState (CS (r Class))
getFunc ClassType
scp
        String
icDesc <- GenState String
inputClassDesc
        CS (r Class)
c <- String
-> Maybe String
-> String
-> [CSStateVar r svr]
-> GenState [MS (r md)]
-> GenState [MS (r md)]
-> GenState (CS (r Class))
f String
cname Maybe String
forall a. Maybe a
Nothing String
icDesc ([CSStateVar r svr]
inputVars [CSStateVar r svr] -> [CSStateVar r svr] -> [CSStateVar r svr]
forall a. [a] -> [a] -> [a]
++ [CSStateVar r svr]
constVars) GenState [MS (r md)]
forall (r :: * -> *) vis smt md svr att prg.
OOProg r vis smt md svr att prg =>
GenState [MS (r md)]
constructors GenState [MS (r md)]
forall (r :: * -> *) vis smt md svr att prg.
OOProg r vis smt md svr att prg =>
GenState [MS (r md)]
methods
        Maybe (CS (r Class))
-> StateT DrasilState Identity (Maybe (CS (r Class)))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (CS (r Class))
 -> StateT DrasilState Identity (Maybe (CS (r Class))))
-> Maybe (CS (r Class))
-> StateT DrasilState Identity (Maybe (CS (r Class)))
forall a b. (a -> b) -> a -> b
$ CS (r Class) -> Maybe (CS (r Class))
forall a. a -> Maybe a
Just CS (r Class)
c
  [CodeVarChunk]
-> [CodeDefinition] -> GenState (Maybe (CS (r Class)))
forall (r :: * -> *) vis smt md svr att prg.
OOProg r vis smt md svr att prg =>
[CodeVarChunk]
-> [CodeDefinition] -> GenState (Maybe (CS (r Class)))
genClass ([CodeVarChunk] -> [CodeVarChunk]
forall c. CodeIdea c => [c] -> [c]
filt [CodeVarChunk]
ins) ([CodeDefinition] -> [CodeDefinition]
forall c. CodeIdea c => [c] -> [c]
filt [CodeDefinition]
cs)

-- | Generates a constructor for the input class, where the constructor calls the
-- input-related functions. Returns 'Nothing' if no input-related functions are
-- generated.
genInputConstructor :: (OOProg r vis smt md svr att prg) => GenState (Maybe (MS (r md)))
genInputConstructor :: forall (r :: * -> *) vis smt md svr att prg.
OOProg r vis smt md svr att prg =>
GenState (Maybe (MS (r md)))
genInputConstructor = do
  DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  String
ipName <- InternalConcept -> GenState String
genICName InternalConcept
InputParameters
  String
giName <- InternalConcept -> GenState String
genICName InternalConcept
GetInput
  String
dvName <- InternalConcept -> GenState String
genICName InternalConcept
DerivedValuesFn
  String
icName <- InternalConcept -> GenState String
genICName InternalConcept
InputConstraintsFn
  let ds :: Set String
ds = DrasilState -> Set String
defSet DrasilState
g
      genCtor :: Bool -> StateT DrasilState Identity (Maybe (MS (r md)))
genCtor Bool
False = Maybe (MS (r md))
-> StateT DrasilState Identity (Maybe (MS (r md)))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MS (r md))
forall a. Maybe a
Nothing
      genCtor Bool
True = do
        String
cdesc <- GenState String
inputConstructorDesc
        [CodeVarChunk]
cparams <- GenState [CodeVarChunk]
getInConstructorParams
        [MS (r smt)]
ics <- GenState [MS (r smt)]
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
GenState [MS (r smt)]
genAllInputCalls
        MS (r md)
ctor <- String
-> String
-> [ParameterChunk]
-> [MS (r Class)]
-> GenState (MS (r md))
forall (r :: * -> *) vis smt md svr att prg.
OOProg r vis smt md svr att prg =>
String
-> String
-> [ParameterChunk]
-> [MS (r Class)]
-> GenState (MS (r md))
genConstructor String
ipName String
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 smt)] -> MS (r Class)
forall (r :: * -> *) smt.
BlockSym r smt =>
[MS (r smt)] -> MS (r Class)
block [MS (r smt)]
ics]
        Maybe (MS (r md))
-> StateT DrasilState Identity (Maybe (MS (r md)))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MS (r md))
 -> StateT DrasilState Identity (Maybe (MS (r md))))
-> Maybe (MS (r md))
-> StateT DrasilState Identity (Maybe (MS (r md)))
forall a b. (a -> b) -> a -> b
$ MS (r md) -> Maybe (MS (r md))
forall a. a -> Maybe a
Just MS (r md)
ctor
  Bool -> GenState (Maybe (MS (r md)))
forall {r :: * -> *} {vis} {smt} {md} {svr} {att} {prg}.
OOProg r vis smt md svr att prg =>
Bool -> StateT DrasilState Identity (Maybe (MS (r md)))
genCtor (Bool -> GenState (Maybe (MS (r md))))
-> Bool -> GenState (Maybe (MS (r md)))
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String -> Set String -> Bool
forall a. Eq a => a -> Set a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Set String
ds) [String
giName,
    String
dvName, String
icName]

-- | Generates a function for calculating derived inputs.
genInputDerived
  :: (OOProg r vis smt md svr att prg)
  => VisibilityTag -> GenState (Maybe (MS (r md)))
genInputDerived :: forall (r :: * -> *) vis smt md svr att prg.
OOProg r vis smt md svr att prg =>
VisibilityTag -> GenState (Maybe (MS (r md)))
genInputDerived VisibilityTag
s = do
  DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  (DrasilState -> DrasilState) -> StateT DrasilState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\DrasilState
st -> DrasilState
st {currentScope = Local})
  String
dvName <- InternalConcept -> GenState String
genICName InternalConcept
DerivedValuesFn
  let dvals :: [CodeDefinition]
dvals = DrasilState
g DrasilState
-> Getting [CodeDefinition] DrasilState [CodeDefinition]
-> [CodeDefinition]
forall s a. s -> Getting a s a -> a
^. Getting [CodeDefinition] DrasilState [CodeDefinition]
forall c. HasCodeSpec c => Lens' c [CodeDefinition]
Lens' DrasilState [CodeDefinition]
derivedInputs
      getFunc :: VisibilityTag
-> String
-> String
-> [CodeVarChunk]
-> [CodeVarChunk]
-> [MS (r Class)]
-> GenState (MS (r md))
getFunc VisibilityTag
Pub = String
-> String
-> [CodeVarChunk]
-> [CodeVarChunk]
-> [MS (r Class)]
-> GenState (MS (r md))
forall (r :: * -> *) vis smt md svr att prg.
OOProg r vis smt md svr att prg =>
String
-> String
-> [CodeVarChunk]
-> [CodeVarChunk]
-> [MS (r Class)]
-> GenState (MS (r md))
publicInOutFunc
      getFunc VisibilityTag
Priv = String
-> String
-> [CodeVarChunk]
-> [CodeVarChunk]
-> [MS (r Class)]
-> GenState (MS (r md))
forall (r :: * -> *) vis smt md svr att prg.
OOProg r vis smt md svr att prg =>
String
-> String
-> [CodeVarChunk]
-> [CodeVarChunk]
-> [MS (r Class)]
-> GenState (MS (r md))
privateInOutMethod
      genDerived
        :: (OOProg r vis smt md svr att prg)
        => Bool -> GenState (Maybe (MS (r md)))
      genDerived :: forall {r :: * -> *} {vis} {smt} {md} {svr} {att} {prg}.
OOProg r vis smt md svr att prg =>
Bool -> StateT DrasilState Identity (Maybe (MS (r md)))
genDerived Bool
False = Maybe (MS (r md))
-> StateT DrasilState Identity (Maybe (MS (r md)))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MS (r md))
forall a. Maybe a
Nothing
      genDerived Bool
_ = do
        [CodeVarChunk]
ins <- GenState [CodeVarChunk]
getDerivedIns
        [CodeVarChunk]
outs <- GenState [CodeVarChunk]
getDerivedOuts
        [MS (r Class)]
bod <- (CodeDefinition -> StateT DrasilState Identity (MS (r Class)))
-> [CodeDefinition] -> StateT DrasilState Identity [MS (r Class)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\CodeDefinition
x -> CalcType
-> CodeDefinition
-> CodeExpr
-> StateT DrasilState Identity (MS (r Class))
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
CalcType -> CodeDefinition -> CodeExpr -> GenState (MS (r Class))
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
Lens' CodeDefinition CodeExpr
codeExpr)) [CodeDefinition]
dvals
        String
desc <- GenState String
dvFuncDesc
        MS (r md)
mthd <- VisibilityTag
-> String
-> String
-> [CodeVarChunk]
-> [CodeVarChunk]
-> [MS (r Class)]
-> GenState (MS (r md))
forall {r :: * -> *} {vis} {svr} {att} {smt} {md} {prg}.
OOProg r vis smt md svr att prg =>
VisibilityTag
-> String
-> String
-> [CodeVarChunk]
-> [CodeVarChunk]
-> [MS (r Class)]
-> GenState (MS (r md))
getFunc VisibilityTag
s String
dvName String
desc [CodeVarChunk]
ins [CodeVarChunk]
outs [MS (r Class)]
bod
        Maybe (MS (r md))
-> StateT DrasilState Identity (Maybe (MS (r md)))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MS (r md))
 -> StateT DrasilState Identity (Maybe (MS (r md))))
-> Maybe (MS (r md))
-> StateT DrasilState Identity (Maybe (MS (r md)))
forall a b. (a -> b) -> a -> b
$ MS (r md) -> Maybe (MS (r md))
forall a. a -> Maybe a
Just MS (r md)
mthd
  Bool -> GenState (Maybe (MS (r md)))
forall {r :: * -> *} {vis} {smt} {md} {svr} {att} {prg}.
OOProg r vis smt md svr att prg =>
Bool -> StateT DrasilState Identity (Maybe (MS (r md)))
genDerived (Bool -> GenState (Maybe (MS (r md))))
-> Bool -> GenState (Maybe (MS (r md)))
forall a b. (a -> b) -> a -> b
$ String
dvName String -> Set String -> Bool
forall a. Eq a => a -> Set a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` DrasilState -> Set String
defSet DrasilState
g

-- | Generates function that checks constraints on the input.
genInputConstraints
  :: (OOProg r vis smt md svr att prg)
  => VisibilityTag -> GenState (Maybe (MS (r md)))
genInputConstraints :: forall (r :: * -> *) vis smt md svr att prg.
OOProg r vis smt md svr att prg =>
VisibilityTag -> GenState (Maybe (MS (r md)))
genInputConstraints VisibilityTag
s = do
  DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  (DrasilState -> DrasilState) -> StateT DrasilState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\DrasilState
st -> DrasilState
st {currentScope = Local})
  String
icName <- InternalConcept -> GenState String
genICName InternalConcept
InputConstraintsFn
  let cm :: ConstraintCEMap
cm = DrasilState
g DrasilState
-> Getting ConstraintCEMap DrasilState ConstraintCEMap
-> ConstraintCEMap
forall s a. s -> Getting a s a -> a
^. Getting ConstraintCEMap DrasilState ConstraintCEMap
forall c. HasCodeSpec c => Lens' c ConstraintCEMap
Lens' DrasilState ConstraintCEMap
cMap
      getFunc :: VisibilityTag
-> String
-> VS (r TypeData)
-> String
-> [ParameterChunk]
-> Maybe String
-> [MS (r Class)]
-> GenState (MS (r md))
getFunc VisibilityTag
Pub = String
-> VS (r TypeData)
-> String
-> [ParameterChunk]
-> Maybe String
-> [MS (r Class)]
-> GenState (MS (r md))
forall (r :: * -> *) vis smt md svr att prg.
OOProg r vis smt md svr att prg =>
String
-> VS (r TypeData)
-> String
-> [ParameterChunk]
-> Maybe String
-> [MS (r Class)]
-> GenState (MS (r md))
publicFunc
      getFunc VisibilityTag
Priv = String
-> VS (r TypeData)
-> String
-> [ParameterChunk]
-> Maybe String
-> [MS (r Class)]
-> GenState (MS (r md))
forall (r :: * -> *) vis smt md svr att prg.
OOProg r vis smt md svr att prg =>
String
-> VS (r TypeData)
-> String
-> [ParameterChunk]
-> Maybe String
-> [MS (r Class)]
-> GenState (MS (r md))
privateMethod
      genConstraints
        :: (OOProg r vis smt md svr att prg)
        => Bool -> GenState (Maybe (MS (r md)))
      genConstraints :: forall {r :: * -> *} {vis} {smt} {md} {svr} {att} {prg}.
OOProg r vis smt md svr att prg =>
Bool -> StateT DrasilState Identity (Maybe (MS (r md)))
genConstraints Bool
False = Maybe (MS (r md))
-> StateT DrasilState Identity (Maybe (MS (r md)))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MS (r md))
forall a. Maybe a
Nothing
      genConstraints Bool
_ = do
        [CodeVarChunk]
parms <- GenState [CodeVarChunk]
getConstraintParams
        let varsList :: [CodeVarChunk]
varsList = (CodeVarChunk -> Bool) -> [CodeVarChunk] -> [CodeVarChunk]
forall a. (a -> Bool) -> [a] -> [a]
filter (\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 => Getter c UID
Getter CodeVarChunk UID
uid) ConstraintCEMap
cm) (DrasilState
g DrasilState
-> Getting [CodeVarChunk] DrasilState [CodeVarChunk]
-> [CodeVarChunk]
forall s a. s -> Getting a s a -> a
^. Getting [CodeVarChunk] DrasilState [CodeVarChunk]
forall c. HasCodeSpec c => Lens' c [CodeVarChunk]
Lens' DrasilState [CodeVarChunk]
inputs)
            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 smt)]
sf <- [(CodeVarChunk, [ConstraintCE])] -> GenState [MS (r smt)]
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
[(CodeVarChunk, [ConstraintCE])] -> GenState [MS (r smt)]
sfwrCBody [(CodeVarChunk, [ConstraintCE])]
sfwrCs
        [MS (r smt)]
ph <- [(CodeVarChunk, [ConstraintCE])] -> GenState [MS (r smt)]
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
[(CodeVarChunk, [ConstraintCE])] -> GenState [MS (r smt)]
physCBody [(CodeVarChunk, [ConstraintCE])]
physCs
        String
desc <- GenState String
inConsFuncDesc
        MS (r md)
mthd <- VisibilityTag
-> String
-> VS (r TypeData)
-> String
-> [ParameterChunk]
-> Maybe String
-> [MS (r Class)]
-> GenState (MS (r md))
forall {r :: * -> *} {vis} {svr} {att} {smt} {md} {prg}.
OOProg r vis smt md svr att prg =>
VisibilityTag
-> String
-> VS (r TypeData)
-> String
-> [ParameterChunk]
-> Maybe String
-> [MS (r Class)]
-> GenState (MS (r md))
getFunc VisibilityTag
s String
icName VS (r TypeData)
forall (r :: * -> *). TypeSym r => VS (r TypeData)
void String
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 String
forall a. Maybe a
Nothing [[MS (r smt)] -> MS (r Class)
forall (r :: * -> *) smt.
BlockSym r smt =>
[MS (r smt)] -> MS (r Class)
block [MS (r smt)]
sf, [MS (r smt)] -> MS (r Class)
forall (r :: * -> *) smt.
BlockSym r smt =>
[MS (r smt)] -> MS (r Class)
block [MS (r smt)]
ph]
        Maybe (MS (r md))
-> StateT DrasilState Identity (Maybe (MS (r md)))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MS (r md))
 -> StateT DrasilState Identity (Maybe (MS (r md))))
-> Maybe (MS (r md))
-> StateT DrasilState Identity (Maybe (MS (r md)))
forall a b. (a -> b) -> a -> b
$ MS (r md) -> Maybe (MS (r md))
forall a. a -> Maybe a
Just MS (r md)
mthd
  Bool -> GenState (Maybe (MS (r md)))
forall {r :: * -> *} {vis} {smt} {md} {svr} {att} {prg}.
OOProg r vis smt md svr att prg =>
Bool -> StateT DrasilState Identity (Maybe (MS (r md)))
genConstraints (Bool -> GenState (Maybe (MS (r md))))
-> Bool -> GenState (Maybe (MS (r md)))
forall a b. (a -> b) -> a -> b
$ String
icName String -> Set String -> Bool
forall a. Eq a => a -> Set a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` DrasilState -> Set String
defSet DrasilState
g

-- | Generates input constraints code block for checking software constraints.
sfwrCBody
  :: (OOStatement r smt, TypeElim r, VariableElim r)
  => [(CodeVarChunk, [ConstraintCE])] -> GenState [MS (r smt)]
sfwrCBody :: forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
[(CodeVarChunk, [ConstraintCE])] -> GenState [MS (r smt)]
sfwrCBody [(CodeVarChunk, [ConstraintCE])]
cs = do
  DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  let cb :: ConstraintBehaviour
cb = DrasilState
g DrasilState
-> Getting ConstraintBehaviour DrasilState ConstraintBehaviour
-> ConstraintBehaviour
forall s a. s -> Getting a s a -> a
^. Getting ConstraintBehaviour DrasilState ConstraintBehaviour
forall a. HasChoices a => Lens' a ConstraintBehaviour
Lens' DrasilState ConstraintBehaviour
onSfwrC
  ConstraintBehaviour
-> [(CodeVarChunk, [ConstraintCE])] -> GenState [MS (r smt)]
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
ConstraintBehaviour
-> [(CodeVarChunk, [ConstraintCE])] -> GenState [MS (r smt)]
chooseConstr ConstraintBehaviour
cb [(CodeVarChunk, [ConstraintCE])]
cs

-- | Generates input constraints code block for checking physical constraints.
physCBody
  :: (OOStatement r smt, TypeElim r, VariableElim r)
  => [(CodeVarChunk, [ConstraintCE])] -> GenState [MS (r smt)]
physCBody :: forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
[(CodeVarChunk, [ConstraintCE])] -> GenState [MS (r smt)]
physCBody [(CodeVarChunk, [ConstraintCE])]
cs = do
  DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  let cb :: ConstraintBehaviour
cb = DrasilState
g DrasilState
-> Getting ConstraintBehaviour DrasilState ConstraintBehaviour
-> ConstraintBehaviour
forall s a. s -> Getting a s a -> a
^. Getting ConstraintBehaviour DrasilState ConstraintBehaviour
forall a. HasChoices a => Lens' a ConstraintBehaviour
Lens' DrasilState ConstraintBehaviour
onPhysC
  ConstraintBehaviour
-> [(CodeVarChunk, [ConstraintCE])] -> GenState [MS (r smt)]
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
ConstraintBehaviour
-> [(CodeVarChunk, [ConstraintCE])] -> GenState [MS (r smt)]
chooseConstr ConstraintBehaviour
cb [(CodeVarChunk, [ConstraintCE])]
cs

-- | Generates conditional statements for checking constraints, where the
-- bodies depend on user's choice of constraint violation behaviour.
chooseConstr
  :: (OOStatement r smt, TypeElim r, VariableElim r)
  => ConstraintBehaviour
  -> [(CodeVarChunk, [ConstraintCE])]
  -> GenState [MS (r smt)]
chooseConstr :: forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
ConstraintBehaviour
-> [(CodeVarChunk, [ConstraintCE])] -> GenState [MS (r smt)]
chooseConstr ConstraintBehaviour
cb [(CodeVarChunk, [ConstraintCE])]
cs = do
  let ch :: [(CodeVarChunk, ConstraintCE)]
ch = ((CodeVarChunk, [ConstraintCE]) -> [(CodeVarChunk, ConstraintCE)])
-> [(CodeVarChunk, [ConstraintCE])]
-> [(CodeVarChunk, ConstraintCE)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(CodeVarChunk
s, [ConstraintCE]
ns) -> [(CodeVarChunk
s, ConstraintCE
n) | ConstraintCE
n <- [ConstraintCE]
ns]) [(CodeVarChunk, [ConstraintCE])]
cs
  -- Generate variable declarations based on constraints
  [MS (r smt)]
varDecs <- ((CodeVarChunk, ConstraintCE)
 -> StateT DrasilState Identity (MS (r smt)))
-> [(CodeVarChunk, ConstraintCE)] -> GenState [MS (r smt)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\case
    (CodeVarChunk
q, Elem ConstraintReason
_ CodeExpr
e) -> CodeVarChunk
-> CodeExpr -> StateT DrasilState Identity (MS (r smt))
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
CodeVarChunk -> CodeExpr -> GenState (MS (r smt))
constrVarDec CodeVarChunk
q CodeExpr
e
    (CodeVarChunk, ConstraintCE)
_             -> MS (r smt) -> StateT DrasilState Identity (MS (r smt))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return MS (r smt)
forall (r :: * -> *) smt. StatementSym r smt => MS (r smt)
emptyStmt) [(CodeVarChunk, ConstraintCE)]
ch
  -- Generate conditions for constraints
  [[SValue r]]
conds <- ((CodeVarChunk, [ConstraintCE])
 -> StateT DrasilState Identity [SValue r])
-> [(CodeVarChunk, [ConstraintCE])]
-> StateT DrasilState Identity [[SValue r]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\(CodeVarChunk
q,[ConstraintCE]
cns) -> (ConstraintCE -> StateT DrasilState Identity (SValue r))
-> [ConstraintCE] -> StateT DrasilState Identity [SValue r]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (CodeExpr -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr (CodeExpr -> StateT DrasilState Identity (SValue r))
-> (ConstraintCE -> CodeExpr)
-> ConstraintCE
-> StateT DrasilState Identity (SValue r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CodeVarChunk -> ConstraintCE -> CodeExpr
forall c. (IsChunk c, HasSymbol c) => c -> ConstraintCE -> CodeExpr
renderC CodeVarChunk
q) [ConstraintCE]
cns) [(CodeVarChunk, [ConstraintCE])]
cs
  -- Generate bodies based on constraint behavior
  [[MS (r Class)]]
bods <- ((CodeVarChunk, [ConstraintCE])
 -> StateT DrasilState Identity [MS (r Class)])
-> [(CodeVarChunk, [ConstraintCE])]
-> StateT DrasilState Identity [[MS (r Class)]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ConstraintBehaviour
-> (CodeVarChunk, [ConstraintCE])
-> StateT DrasilState Identity [MS (r Class)]
forall {r :: * -> *} {smt}.
(OOStatement r smt, VariableElim r, TypeElim r) =>
ConstraintBehaviour
-> (CodeVarChunk, [ConstraintCE]) -> GenState [MS (r Class)]
chooseCB ConstraintBehaviour
cb) [(CodeVarChunk, [ConstraintCE])]
cs
  let bodies :: [MS (r smt)]
bodies = [[MS (r smt)]] -> [MS (r smt)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[MS (r smt)]] -> [MS (r smt)]) -> [[MS (r smt)]] -> [MS (r smt)]
forall a b. (a -> b) -> a -> b
$ ([SValue r] -> [MS (r Class)] -> [MS (r smt)])
-> [[SValue r]] -> [[MS (r Class)]] -> [[MS (r smt)]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ((SValue r -> MS (r Class) -> MS (r smt))
-> [SValue r] -> [MS (r Class)] -> [MS (r smt)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\SValue r
cond MS (r Class)
bod -> [(SValue r, MS (r Class))] -> MS (r smt)
forall (r :: * -> *) smt.
ControlStatement r smt =>
[(SValue r, MS (r Class))] -> MS (r smt)
ifNoElse [(SValue r -> SValue r
forall (r :: * -> *). BooleanExpression r => SValue r -> SValue r
(?!) SValue r
cond, MS (r Class)
bod)])) [[SValue r]]
conds [[MS (r Class)]]
bods
  [MS (r smt)] -> GenState [MS (r smt)]
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([MS (r smt)] -> GenState [MS (r smt)])
-> [MS (r smt)] -> GenState [MS (r smt)]
forall a b. (a -> b) -> a -> b
$ [MS (r smt)] -> [MS (r smt)] -> [MS (r smt)]
forall a. [a] -> [a] -> [a]
interleave [MS (r smt)]
varDecs [MS (r smt)]
bodies
  where chooseCB :: ConstraintBehaviour
-> (CodeVarChunk, [ConstraintCE]) -> GenState [MS (r Class)]
chooseCB ConstraintBehaviour
Warning = (CodeVarChunk, [ConstraintCE]) -> GenState [MS (r Class)]
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
(CodeVarChunk, [ConstraintCE]) -> GenState [MS (r Class)]
constrWarn
        chooseCB ConstraintBehaviour
Exception = (CodeVarChunk, [ConstraintCE]) -> GenState [MS (r Class)]
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
(CodeVarChunk, [ConstraintCE]) -> GenState [MS (r Class)]
constrExc

-- | Generates body defining constraint violation behaviour if Warning chosen from 'chooseConstr'.
-- Prints a \"Warning\" message followed by a message that says
-- what value was \"suggested\".
constrWarn
  :: (OOStatement r smt, TypeElim r, VariableElim r)
  => (CodeVarChunk, [ConstraintCE]) -> GenState [MS (r Body)]
constrWarn :: forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
(CodeVarChunk, [ConstraintCE]) -> GenState [MS (r Class)]
constrWarn (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 smt)]]
msgs <- (ConstraintCE -> StateT DrasilState Identity [MS (r smt)])
-> [ConstraintCE] -> StateT DrasilState Identity [[MS (r smt)]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (CodeVarChunk
-> String
-> ConstraintCE
-> StateT DrasilState Identity [MS (r smt)]
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
CodeVarChunk -> String -> ConstraintCE -> GenState [MS (r smt)]
constraintViolatedMsg CodeVarChunk
q String
"suggested") [ConstraintCE]
cs
  [MS (r Class)] -> GenState [MS (r Class)]
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([MS (r Class)] -> GenState [MS (r Class)])
-> [MS (r Class)] -> GenState [MS (r Class)]
forall a b. (a -> b) -> a -> b
$ ([MS (r smt)] -> MS (r Class)) -> [[MS (r smt)]] -> [MS (r Class)]
forall a b. (a -> b) -> [a] -> [b]
map ([MS (r smt)] -> MS (r Class)
forall (r :: * -> *) smt.
BodySym r smt =>
[MS (r smt)] -> MS (r Class)
bodyStatements ([MS (r smt)] -> MS (r Class))
-> ([MS (r smt)] -> [MS (r smt)]) -> [MS (r smt)] -> MS (r Class)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> MS (r smt)
forall (r :: * -> *) smt. IOStatement r smt => String -> MS (r smt)
printStr String
"Warning: " MS (r smt) -> [MS (r smt)] -> [MS (r smt)]
forall a. a -> [a] -> [a]
:)) [[MS (r smt)]]
msgs

-- | Generates body defining constraint violation behaviour if Exception chosen from 'chooseConstr'.
-- Prints a message that says what value was \"expected\",
-- followed by throwing an exception.
constrExc
  :: (OOStatement r smt, TypeElim r, VariableElim r)
  => (CodeVarChunk, [ConstraintCE]) -> GenState [MS (r Body)]
constrExc :: forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
(CodeVarChunk, [ConstraintCE]) -> GenState [MS (r Class)]
constrExc (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 smt)]]
msgs <- (ConstraintCE -> StateT DrasilState Identity [MS (r smt)])
-> [ConstraintCE] -> StateT DrasilState Identity [[MS (r smt)]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (CodeVarChunk
-> String
-> ConstraintCE
-> StateT DrasilState Identity [MS (r smt)]
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
CodeVarChunk -> String -> ConstraintCE -> GenState [MS (r smt)]
constraintViolatedMsg CodeVarChunk
q String
"expected") [ConstraintCE]
cs
  [MS (r Class)] -> GenState [MS (r Class)]
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([MS (r Class)] -> GenState [MS (r Class)])
-> [MS (r Class)] -> GenState [MS (r Class)]
forall a b. (a -> b) -> a -> b
$ ([MS (r smt)] -> MS (r Class)) -> [[MS (r smt)]] -> [MS (r Class)]
forall a b. (a -> b) -> [a] -> [b]
map ([MS (r smt)] -> MS (r Class)
forall (r :: * -> *) smt.
BodySym r smt =>
[MS (r smt)] -> MS (r Class)
bodyStatements ([MS (r smt)] -> MS (r Class))
-> ([MS (r smt)] -> [MS (r smt)]) -> [MS (r smt)] -> MS (r Class)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([MS (r smt)] -> [MS (r smt)] -> [MS (r smt)]
forall a. [a] -> [a] -> [a]
++ [String -> MS (r smt)
forall (r :: * -> *) smt.
ControlStatement r smt =>
String -> MS (r smt)
throw String
"InputError"])) [[MS (r smt)]]
msgs

-- | Generates set variable dec
constrVarDec
  :: (OOStatement r smt, TypeElim r, VariableElim r)
  => CodeVarChunk -> CodeExpr -> GenState (MS (r smt))
constrVarDec :: forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
CodeVarChunk -> CodeExpr -> GenState (MS (r smt))
constrVarDec CodeVarChunk
v CodeExpr
e = do
  SValue r
lb <- CodeExpr -> GenState (SValue r)
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr CodeExpr
e
  CodeType
t <- CodeVarChunk -> StateT DrasilState Identity CodeType
forall c. HasSpace c => c -> StateT DrasilState Identity CodeType
codeType CodeVarChunk
v
  let mkValue :: SVariable r
mkValue = String -> VS (r TypeData) -> SVariable r
forall (r :: * -> *).
VariableSym r =>
String -> VS (r TypeData) -> SVariable r
var (String
"set_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ CodeVarChunk -> String
forall x. HasSymbol x => x -> String
showHasSymbImpl CodeVarChunk
v) (VS (r TypeData) -> VS (r TypeData)
forall (r :: * -> *).
TypeSym r =>
VS (r TypeData) -> VS (r TypeData)
setType (CodeType -> VS (r TypeData)
forall (r :: * -> *). TypeSym r => CodeType -> VS (r TypeData)
convType CodeType
t))
  MS (r smt) -> GenState (MS (r smt))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (SVariable r -> r ScopeData -> SValue r -> MS (r smt)
forall (r :: * -> *) smt.
DeclStatement r smt =>
SVariable r -> r ScopeData -> SValue r -> MS (r smt)
setDecDef SVariable r
mkValue r ScopeData
forall (r :: * -> *). ScopeSym r => r ScopeData
local SValue r
lb)

-- | Generates statements that print a message for when a constraint is violated.
-- Message includes the name of the cosntraint quantity, its value, and a
-- description of the constraint that is violated.
constraintViolatedMsg
  :: (OOStatement r smt, TypeElim r, VariableElim r)
  => CodeVarChunk -> String -> ConstraintCE -> GenState [MS (r smt)]
constraintViolatedMsg :: forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
CodeVarChunk -> String -> ConstraintCE -> GenState [MS (r smt)]
constraintViolatedMsg CodeVarChunk
q String
s ConstraintCE
c = do
  [MS (r smt)]
pc <- String -> ConstraintCE -> GenState [MS (r smt)]
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
String -> ConstraintCE -> GenState [MS (r smt)]
printConstraint (CodeVarChunk -> String
forall x. HasSymbol x => x -> String
showHasSymbImpl CodeVarChunk
q) ConstraintCE
c
  SValue r
v <- CodeVarChunk -> GenState (SValue r)
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
CodeVarChunk -> GenState (SValue r)
mkVal (CodeVarChunk -> CodeVarChunk
forall c.
(Quantity c, MayHaveUnit c, Concept c) =>
c -> CodeVarChunk
quantvar CodeVarChunk
q)
  [MS (r smt)] -> GenState [MS (r smt)]
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([MS (r smt)] -> GenState [MS (r smt)])
-> [MS (r smt)] -> GenState [MS (r smt)]
forall a b. (a -> b) -> a -> b
$ [String -> MS (r smt)
forall (r :: * -> *) smt. IOStatement r smt => String -> MS (r smt)
printStr (String -> MS (r smt)) -> String -> MS (r smt)
forall a b. (a -> b) -> a -> b
$ CodeVarChunk -> String
forall c. CodeIdea c => c -> String
codeName CodeVarChunk
q String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" has value ",
    SValue r -> MS (r smt)
forall (r :: * -> *) smt.
IOStatement r smt =>
SValue r -> MS (r smt)
print SValue r
v,
    String -> MS (r smt)
forall (r :: * -> *) smt. IOStatement r smt => String -> MS (r smt)
printStr (String -> MS (r smt)) -> String -> MS (r smt)
forall a b. (a -> b) -> a -> b
$ String
", but is " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" to be "] [MS (r smt)] -> [MS (r smt)] -> [MS (r smt)]
forall a. [a] -> [a] -> [a]
++ [MS (r smt)]
pc

-- | Generates statements to print descriptions of constraints, using words and
-- the constrained values. Constrained values are followed by printing the
-- expression they originated from, using printExpr.
printConstraint
  :: (OOStatement r smt, TypeElim r, VariableElim r)
  => String -> ConstraintCE -> GenState [MS (r smt)]
printConstraint :: forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
String -> ConstraintCE -> GenState [MS (r smt)]
printConstraint String
v ConstraintCE
c = do
  DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  let db :: PrintingInformation
db = DrasilState -> PrintingInformation
printfo DrasilState
g
      printConstraint'
        :: (OOStatement r smt, TypeElim r, VariableElim r)
        => String -> ConstraintCE -> GenState [MS (r smt)]
      printConstraint' :: forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
String -> ConstraintCE -> GenState [MS (r smt)]
printConstraint' String
_ (Range ConstraintReason
_ (Bounded (Inclusive
_, CodeExpr
e1) (Inclusive
_, CodeExpr
e2))) = do
        SValue r
lb <- CodeExpr -> GenState (SValue r)
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr CodeExpr
e1
        SValue r
ub <- CodeExpr -> GenState (SValue r)
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr CodeExpr
e2
        [MS (r smt)] -> GenState [MS (r smt)]
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([MS (r smt)] -> GenState [MS (r smt)])
-> [MS (r smt)] -> GenState [MS (r smt)]
forall a b. (a -> b) -> a -> b
$ [String -> MS (r smt)
forall (r :: * -> *) smt. IOStatement r smt => String -> MS (r smt)
printStr String
"between ", SValue r -> MS (r smt)
forall (r :: * -> *) smt.
IOStatement r smt =>
SValue r -> MS (r smt)
print SValue r
lb] [MS (r smt)] -> [MS (r smt)] -> [MS (r smt)]
forall a. [a] -> [a] -> [a]
++ CodeExpr -> PrintingInformation -> [MS (r smt)]
forall (r :: * -> *) smt.
IOStatement r smt =>
CodeExpr -> PrintingInformation -> [MS (r smt)]
printExpr CodeExpr
e1 PrintingInformation
db [MS (r smt)] -> [MS (r smt)] -> [MS (r smt)]
forall a. [a] -> [a] -> [a]
++
          [String -> MS (r smt)
forall (r :: * -> *) smt. IOStatement r smt => String -> MS (r smt)
printStr String
" and ", SValue r -> MS (r smt)
forall (r :: * -> *) smt.
IOStatement r smt =>
SValue r -> MS (r smt)
print SValue r
ub] [MS (r smt)] -> [MS (r smt)] -> [MS (r smt)]
forall a. [a] -> [a] -> [a]
++ CodeExpr -> PrintingInformation -> [MS (r smt)]
forall (r :: * -> *) smt.
IOStatement r smt =>
CodeExpr -> PrintingInformation -> [MS (r smt)]
printExpr CodeExpr
e2 PrintingInformation
db [MS (r smt)] -> [MS (r smt)] -> [MS (r smt)]
forall a. [a] -> [a] -> [a]
++ [String -> MS (r smt)
forall (r :: * -> *) smt. IOStatement r smt => String -> MS (r smt)
printStrLn String
"."]
      printConstraint' String
_ (Range ConstraintReason
_ (UpTo (Inclusive
_, CodeExpr
e))) = do
        SValue r
ub <- CodeExpr -> GenState (SValue r)
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr CodeExpr
e
        [MS (r smt)] -> GenState [MS (r smt)]
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([MS (r smt)] -> GenState [MS (r smt)])
-> [MS (r smt)] -> GenState [MS (r smt)]
forall a b. (a -> b) -> a -> b
$ [String -> MS (r smt)
forall (r :: * -> *) smt. IOStatement r smt => String -> MS (r smt)
printStr String
"below ", SValue r -> MS (r smt)
forall (r :: * -> *) smt.
IOStatement r smt =>
SValue r -> MS (r smt)
print SValue r
ub] [MS (r smt)] -> [MS (r smt)] -> [MS (r smt)]
forall a. [a] -> [a] -> [a]
++ CodeExpr -> PrintingInformation -> [MS (r smt)]
forall (r :: * -> *) smt.
IOStatement r smt =>
CodeExpr -> PrintingInformation -> [MS (r smt)]
printExpr CodeExpr
e PrintingInformation
db [MS (r smt)] -> [MS (r smt)] -> [MS (r smt)]
forall a. [a] -> [a] -> [a]
++
          [String -> MS (r smt)
forall (r :: * -> *) smt. IOStatement r smt => String -> MS (r smt)
printStrLn String
"."]
      printConstraint' String
_ (Range ConstraintReason
_ (UpFrom (Inclusive
_, CodeExpr
e))) = do
        SValue r
lb <- CodeExpr -> GenState (SValue r)
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr CodeExpr
e
        [MS (r smt)] -> GenState [MS (r smt)]
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([MS (r smt)] -> GenState [MS (r smt)])
-> [MS (r smt)] -> GenState [MS (r smt)]
forall a b. (a -> b) -> a -> b
$ [String -> MS (r smt)
forall (r :: * -> *) smt. IOStatement r smt => String -> MS (r smt)
printStr String
"above ", SValue r -> MS (r smt)
forall (r :: * -> *) smt.
IOStatement r smt =>
SValue r -> MS (r smt)
print SValue r
lb] [MS (r smt)] -> [MS (r smt)] -> [MS (r smt)]
forall a. [a] -> [a] -> [a]
++ CodeExpr -> PrintingInformation -> [MS (r smt)]
forall (r :: * -> *) smt.
IOStatement r smt =>
CodeExpr -> PrintingInformation -> [MS (r smt)]
printExpr CodeExpr
e PrintingInformation
db [MS (r smt)] -> [MS (r smt)] -> [MS (r smt)]
forall a. [a] -> [a] -> [a]
++ [String -> MS (r smt)
forall (r :: * -> *) smt. IOStatement r smt => String -> MS (r smt)
printStrLn String
"."]
      printConstraint' String
name (Elem ConstraintReason
_ CodeExpr
e) = do
        SValue r
lb <- CodeExpr -> GenState (SValue r)
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr (String -> CodeExpr -> CodeExpr
Variable (String
"set_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name) CodeExpr
e)
        [MS (r smt)] -> GenState [MS (r smt)]
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([MS (r smt)] -> GenState [MS (r smt)])
-> [MS (r smt)] -> GenState [MS (r smt)]
forall a b. (a -> b) -> a -> b
$ [String -> MS (r smt)
forall (r :: * -> *) smt. IOStatement r smt => String -> MS (r smt)
printStr String
"an element of the set ", SValue r -> MS (r smt)
forall (r :: * -> *) smt.
IOStatement r smt =>
SValue r -> MS (r smt)
print SValue r
lb] [MS (r smt)] -> [MS (r smt)] -> [MS (r smt)]
forall a. [a] -> [a] -> [a]
++ [String -> MS (r smt)
forall (r :: * -> *) smt. IOStatement r smt => String -> MS (r smt)
printStrLn String
"."]
  String -> ConstraintCE -> GenState [MS (r smt)]
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
String -> ConstraintCE -> GenState [MS (r smt)]
printConstraint' String
v ConstraintCE
c

-- | Don't print expressions that are just literals, because that would be
-- redundant (the values are already printed by printConstraint).
-- If expression is more than just a literal, print it in parentheses.
printExpr :: (IOStatement r smt) => CodeExpr -> PrintingInformation -> [MS (r smt)]
printExpr :: forall (r :: * -> *) smt.
IOStatement r smt =>
CodeExpr -> PrintingInformation -> [MS (r smt)]
printExpr Lit{} PrintingInformation
_     = []
printExpr CodeExpr
e     PrintingInformation
pinfo = [String -> MS (r smt)
forall (r :: * -> *) smt. IOStatement r smt => String -> MS (r smt)
printStr (String -> MS (r smt)) -> String -> MS (r smt)
forall a b. (a -> b) -> a -> b
$ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Class -> String
render (Class -> Class
parens (PrintingInformation -> CodeExpr -> Class
oneLineCodeExprDoc PrintingInformation
pinfo CodeExpr
e))]

-- | | Generates a function for reading inputs from a file.
genInputFormat
  :: (OOProg r vis smt md svr att prg)
  => VisibilityTag -> GenState (Maybe (MS (r md)))
genInputFormat :: forall (r :: * -> *) vis smt md svr att prg.
OOProg r vis smt md svr att prg =>
VisibilityTag -> GenState (Maybe (MS (r md)))
genInputFormat VisibilityTag
s = do
  DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  (DrasilState -> DrasilState) -> StateT DrasilState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\DrasilState
st -> DrasilState
st {currentScope = Local})
  DataDesc
dd <- GenState DataDesc
genDataDesc
  String
giName <- InternalConcept -> GenState String
genICName InternalConcept
GetInput
  let getFunc :: VisibilityTag
-> String
-> String
-> [CodeVarChunk]
-> [CodeVarChunk]
-> [MS (r Class)]
-> GenState (MS (r md))
getFunc VisibilityTag
Pub = String
-> String
-> [CodeVarChunk]
-> [CodeVarChunk]
-> [MS (r Class)]
-> GenState (MS (r md))
forall (r :: * -> *) vis smt md svr att prg.
OOProg r vis smt md svr att prg =>
String
-> String
-> [CodeVarChunk]
-> [CodeVarChunk]
-> [MS (r Class)]
-> GenState (MS (r md))
publicInOutFunc
      getFunc VisibilityTag
Priv = String
-> String
-> [CodeVarChunk]
-> [CodeVarChunk]
-> [MS (r Class)]
-> GenState (MS (r md))
forall (r :: * -> *) vis smt md svr att prg.
OOProg r vis smt md svr att prg =>
String
-> String
-> [CodeVarChunk]
-> [CodeVarChunk]
-> [MS (r Class)]
-> GenState (MS (r md))
privateInOutMethod
      genInFormat
        :: (OOProg r vis smt md svr att prg)
        => Bool -> GenState (Maybe (MS (r md)))
      genInFormat :: forall {r :: * -> *} {vis} {smt} {md} {svr} {att} {prg}.
OOProg r vis smt md svr att prg =>
Bool -> StateT DrasilState Identity (Maybe (MS (r md)))
genInFormat Bool
False = Maybe (MS (r md))
-> StateT DrasilState Identity (Maybe (MS (r md)))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MS (r md))
forall a. Maybe a
Nothing
      genInFormat Bool
_ = do
        [CodeVarChunk]
ins <- GenState [CodeVarChunk]
getInputFormatIns
        [CodeVarChunk]
outs <- GenState [CodeVarChunk]
getInputFormatOuts
        [MS (r Class)]
bod <- DataDesc -> GenState [MS (r Class)]
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
DataDesc -> GenState [MS (r Class)]
readData DataDesc
dd
        String
desc <- GenState String
inFmtFuncDesc
        MS (r md)
mthd <- VisibilityTag
-> String
-> String
-> [CodeVarChunk]
-> [CodeVarChunk]
-> [MS (r Class)]
-> GenState (MS (r md))
forall {r :: * -> *} {vis} {svr} {att} {smt} {md} {prg}.
OOProg r vis smt md svr att prg =>
VisibilityTag
-> String
-> String
-> [CodeVarChunk]
-> [CodeVarChunk]
-> [MS (r Class)]
-> GenState (MS (r md))
getFunc VisibilityTag
s String
giName String
desc [CodeVarChunk]
ins [CodeVarChunk]
outs [MS (r Class)]
bod
        Maybe (MS (r md))
-> StateT DrasilState Identity (Maybe (MS (r md)))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MS (r md))
 -> StateT DrasilState Identity (Maybe (MS (r md))))
-> Maybe (MS (r md))
-> StateT DrasilState Identity (Maybe (MS (r md)))
forall a b. (a -> b) -> a -> b
$ MS (r md) -> Maybe (MS (r md))
forall a. a -> Maybe a
Just MS (r md)
mthd
  Bool -> GenState (Maybe (MS (r md)))
forall {r :: * -> *} {vis} {smt} {md} {svr} {att} {prg}.
OOProg r vis smt md svr att prg =>
Bool -> StateT DrasilState Identity (Maybe (MS (r md)))
genInFormat (Bool -> GenState (Maybe (MS (r md))))
-> Bool -> GenState (Maybe (MS (r md)))
forall a b. (a -> b) -> a -> b
$ String
giName String -> Set String -> Bool
forall a. Eq a => a -> Set a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` DrasilState -> Set String
defSet DrasilState
g

-- | Defines the 'DataDesc' for the format we require for input files. When we make
-- input format a design variability, this will read the user's design choices
-- instead of returning a fixed 'DataDesc'.
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 a. a -> StateT DrasilState Identity a
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 (DrasilState
g DrasilState
-> Getting [CodeVarChunk] DrasilState [CodeVarChunk]
-> [CodeVarChunk]
forall s a. s -> Getting a s a -> a
^. Getting [CodeVarChunk] DrasilState [CodeVarChunk]
forall c. HasCodeSpec c => Lens' c [CodeVarChunk]
Lens' DrasilState [CodeVarChunk]
extInputs))

-- | Generates a sample input file compatible with the generated program,
-- if the user chose to.
genSampleInput :: (Applicative r) => GenState (Maybe (r FileLayout))
genSampleInput :: forall (r :: * -> *).
Applicative r =>
GenState (Maybe (r FileLayout))
genSampleInput = do
  DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  DataDesc
dd <- GenState DataDesc
genDataDesc
  if [SoftwareDossierFile] -> Bool
hasSampleInput (DrasilState -> [SoftwareDossierFile]
getSoftwareDossierFiles DrasilState
g) then Maybe (r FileLayout) -> GenState (Maybe (r FileLayout))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (r FileLayout) -> GenState (Maybe (r FileLayout)))
-> (r FileLayout -> Maybe (r FileLayout))
-> r FileLayout
-> GenState (Maybe (r FileLayout))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r FileLayout -> Maybe (r FileLayout)
forall a. a -> Maybe a
Just (r FileLayout -> GenState (Maybe (r FileLayout)))
-> r FileLayout -> GenState (Maybe (r FileLayout))
forall a b. (a -> b) -> a -> b
$ PrintingInformation -> DataDesc -> [Expr] -> r FileLayout
forall (r :: * -> *).
Applicative r =>
PrintingInformation -> DataDesc -> [Expr] -> r FileLayout
sampleInput
    (DrasilState -> PrintingInformation
printfo DrasilState
g) DataDesc
dd (DrasilState -> [Expr]
getSampleData DrasilState
g) else Maybe (r FileLayout) -> GenState (Maybe (r FileLayout))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (r FileLayout)
forall a. Maybe a
Nothing

----- CONSTANTS -----

-- | Generates a module containing the class where constants are stored.
genConstMod :: (OOProg r vis smt md svr att prg) => GenState [FS (r File)]
genConstMod :: forall (r :: * -> *) vis smt md svr att prg.
OOProg r vis smt md svr att prg =>
GenState [FS (r File)]
genConstMod = do
  String
cDesc <- GenState [String] -> GenState String
modDesc (GenState [String] -> GenState String)
-> GenState [String] -> GenState String
forall a b. (a -> b) -> a -> b
$ GenState String -> GenState [String]
forall a b. State a b -> State a [b]
liftS GenState String
constModDesc
  String
cName <- InternalConcept -> GenState String
genICName InternalConcept
Constants
  State DrasilState (FS (r File)) -> GenState [FS (r File)]
forall a b. State a b -> State a [b]
liftS (State DrasilState (FS (r File)) -> GenState [FS (r File)])
-> State DrasilState (FS (r File)) -> GenState [FS (r File)]
forall a b. (a -> b) -> a -> b
$ String
-> String
-> [GenState (Maybe (MS (r md)))]
-> [GenState (Maybe (CS (r Class)))]
-> State DrasilState (FS (r File))
forall (r :: * -> *) vis smt md svr att prg.
OOProg r vis smt md svr att prg =>
String
-> String
-> [GenState (Maybe (MS (r md)))]
-> [GenState (Maybe (CS (r Class)))]
-> GenState (FS (r File))
genModule String
cName String
cDesc [] [ClassType -> GenState (Maybe (CS (r Class)))
forall (r :: * -> *) vis smt md svr att prg.
OOProg r vis smt md svr att prg =>
ClassType -> GenState (Maybe (CS (r Class)))
genConstClass ClassType
Primary]

-- | Generates a class to store constants, if constants are mapped to the
-- Constants class in the class definition map, otherwise returns Nothing.
genConstClass
  :: (OOProg r vis smt md svr att prg)
  => ClassType -> GenState (Maybe (CS (r Class)))
genConstClass :: forall (r :: * -> *) vis smt md svr att prg.
OOProg r vis smt md svr att prg =>
ClassType -> GenState (Maybe (CS (r Class)))
genConstClass ClassType
scp = do
  DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  (DrasilState -> DrasilState) -> StateT DrasilState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\DrasilState
st -> DrasilState
st {currentScope = Local})
  String
cname <- InternalConcept -> GenState String
genICName InternalConcept
Constants
  let cs :: [CodeDefinition]
cs = DrasilState
g DrasilState
-> Getting [CodeDefinition] DrasilState [CodeDefinition]
-> [CodeDefinition]
forall s a. s -> Getting a s a -> a
^. Getting [CodeDefinition] DrasilState [CodeDefinition]
forall c. HasCodeSpec c => Lens' c [CodeDefinition]
Lens' DrasilState [CodeDefinition]
constDefns
      genClass
        :: (OOProg r vis smt md svr att prg)
        => [CodeDefinition] -> GenState (Maybe (CS (r Class)))
      genClass :: forall (r :: * -> *) vis smt md svr att prg.
OOProg r vis smt md svr att prg =>
[CodeDefinition] -> GenState (Maybe (CS (r Class)))
genClass [] = Maybe (CS (r Class))
-> StateT DrasilState Identity (Maybe (CS (r Class)))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (CS (r Class))
forall a. Maybe a
Nothing
      genClass [CodeDefinition]
vs = do
        [SValue r]
vals <- (CodeDefinition -> StateT DrasilState Identity (SValue r))
-> [CodeDefinition] -> StateT DrasilState Identity [SValue r]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (CodeExpr -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr (CodeExpr -> StateT DrasilState Identity (SValue r))
-> (CodeDefinition -> CodeExpr)
-> CodeDefinition
-> StateT DrasilState Identity (SValue 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
Lens' CodeDefinition CodeExpr
codeExpr)) [CodeDefinition]
vs
        [SVariable r]
vars <- (CodeDefinition -> StateT DrasilState Identity (SVariable r))
-> [CodeDefinition] -> StateT DrasilState Identity [SVariable r]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\CodeDefinition
x -> (CodeType -> SVariable r)
-> StateT DrasilState Identity CodeType
-> StateT DrasilState Identity (SVariable r)
forall a b.
(a -> b)
-> StateT DrasilState Identity a -> StateT DrasilState Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> VS (r TypeData) -> SVariable r
forall (r :: * -> *).
VariableSym r =>
String -> VS (r TypeData) -> SVariable r
var (CodeDefinition -> String
forall c. CodeIdea c => c -> String
codeName CodeDefinition
x) (VS (r TypeData) -> SVariable r)
-> (CodeType -> VS (r TypeData)) -> CodeType -> SVariable r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CodeType -> VS (r TypeData)
forall (r :: * -> *). OOTypeSym r => CodeType -> VS (r TypeData)
convTypeOO)
          (CodeDefinition -> StateT DrasilState Identity CodeType
forall c. HasSpace c => c -> StateT DrasilState Identity CodeType
codeType CodeDefinition
x)) [CodeDefinition]
vs
        let constVars :: [CSStateVar r svr]
constVars = (SVariable r -> SValue r -> CSStateVar r svr)
-> [SVariable r] -> [SValue r] -> [CSStateVar r svr]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (ConstantRepr -> SVariable r -> SValue r -> CSStateVar r svr
forall (r :: * -> *) vis svr att.
StateVarSym r vis svr att =>
ConstantRepr -> SVariable r -> SValue r -> CSStateVar r svr
constVarFunc (DrasilState
g DrasilState
-> Getting ConstantRepr DrasilState ConstantRepr -> ConstantRepr
forall s a. s -> Getting a s a -> a
^. Getting ConstantRepr DrasilState ConstantRepr
forall a. HasChoices a => Lens' a ConstantRepr
Lens' DrasilState ConstantRepr
conRepr)) [SVariable r]
vars [SValue r]
vals
            getFunc :: ClassType
-> String
-> Maybe String
-> String
-> [CSStateVar r svr]
-> GenState [MS (r md)]
-> GenState [MS (r md)]
-> GenState (CS (r Class))
getFunc ClassType
Primary = String
-> Maybe String
-> String
-> [CSStateVar r svr]
-> GenState [MS (r md)]
-> GenState [MS (r md)]
-> GenState (CS (r Class))
forall (r :: * -> *) vis smt md svr att.
ClassSym r vis smt md svr att =>
String
-> Maybe String
-> String
-> [CSStateVar r svr]
-> GenState [MS (r md)]
-> GenState [MS (r md)]
-> GenState (CS (r Class))
primaryClass
            getFunc ClassType
Auxiliary = String
-> Maybe String
-> String
-> [CSStateVar r svr]
-> GenState [MS (r md)]
-> GenState [MS (r md)]
-> GenState (CS (r Class))
forall (r :: * -> *) vis smt md svr att.
ClassSym r vis smt md svr att =>
String
-> Maybe String
-> String
-> [CSStateVar r svr]
-> GenState [MS (r md)]
-> GenState [MS (r md)]
-> GenState (CS (r Class))
auxClass
            f :: String
-> Maybe String
-> String
-> [CSStateVar r svr]
-> GenState [MS (r md)]
-> GenState [MS (r md)]
-> GenState (CS (r Class))
f = ClassType
-> String
-> Maybe String
-> String
-> [CSStateVar r svr]
-> GenState [MS (r md)]
-> GenState [MS (r md)]
-> GenState (CS (r Class))
forall {r :: * -> *} {vis} {smt} {md} {att} {svr}.
ClassSym r vis smt md svr att =>
ClassType
-> String
-> Maybe String
-> String
-> [CSStateVar r svr]
-> GenState [MS (r md)]
-> GenState [MS (r md)]
-> GenState (CS (r Class))
getFunc ClassType
scp
        String
cDesc <- GenState String
constClassDesc
        CS (r Class)
cls <- String
-> Maybe String
-> String
-> [CSStateVar r svr]
-> GenState [MS (r md)]
-> GenState [MS (r md)]
-> GenState (CS (r Class))
f String
cname Maybe String
forall a. Maybe a
Nothing String
cDesc [CSStateVar r svr]
constVars ([MS (r md)] -> GenState [MS (r md)]
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return []) ([MS (r md)] -> GenState [MS (r md)]
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return [])
        Maybe (CS (r Class))
-> StateT DrasilState Identity (Maybe (CS (r Class)))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (CS (r Class))
 -> StateT DrasilState Identity (Maybe (CS (r Class))))
-> Maybe (CS (r Class))
-> StateT DrasilState Identity (Maybe (CS (r Class)))
forall a b. (a -> b) -> a -> b
$ CS (r Class) -> Maybe (CS (r Class))
forall a. a -> Maybe a
Just CS (r Class)
cls
  [CodeDefinition] -> GenState (Maybe (CS (r Class)))
forall (r :: * -> *) vis smt md svr att prg.
OOProg r vis smt md svr att prg =>
[CodeDefinition] -> GenState (Maybe (CS (r Class)))
genClass ([CodeDefinition] -> GenState (Maybe (CS (r Class))))
-> [CodeDefinition] -> GenState (Maybe (CS (r Class)))
forall a b. (a -> b) -> a -> b
$ (CodeDefinition -> Bool) -> [CodeDefinition] -> [CodeDefinition]
forall a. (a -> Bool) -> [a] -> [a]
filter ((String -> Map String String -> Bool)
-> Map String String -> String -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> Map String String -> Bool
forall k a. Ord k => k -> Map k a -> Bool
member ((String -> Bool) -> Map String String -> Map String String
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (String
cname String -> String -> Bool
forall a. Eq a => a -> a -> Bool
==) (DrasilState -> Map String String
clsMap DrasilState
g))
    (String -> Bool)
-> (CodeDefinition -> String) -> CodeDefinition -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CodeDefinition -> String
forall c. CodeIdea c => c -> String
codeName) [CodeDefinition]
cs

------- CALC ----------

-- | Generates a module containing calculation functions.
genCalcMod :: (OOProg r vis smt md svr att prg) => GenState (FS (r File))
genCalcMod :: forall (r :: * -> *) vis smt md svr att prg.
OOProg r vis smt md svr att prg =>
GenState (FS (r File))
genCalcMod = do
  DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  String
cName <- InternalConcept -> GenState String
genICName InternalConcept
Calculations
  let elmap :: ExtLibMap
elmap = DrasilState -> ExtLibMap
extLibMap DrasilState
g
  String
-> String
-> [String]
-> [GenState (Maybe (MS (r md)))]
-> [GenState (Maybe (CS (r Class)))]
-> GenState (FS (r File))
forall (r :: * -> *) vis smt md svr att prg.
OOProg r vis smt md svr att prg =>
String
-> String
-> [String]
-> [GenState (Maybe (MS (r md)))]
-> [GenState (Maybe (CS (r Class)))]
-> GenState (FS (r File))
genModuleWithImports String
cName String
calcModDesc ((ExtLibState -> [String]) -> [ExtLibState] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (ExtLibState -> Getting [String] ExtLibState [String] -> [String]
forall s a. s -> Getting a s a -> a
^. Getting [String] ExtLibState [String]
Lens' ExtLibState [String]
imports) ([ExtLibState] -> [String]) -> [ExtLibState] -> [String]
forall a b. (a -> b) -> a -> b
$
    ExtLibMap -> [ExtLibState]
forall k a. Map k a -> [a]
elems ExtLibMap
elmap) ((CodeDefinition -> GenState (Maybe (MS (r md))))
-> [CodeDefinition] -> [GenState (Maybe (MS (r md)))]
forall a b. (a -> b) -> [a] -> [b]
map ((MS (r md) -> Maybe (MS (r md)))
-> StateT DrasilState Identity (MS (r md))
-> GenState (Maybe (MS (r md)))
forall a b.
(a -> b)
-> StateT DrasilState Identity a -> StateT DrasilState Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MS (r md) -> Maybe (MS (r md))
forall a. a -> Maybe a
Just (StateT DrasilState Identity (MS (r md))
 -> GenState (Maybe (MS (r md))))
-> (CodeDefinition -> StateT DrasilState Identity (MS (r md)))
-> CodeDefinition
-> GenState (Maybe (MS (r md)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CodeDefinition -> StateT DrasilState Identity (MS (r md))
forall (r :: * -> *) vis smt md svr att prg.
OOProg r vis smt md svr att prg =>
CodeDefinition -> GenState (MS (r md))
genCalcFunc) (DrasilState
g DrasilState
-> Getting [CodeDefinition] DrasilState [CodeDefinition]
-> [CodeDefinition]
forall s a. s -> Getting a s a -> a
^. Getting [CodeDefinition] DrasilState [CodeDefinition]
forall c. HasCodeSpec c => Lens' c [CodeDefinition]
Lens' DrasilState [CodeDefinition]
execOrder)) []

-- | Generates a calculation function corresponding to the 'CodeDefinition'.
-- For solving ODEs, the 'ExtLibState' containing the information needed to
-- generate code is found by looking it up in the external library map.
genCalcFunc
  :: (OOProg r vis smt md svr att prg)
  => CodeDefinition -> GenState (MS (r md))
genCalcFunc :: forall (r :: * -> *) vis smt md svr att prg.
OOProg r vis smt md svr att prg =>
CodeDefinition -> GenState (MS (r md))
genCalcFunc CodeDefinition
cdef = do
  DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  (DrasilState -> DrasilState) -> StateT DrasilState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\DrasilState
st -> DrasilState
st {currentScope = Local})
  [CodeVarChunk]
parms <- CodeDefinition -> GenState [CodeVarChunk]
getCalcParams CodeDefinition
cdef
  let nm :: String
nm = CodeDefinition -> String
forall c. CodeIdea c => c -> String
codeName CodeDefinition
cdef
  CodeType
tp <- CodeDefinition -> StateT DrasilState Identity CodeType
forall c. HasSpace c => c -> StateT DrasilState Identity CodeType
codeType CodeDefinition
cdef
  SVariable r
v <- CodeVarChunk -> GenState (SVariable r)
forall (r :: * -> *).
(SelfSym r, VariableElim r, VariableValue r) =>
CodeVarChunk -> GenState (SVariable r)
mkVar (CodeDefinition -> CodeVarChunk
forall c.
(Quantity c, MayHaveUnit c, Concept c) =>
c -> CodeVarChunk
quantvar CodeDefinition
cdef)
  [MS (r Class)]
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 DefinitionType
Definition -> State DrasilState (MS (r Class))
-> StateT DrasilState Identity [MS (r Class)]
forall a b. State a b -> State a [b]
liftS (State DrasilState (MS (r Class))
 -> StateT DrasilState Identity [MS (r Class)])
-> State DrasilState (MS (r Class))
-> StateT DrasilState Identity [MS (r Class)]
forall a b. (a -> b) -> a -> b
$ CalcType
-> CodeDefinition -> CodeExpr -> State DrasilState (MS (r Class))
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
CalcType -> CodeDefinition -> CodeExpr -> GenState (MS (r Class))
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
Lens' CodeDefinition CodeExpr
codeExpr)
               DefinitionType
ODE -> StateT DrasilState Identity [MS (r Class)]
-> (ExtLibState -> StateT DrasilState Identity [MS (r Class)])
-> Maybe ExtLibState
-> StateT DrasilState Identity [MS (r Class)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> StateT DrasilState Identity [MS (r Class)]
forall a. HasCallStack => String -> a
error (String -> StateT DrasilState Identity [MS (r Class)])
-> String -> StateT DrasilState Identity [MS (r Class)]
forall a b. (a -> b) -> a -> b
$ String
nm String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" missing from ExtLibMap")
                 (\ExtLibState
el -> do
                   [MS (r smt)]
defStmts <- (FuncStmt -> StateT DrasilState Identity (MS (r smt)))
-> [FuncStmt] -> StateT DrasilState Identity [MS (r smt)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM FuncStmt -> StateT DrasilState Identity (MS (r smt))
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
FuncStmt -> GenState (MS (r smt))
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 smt)]
stepStmts <- (FuncStmt -> StateT DrasilState Identity (MS (r smt)))
-> [FuncStmt] -> StateT DrasilState Identity [MS (r smt)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM FuncStmt -> StateT DrasilState Identity (MS (r smt))
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
FuncStmt -> GenState (MS (r smt))
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 Class)] -> StateT DrasilState Identity [MS (r Class)]
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return [[MS (r smt)] -> MS (r Class)
forall (r :: * -> *) smt.
BlockSym r smt =>
[MS (r smt)] -> MS (r Class)
block (SVariable r -> r ScopeData -> MS (r smt)
forall (r :: * -> *) smt.
DeclStatement r smt =>
SVariable r -> r ScopeData -> MS (r smt)
varDec SVariable r
v r ScopeData
forall (r :: * -> *). ScopeSym r => r ScopeData
local MS (r smt) -> [MS (r smt)] -> [MS (r smt)]
forall a. a -> [a] -> [a]
: [MS (r smt)]
defStmts),
                     [MS (r smt)] -> MS (r Class)
forall (r :: * -> *) smt.
BlockSym r smt =>
[MS (r smt)] -> MS (r Class)
block [MS (r smt)]
stepStmts,
                     [MS (r smt)] -> MS (r Class)
forall (r :: * -> *) smt.
BlockSym r smt =>
[MS (r smt)] -> MS (r Class)
block [SValue r -> MS (r smt)
forall (r :: * -> *) smt.
ControlStatement r smt =>
SValue r -> MS (r smt)
returnStmt (SValue r -> MS (r smt)) -> SValue r -> MS (r smt)
forall a b. (a -> b) -> a -> b
$ SVariable r -> SValue r
forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
valueOf SVariable r
v]])
                 (String -> ExtLibMap -> Maybe ExtLibState
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
nm (DrasilState -> ExtLibMap
extLibMap DrasilState
g))
  String
calcDesc <- CodeDefinition -> GenState String
forall c. CodeIdea c => c -> GenState String
getCommentBrief CodeDefinition
cdef
  String
desc <- CodeDefinition -> GenState String
forall c. CodeIdea c => c -> GenState String
getCommentBrief CodeDefinition
cdef
  String
-> VS (r TypeData)
-> String
-> [ParameterChunk]
-> Maybe String
-> [MS (r Class)]
-> GenState (MS (r md))
forall (r :: * -> *) vis smt md svr att prg.
OOProg r vis smt md svr att prg =>
String
-> VS (r TypeData)
-> String
-> [ParameterChunk]
-> Maybe String
-> [MS (r Class)]
-> GenState (MS (r md))
publicFunc
    String
nm
    (CodeType -> VS (r TypeData)
forall (r :: * -> *). OOTypeSym r => CodeType -> VS (r TypeData)
convTypeOO CodeType
tp)
    (String
"Calculates " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
calcDesc)
    ((CodeVarChunk -> ParameterChunk)
-> [CodeVarChunk] -> [ParameterChunk]
forall a b. (a -> b) -> [a] -> [b]
map CodeVarChunk -> ParameterChunk
forall c. CodeIdea c => c -> ParameterChunk
pcAuto [CodeVarChunk]
parms)
    (String -> Maybe String
forall a. a -> Maybe a
Just String
desc)
    [MS (r Class)]
blcks

-- | Calculations may be assigned to a variable or asked for a result.
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
$c== :: CalcType -> CalcType -> Bool
== :: CalcType -> CalcType -> Bool
$c/= :: CalcType -> CalcType -> Bool
/= :: CalcType -> CalcType -> Bool
Eq

-- | Generates a calculation block for the given 'CodeDefinition', and assigns the
-- result to a variable (if 'CalcAssign') or returns the result (if 'CalcReturn').
genCalcBlock
  :: (OOStatement r smt, TypeElim r, VariableElim r)
   => CalcType -> CodeDefinition -> CodeExpr -> GenState (MS (r Block))
genCalcBlock :: forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
CalcType -> CodeDefinition -> CodeExpr -> GenState (MS (r Class))
genCalcBlock CalcType
t CodeDefinition
v (Case Completeness
c [(CodeExpr, CodeExpr)]
e) = CalcType
-> CodeDefinition
-> Completeness
-> [(CodeExpr, CodeExpr)]
-> GenState (MS (r Class))
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
CalcType
-> CodeDefinition
-> Completeness
-> [(CodeExpr, CodeExpr)]
-> GenState (MS (r Class))
genCaseBlock CalcType
t CodeDefinition
v Completeness
c [(CodeExpr, CodeExpr)]
e
genCalcBlock CalcType
CalcAssign CodeDefinition
v CodeExpr
e = do
  SVariable r
vv <- CodeVarChunk -> GenState (SVariable r)
forall (r :: * -> *).
(SelfSym r, VariableElim r, VariableValue r) =>
CodeVarChunk -> GenState (SVariable r)
mkVar (CodeDefinition -> CodeVarChunk
forall c.
(Quantity c, MayHaveUnit c, Concept c) =>
c -> CodeVarChunk
quantvar CodeDefinition
v)
  SValue r
ee <- CodeExpr -> GenState (SValue r)
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr CodeExpr
e
  MS (r Class) -> GenState (MS (r Class))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (MS (r Class) -> GenState (MS (r Class)))
-> MS (r Class) -> GenState (MS (r Class))
forall a b. (a -> b) -> a -> b
$ [MS (r smt)] -> MS (r Class)
forall (r :: * -> *) smt.
BlockSym r smt =>
[MS (r smt)] -> MS (r Class)
block [SVariable r -> SValue r -> MS (r smt)
forall (r :: * -> *) smt.
AssignStatement r smt =>
SVariable r -> SValue r -> MS (r smt)
assign SVariable r
vv SValue r
ee]
genCalcBlock CalcType
CalcReturn CodeDefinition
_ CodeExpr
e = [MS (r smt)] -> MS (r Class)
forall (r :: * -> *) smt.
BlockSym r smt =>
[MS (r smt)] -> MS (r Class)
block ([MS (r smt)] -> MS (r Class))
-> StateT DrasilState Identity [MS (r smt)]
-> GenState (MS (r Class))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> State DrasilState (MS (r smt))
-> StateT DrasilState Identity [MS (r smt)]
forall a b. State a b -> State a [b]
liftS (SValue r -> MS (r smt)
forall (r :: * -> *) smt.
ControlStatement r smt =>
SValue r -> MS (r smt)
returnStmt (SValue r -> MS (r smt))
-> GenState (SValue r) -> State DrasilState (MS (r smt))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CodeExpr -> GenState (SValue r)
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr CodeExpr
e)

-- | Generates a calculation block for a value defined by cases.
-- If the function is defined for every case, the final case is captured by an
-- else clause, otherwise an error-throwing else-clause is generated.
genCaseBlock
  :: (OOStatement r smt, TypeElim r, VariableElim r)
  => CalcType
  -> CodeDefinition
  -> Completeness
  -> [(CodeExpr, CodeExpr)]
  -> GenState (MS (r Block))
genCaseBlock :: forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
CalcType
-> CodeDefinition
-> Completeness
-> [(CodeExpr, CodeExpr)]
-> GenState (MS (r Class))
genCaseBlock CalcType
_ CodeDefinition
_ Completeness
_ [] = String -> GenState (MS (r Class))
forall a. HasCallStack => String -> a
error (String -> GenState (MS (r Class)))
-> String -> GenState (MS (r Class))
forall a b. (a -> b) -> a -> b
$ String
"Case expression with no cases encountered" String -> String -> String
forall a. [a] -> [a] -> [a]
++
  String
" in code generator"
genCaseBlock CalcType
t CodeDefinition
v Completeness
c [(CodeExpr, CodeExpr)]
cs = do
  [(SValue r, MS (r Class))]
ifs <- ((CodeExpr, CodeExpr)
 -> StateT DrasilState Identity (SValue r, MS (r Class)))
-> [(CodeExpr, CodeExpr)]
-> StateT DrasilState Identity [(SValue r, MS (r Class))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\(CodeExpr
e,CodeExpr
r) -> (SValue r -> MS (r Class) -> (SValue r, MS (r Class)))
-> StateT DrasilState Identity (SValue r)
-> GenState (MS (r Class))
-> StateT DrasilState Identity (SValue r, MS (r Class))
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) (CodeExpr -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr CodeExpr
r) (CodeExpr -> GenState (MS (r Class))
forall {r :: * -> *} {smt}.
(VariableElim r, TypeElim r, OOStatement r smt) =>
CodeExpr -> StateT DrasilState Identity (MS (r Class))
calcBody CodeExpr
e)) (Completeness -> [(CodeExpr, CodeExpr)]
ifEs Completeness
c)
  MS (r Class)
els <- Completeness -> GenState (MS (r Class))
forall {r :: * -> *} {smt}.
(OOStatement r smt, TypeElim r, VariableElim r) =>
Completeness -> StateT DrasilState Identity (MS (r Class))
elseE Completeness
c
  MS (r Class) -> GenState (MS (r Class))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (MS (r Class) -> GenState (MS (r Class)))
-> MS (r Class) -> GenState (MS (r Class))
forall a b. (a -> b) -> a -> b
$ [MS (r smt)] -> MS (r Class)
forall (r :: * -> *) smt.
BlockSym r smt =>
[MS (r smt)] -> MS (r Class)
block [[(SValue r, MS (r Class))] -> MS (r Class) -> MS (r smt)
forall (r :: * -> *) smt.
ControlStatement r smt =>
[(SValue r, MS (r Class))] -> MS (r Class) -> MS (r smt)
ifCond [(SValue r, MS (r Class))]
ifs MS (r Class)
els]
  where calcBody :: CodeExpr -> StateT DrasilState Identity (MS (r Class))
calcBody CodeExpr
e = ([MS (r Class)] -> MS (r Class))
-> StateT DrasilState Identity [MS (r Class)]
-> StateT DrasilState Identity (MS (r Class))
forall a b.
(a -> b)
-> StateT DrasilState Identity a -> StateT DrasilState Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [MS (r Class)] -> MS (r Class)
forall (r :: * -> *) smt.
BodySym r smt =>
[MS (r Class)] -> MS (r Class)
body (StateT DrasilState Identity [MS (r Class)]
 -> StateT DrasilState Identity (MS (r Class)))
-> StateT DrasilState Identity [MS (r Class)]
-> StateT DrasilState Identity (MS (r Class))
forall a b. (a -> b) -> a -> b
$ StateT DrasilState Identity (MS (r Class))
-> StateT DrasilState Identity [MS (r Class)]
forall a b. State a b -> State a [b]
liftS (StateT DrasilState Identity (MS (r Class))
 -> StateT DrasilState Identity [MS (r Class)])
-> StateT DrasilState Identity (MS (r Class))
-> StateT DrasilState Identity [MS (r Class)]
forall a b. (a -> b) -> a -> b
$ CalcType
-> CodeDefinition
-> CodeExpr
-> StateT DrasilState Identity (MS (r Class))
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
CalcType -> CodeDefinition -> CodeExpr -> GenState (MS (r Class))
genCalcBlock CalcType
t CodeDefinition
v CodeExpr
e
        ifEs :: Completeness -> [(CodeExpr, CodeExpr)]
ifEs Completeness
Complete = [(CodeExpr, CodeExpr)] -> [(CodeExpr, CodeExpr)]
forall a. HasCallStack => [a] -> [a]
init [(CodeExpr, CodeExpr)]
cs
        ifEs Completeness
Incomplete = [(CodeExpr, CodeExpr)]
cs
        elseE :: Completeness -> StateT DrasilState Identity (MS (r Class))
elseE Completeness
Complete = CodeExpr -> StateT DrasilState Identity (MS (r Class))
forall {r :: * -> *} {smt}.
(VariableElim r, TypeElim r, OOStatement r smt) =>
CodeExpr -> StateT DrasilState Identity (MS (r Class))
calcBody (CodeExpr -> StateT DrasilState Identity (MS (r Class)))
-> CodeExpr -> StateT DrasilState Identity (MS (r Class))
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. HasCallStack => [a] -> a
last [(CodeExpr, CodeExpr)]
cs
        elseE Completeness
Incomplete = MS (r Class) -> StateT DrasilState Identity (MS (r Class))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (MS (r Class) -> StateT DrasilState Identity (MS (r Class)))
-> MS (r Class) -> StateT DrasilState Identity (MS (r Class))
forall a b. (a -> b) -> a -> b
$ MS (r smt) -> MS (r Class)
forall (r :: * -> *) smt.
BodySym r smt =>
MS (r smt) -> MS (r Class)
oneLiner (MS (r smt) -> MS (r Class)) -> MS (r smt) -> MS (r Class)
forall a b. (a -> b) -> a -> b
$ String -> MS (r smt)
forall (r :: * -> *) smt.
ControlStatement r smt =>
String -> MS (r smt)
throw (String -> MS (r smt)) -> String -> MS (r smt)
forall a b. (a -> b) -> a -> b
$
          String
"Undefined case encountered in function " String -> String -> String
forall a. [a] -> [a] -> [a]
++ CodeDefinition -> String
forall c. CodeIdea c => c -> String
codeName CodeDefinition
v

----- OUTPUT -------

-- | Generates a module containing the function for printing outputs.
genOutputMod :: (OOProg r vis smt md svr att prg) => GenState [FS (r File)]
genOutputMod :: forall (r :: * -> *) vis smt md svr att prg.
OOProg r vis smt md svr att prg =>
GenState [FS (r File)]
genOutputMod = do
  String
ofName <- InternalConcept -> GenState String
genICName InternalConcept
OutputFormat
  String
ofDesc <- GenState [String] -> GenState String
modDesc (GenState [String] -> GenState String)
-> GenState [String] -> GenState String
forall a b. (a -> b) -> a -> b
$ GenState String -> GenState [String]
forall a b. State a b -> State a [b]
liftS GenState String
outputFormatDesc
  State DrasilState (FS (r File)) -> GenState [FS (r File)]
forall a b. State a b -> State a [b]
liftS (State DrasilState (FS (r File)) -> GenState [FS (r File)])
-> State DrasilState (FS (r File)) -> GenState [FS (r File)]
forall a b. (a -> b) -> a -> b
$ String
-> String
-> [GenState (Maybe (MS (r md)))]
-> [GenState (Maybe (CS (r Class)))]
-> State DrasilState (FS (r File))
forall (r :: * -> *) vis smt md svr att prg.
OOProg r vis smt md svr att prg =>
String
-> String
-> [GenState (Maybe (MS (r md)))]
-> [GenState (Maybe (CS (r Class)))]
-> GenState (FS (r File))
genModule String
ofName String
ofDesc [GenState (Maybe (MS (r md)))
forall (r :: * -> *) vis smt md svr att prg.
OOProg r vis smt md svr att prg =>
GenState (Maybe (MS (r md)))
genOutputFormat] []

-- | Generates a function for printing output values.
genOutputFormat :: (OOProg r vis smt md svr att prg) => GenState (Maybe (MS (r md)))
genOutputFormat :: forall (r :: * -> *) vis smt md svr att prg.
OOProg r vis smt md svr att prg =>
GenState (Maybe (MS (r md)))
genOutputFormat = do
  DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  (DrasilState -> DrasilState) -> StateT DrasilState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\DrasilState
st -> DrasilState
st {currentScope = Local})
  String
woName <- InternalConcept -> GenState String
genICName InternalConcept
WriteOutput
  let genOutput
        :: (OOProg r vis smt md svr att prg)
        => Maybe String -> GenState (Maybe (MS (r md)))
      genOutput :: forall (r :: * -> *) vis smt md svr att prg.
OOProg r vis smt md svr att prg =>
Maybe String -> GenState (Maybe (MS (r md)))
genOutput Maybe String
Nothing = Maybe (MS (r md))
-> StateT DrasilState Identity (Maybe (MS (r md)))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MS (r md))
forall a. Maybe a
Nothing
      genOutput (Just String
_) = do
        let l_outfile :: String
l_outfile = String
"outputfile"
            var_outfile :: SVariable r
var_outfile = String -> VS (r TypeData) -> SVariable r
forall (r :: * -> *).
VariableSym r =>
String -> VS (r TypeData) -> SVariable r
var String
l_outfile VS (r TypeData)
forall (r :: * -> *). TypeSym r => VS (r TypeData)
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
        let outs :: [CodeVarChunk]
outs = (CodeVarChunk -> CodeVarChunk) -> [CodeVarChunk] -> [CodeVarChunk]
forall a b. (a -> b) -> [a] -> [b]
map (DrasilState -> CodeVarChunk -> CodeVarChunk
resolveOutputDefType DrasilState
g) (DrasilState
g DrasilState
-> Getting [CodeVarChunk] DrasilState [CodeVarChunk]
-> [CodeVarChunk]
forall s a. s -> Getting a s a -> a
^. Getting [CodeVarChunk] DrasilState [CodeVarChunk]
forall c. HasCodeSpec c => Lens' c [CodeVarChunk]
Lens' DrasilState [CodeVarChunk]
outputs)
        [[MS (r smt)]]
outp <- (CodeVarChunk -> StateT DrasilState Identity [MS (r smt)])
-> [CodeVarChunk] -> StateT DrasilState Identity [[MS (r smt)]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\CodeVarChunk
x -> do
          SValue r
v <- CodeVarChunk -> GenState (SValue r)
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
CodeVarChunk -> GenState (SValue r)
mkVal CodeVarChunk
x
          [MS (r smt)] -> StateT DrasilState Identity [MS (r smt)]
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([MS (r smt)] -> StateT DrasilState Identity [MS (r smt)])
-> [MS (r smt)] -> StateT DrasilState Identity [MS (r smt)]
forall a b. (a -> b) -> a -> b
$
            SValue r -> String -> MS (r smt)
forall (r :: * -> *) smt.
IOStatement r smt =>
SValue r -> String -> MS (r smt)
printFileStr SValue r
v_outfile (CodeVarChunk -> String
forall c. CodeIdea c => c -> String
codeName CodeVarChunk
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" = ")
            MS (r smt) -> [MS (r smt)] -> [MS (r smt)]
forall a. a -> [a] -> [a]
: SValue r -> SValue r -> Space -> [MS (r smt)]
forall (r :: * -> *) smt.
SharedStatement r smt =>
SValue r -> SValue r -> Space -> [MS (r smt)]
writeOutputValue SValue r
v_outfile SValue r
v (CodeVarChunk
x CodeVarChunk -> Getting Space CodeVarChunk Space -> Space
forall s a. s -> Getting a s a -> a
^. Getting Space CodeVarChunk Space
forall c. HasSpace c => Getter c Space
Getter CodeVarChunk Space
typ) ) [CodeVarChunk]
outs
        String
desc <- GenState String
woFuncDesc
        MS (r md)
mthd <- String
-> VS (r TypeData)
-> String
-> [ParameterChunk]
-> Maybe String
-> [MS (r Class)]
-> GenState (MS (r md))
forall (r :: * -> *) vis smt md svr att prg.
OOProg r vis smt md svr att prg =>
String
-> VS (r TypeData)
-> String
-> [ParameterChunk]
-> Maybe String
-> [MS (r Class)]
-> GenState (MS (r md))
publicFunc String
woName VS (r TypeData)
forall (r :: * -> *). TypeSym r => VS (r TypeData)
void String
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 String
forall a. Maybe a
Nothing
          [[MS (r smt)] -> MS (r Class)
forall (r :: * -> *) smt.
BlockSym r smt =>
[MS (r smt)] -> MS (r Class)
block ([MS (r smt)] -> MS (r Class)) -> [MS (r smt)] -> MS (r Class)
forall a b. (a -> b) -> a -> b
$ [
          SVariable r -> r ScopeData -> MS (r smt)
forall (r :: * -> *) smt.
DeclStatement r smt =>
SVariable r -> r ScopeData -> MS (r smt)
varDec SVariable r
var_outfile r ScopeData
forall (r :: * -> *). ScopeSym r => r ScopeData
local,
          SVariable r -> SValue r -> MS (r smt)
forall (r :: * -> *) smt.
IOStatement r smt =>
SVariable r -> SValue r -> MS (r smt)
openFileW SVariable r
var_outfile (String -> SValue r
forall (r :: * -> *). Literal r => String -> SValue r
litString String
"output.txt") ] [MS (r smt)] -> [MS (r smt)] -> [MS (r smt)]
forall a. [a] -> [a] -> [a]
++
          [[MS (r smt)]] -> [MS (r smt)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[MS (r smt)]]
outp [MS (r smt)] -> [MS (r smt)] -> [MS (r smt)]
forall a. [a] -> [a] -> [a]
++ [ SValue r -> MS (r smt)
forall (r :: * -> *) smt.
IOStatement r smt =>
SValue r -> MS (r smt)
closeFile SValue r
v_outfile ]]
        Maybe (MS (r md))
-> StateT DrasilState Identity (Maybe (MS (r md)))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MS (r md))
 -> StateT DrasilState Identity (Maybe (MS (r md))))
-> Maybe (MS (r md))
-> StateT DrasilState Identity (Maybe (MS (r md)))
forall a b. (a -> b) -> a -> b
$ MS (r md) -> Maybe (MS (r md))
forall a. a -> Maybe a
Just MS (r md)
mthd
  Maybe String -> GenState (Maybe (MS (r md)))
forall (r :: * -> *) vis smt md svr att prg.
OOProg r vis smt md svr att prg =>
Maybe String -> GenState (Maybe (MS (r md)))
genOutput (Maybe String -> GenState (Maybe (MS (r md))))
-> Maybe String -> GenState (Maybe (MS (r md)))
forall a b. (a -> b) -> a -> b
$ String -> Map String String -> Maybe String
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
woName (DrasilState -> Map String String
eMap DrasilState
g)

-- Procedural Versions --

-- | Generates a controller module.
genMainProc
  :: (ProcProg r vis smt md prg, NativeVector r) => GenState (FS (r File))
genMainProc :: forall (r :: * -> *) vis smt md prg.
(ProcProg r vis smt md prg, NativeVector r) =>
GenState (FS (r File))
genMainProc = String
-> String
-> [GenState (Maybe (MS (r md)))]
-> GenState (FS (r File))
forall (r :: * -> *) vis smt md prg.
ProcProg r vis smt md prg =>
String
-> String
-> [GenState (Maybe (MS (r md)))]
-> GenState (FS (r File))
genModuleProc String
"Control" String
"Controls the flow of the program"
  [GenState (Maybe (MS (r md)))
forall (r :: * -> *) vis smt md.
(NativeVector r, SharedProg r vis smt md) =>
GenState (Maybe (MS (r md)))
genMainFuncProc]

-- | Generates a main function, to act as the controller for an SCS program.
-- The controller declares input and constant variables, then calls the
-- functions for reading input values, calculating derived inputs, checking
-- constraints, calculating outputs, and printing outputs.
-- Returns Nothing if the user chose to generate a library.
genMainFuncProc
  :: (NativeVector r, SharedProg r vis smt md)
  => GenState (Maybe (MS (r md)))
genMainFuncProc :: forall (r :: * -> *) vis smt md.
(NativeVector r, SharedProg r vis smt md) =>
GenState (Maybe (MS (r md)))
genMainFuncProc = 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 md)))
mainFunc ImplementationType
Library = Maybe (MS (r md))
-> StateT DrasilState Identity (Maybe (MS (r md)))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MS (r md))
forall a. Maybe a
Nothing
        mainFunc ImplementationType
Program = do
          (DrasilState -> DrasilState) -> StateT DrasilState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\DrasilState
st -> DrasilState
st {currentScope = MainFn})
          SVariable r
v_filename <- CodeVarChunk -> GenState (SVariable r)
forall (r :: * -> *).
VariableSym r =>
CodeVarChunk -> GenState (SVariable r)
mkVarProc (DefinedQuantityDict -> CodeVarChunk
forall c.
(Quantity c, MayHaveUnit c, Concept c) =>
c -> CodeVarChunk
quantvar DefinedQuantityDict
inFileName)
          Maybe (MS (r smt))
co <- GenState (Maybe (MS (r smt)))
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
GenState (Maybe (MS (r smt)))
initConstsProc
          Maybe (MS (r smt))
ip <- GenState (Maybe (MS (r smt)))
forall (r :: * -> *) smt.
DeclStatement r smt =>
GenState (Maybe (MS (r smt)))
getInputDeclProc
          [MS (r smt)]
ics <- GenState [MS (r smt)]
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
GenState [MS (r smt)]
genAllInputCallsProc
          [Maybe (MS (r smt))]
varDef <- (CodeDefinition -> GenState (Maybe (MS (r smt))))
-> [CodeDefinition]
-> StateT DrasilState Identity [Maybe (MS (r smt))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM CodeDefinition -> GenState (Maybe (MS (r smt)))
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
CodeDefinition -> GenState (Maybe (MS (r smt)))
genCalcCallProc (DrasilState
g DrasilState
-> Getting [CodeDefinition] DrasilState [CodeDefinition]
-> [CodeDefinition]
forall s a. s -> Getting a s a -> a
^. Getting [CodeDefinition] DrasilState [CodeDefinition]
forall c. HasCodeSpec c => Lens' c [CodeDefinition]
Lens' DrasilState [CodeDefinition]
execOrder)
          Maybe (MS (r smt))
wo <- GenState (Maybe (MS (r smt)))
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
GenState (Maybe (MS (r smt)))
genOutputCallProc
          Maybe (MS (r md))
-> StateT DrasilState Identity (Maybe (MS (r md)))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MS (r md))
 -> StateT DrasilState Identity (Maybe (MS (r md))))
-> Maybe (MS (r md))
-> StateT DrasilState Identity (Maybe (MS (r md)))
forall a b. (a -> b) -> a -> b
$ MS (r md) -> Maybe (MS (r md))
forall a. a -> Maybe a
Just (MS (r md) -> Maybe (MS (r md))) -> MS (r md) -> Maybe (MS (r md))
forall a b. (a -> b) -> a -> b
$
            (if Comments
CommentFunc Comments -> [Comments] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` DrasilState
g DrasilState
-> Getting [Comments] DrasilState [Comments] -> [Comments]
forall s a. s -> Getting a s a -> a
^. Getting [Comments] DrasilState [Comments]
forall a. HasChoices a => Lens' a [Comments]
Lens' DrasilState [Comments]
commented
              then MS (r Class) -> MS (r md)
forall (r :: * -> *) vis smt md.
MethodSym r vis smt md =>
MS (r Class) -> MS (r md)
docMain
              else MS (r Class) -> MS (r md)
forall (r :: * -> *) vis smt md.
MethodSym r vis smt md =>
MS (r Class) -> MS (r md)
mainFunction)
            (MS (r Class) -> MS (r md)) -> MS (r Class) -> MS (r md)
forall a b. (a -> b) -> a -> b
$ [MS (r smt)] -> MS (r Class)
forall (r :: * -> *) smt.
BodySym r smt =>
[MS (r smt)] -> MS (r Class)
bodyStatements ([MS (r smt)] -> MS (r Class)) -> [MS (r smt)] -> MS (r Class)
forall a b. (a -> b) -> a -> b
$ [Logging] -> r ScopeData -> [MS (r smt)]
forall (r :: * -> *) smt.
DeclStatement r smt =>
[Logging] -> r ScopeData -> [MS (r smt)]
initLogFileVar (DrasilState
g DrasilState -> Getting [Logging] DrasilState [Logging] -> [Logging]
forall s a. s -> Getting a s a -> a
^. Getting [Logging] DrasilState [Logging]
forall a. HasChoices a => Lens' a [Logging]
Lens' DrasilState [Logging]
logKind) r ScopeData
forall (r :: * -> *). ScopeSym r => r ScopeData
mainFn
              [MS (r smt)] -> [MS (r smt)] -> [MS (r smt)]
forall a. [a] -> [a] -> [a]
++ [SVariable r -> r ScopeData -> SValue r -> MS (r smt)
forall (r :: * -> *) smt.
DeclStatement r smt =>
SVariable r -> r ScopeData -> SValue r -> MS (r smt)
varDecDef SVariable r
v_filename r ScopeData
forall (r :: * -> *). ScopeSym r => r ScopeData
mainFn (Integer -> SValue r
forall (r :: * -> *). CommandLineArgs r => Integer -> SValue r
arg Integer
0)]
              -- Constants must be declared before inputs because some derived
              -- input definitions or input constraints may use the constants
              [MS (r smt)] -> [MS (r smt)] -> [MS (r smt)]
forall a. [a] -> [a] -> [a]
++ [Maybe (MS (r smt))] -> [MS (r smt)]
forall a. [Maybe a] -> [a]
catMaybes [Maybe (MS (r smt))
co, Maybe (MS (r smt))
ip] [MS (r smt)] -> [MS (r smt)] -> [MS (r smt)]
forall a. [a] -> [a] -> [a]
++ [MS (r smt)]
ics [MS (r smt)] -> [MS (r smt)] -> [MS (r smt)]
forall a. [a] -> [a] -> [a]
++ [Maybe (MS (r smt))] -> [MS (r smt)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (MS (r smt))]
varDef [Maybe (MS (r smt))]
-> [Maybe (MS (r smt))] -> [Maybe (MS (r smt))]
forall a. [a] -> [a] -> [a]
++ [Maybe (MS (r smt))
wo])
    ImplementationType -> GenState (Maybe (MS (r md)))
forall {r :: * -> *} {vis} {smt} {md}.
(SharedStatement r smt, MethodSym r vis smt md, TypeElim r,
 NativeVector r) =>
ImplementationType
-> StateT DrasilState Identity (Maybe (MS (r md)))
mainFunc (ImplementationType -> GenState (Maybe (MS (r md))))
-> ImplementationType -> GenState (Maybe (MS (r md)))
forall a b. (a -> b) -> a -> b
$ DrasilState
g DrasilState
-> Getting ImplementationType DrasilState ImplementationType
-> ImplementationType
forall s a. s -> Getting a s a -> a
^. Getting ImplementationType DrasilState ImplementationType
forall a. HasChoices a => Lens' a ImplementationType
Lens' DrasilState ImplementationType
implType

-- | If constants are 'Unbundled', declare them individually using 'varDecDef' if
-- representation is 'Var' and 'constDecDef' if representation is 'Const'.
-- If constants are 'Bundled' independently and representation is 'Var', throw
-- an error. If representation is 'Const', no object needs to be
-- declared because the constants will be accessed directly through the
-- Constants class.
-- If constants are 'Bundled' 'WithInputs', do 'Nothing'; declaration of the 'inParams'
-- object is handled by 'getInputDecl'.
-- If constants are 'Inlined', nothing needs to be declared.
initConstsProc
  :: (NativeVector r, SharedStatement r smt, TypeElim r)
  => GenState (Maybe (MS (r smt)))
initConstsProc :: forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
GenState (Maybe (MS (r smt)))
initConstsProc = do
  DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  let scp :: r ScopeData
scp = ScopeType -> r ScopeData
forall (r :: * -> *). ScopeSym r => ScopeType -> r ScopeData
convScope (ScopeType -> r ScopeData) -> ScopeType -> r ScopeData
forall a b. (a -> b) -> a -> b
$ DrasilState -> ScopeType
currentScope DrasilState
g
      cs :: [CodeDefinition]
cs = DrasilState
g DrasilState
-> Getting [CodeDefinition] DrasilState [CodeDefinition]
-> [CodeDefinition]
forall s a. s -> Getting a s a -> a
^. Getting [CodeDefinition] DrasilState [CodeDefinition]
forall c. HasCodeSpec c => Lens' c [CodeDefinition]
Lens' DrasilState [CodeDefinition]
constDefns
      getDecl :: ConstantStructure -> Structure -> GenState (Maybe (MS (r smt)))
getDecl (Store Structure
Unbundled) Structure
_ = GenState (Maybe (MS (r smt)))
declVars
      getDecl (Store Structure
Bundled) Structure
_ = String -> GenState (Maybe (MS (r smt)))
forall a. HasCallStack => String -> a
error String
"initConstsProc: Procedural renderers do not support bundled constants."
      getDecl ConstantStructure
WithInputs Structure
Unbundled = GenState (Maybe (MS (r smt)))
declVars
      getDecl ConstantStructure
WithInputs Structure
Bundled = Maybe (MS (r smt)) -> GenState (Maybe (MS (r smt)))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MS (r smt))
forall a. Maybe a
Nothing
      getDecl ConstantStructure
Inline Structure
_ = Maybe (MS (r smt)) -> GenState (Maybe (MS (r smt)))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MS (r smt))
forall a. Maybe a
Nothing
      declVars :: GenState (Maybe (MS (r smt)))
declVars = do
        [SVariable r]
vars <- (CodeDefinition -> StateT DrasilState Identity (SVariable r))
-> [CodeDefinition] -> StateT DrasilState Identity [SVariable r]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (CodeVarChunk -> StateT DrasilState Identity (SVariable r)
forall (r :: * -> *).
VariableSym r =>
CodeVarChunk -> GenState (SVariable r)
mkVarProc (CodeVarChunk -> StateT DrasilState Identity (SVariable r))
-> (CodeDefinition -> CodeVarChunk)
-> CodeDefinition
-> StateT DrasilState Identity (SVariable r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CodeDefinition -> CodeVarChunk
forall c.
(Quantity c, MayHaveUnit c, Concept c) =>
c -> CodeVarChunk
quantvar) [CodeDefinition]
cs
        [SValue r]
vals <- (CodeDefinition -> StateT DrasilState Identity (SValue r))
-> [CodeDefinition] -> StateT DrasilState Identity [SValue r]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (CodeExpr -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc (CodeExpr -> StateT DrasilState Identity (SValue r))
-> (CodeDefinition -> CodeExpr)
-> CodeDefinition
-> StateT DrasilState Identity (SValue 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
Lens' CodeDefinition CodeExpr
codeExpr)) [CodeDefinition]
cs
        Maybe (MS (r smt)) -> GenState (Maybe (MS (r smt)))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MS (r smt)) -> GenState (Maybe (MS (r smt))))
-> Maybe (MS (r smt)) -> GenState (Maybe (MS (r smt)))
forall a b. (a -> b) -> a -> b
$ MS (r smt) -> Maybe (MS (r smt))
forall a. a -> Maybe a
Just (MS (r smt) -> Maybe (MS (r smt)))
-> MS (r smt) -> Maybe (MS (r smt))
forall a b. (a -> b) -> a -> b
$ [MS (r smt)] -> MS (r smt)
forall (r :: * -> *) smt.
StatementSym r smt =>
[MS (r smt)] -> MS (r smt)
multi ([MS (r smt)] -> MS (r smt)) -> [MS (r smt)] -> MS (r smt)
forall a b. (a -> b) -> a -> b
$
          (SVariable r -> SValue r -> MS (r smt))
-> [SVariable r] -> [SValue r] -> [MS (r smt)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\SVariable r
vr -> ConstantRepr
-> SVariable r -> r ScopeData -> SValue r -> MS (r smt)
forall {r :: * -> *} {smt}.
DeclStatement r smt =>
ConstantRepr
-> SVariable r -> r ScopeData -> SValue r -> MS (r smt)
defFunc (DrasilState
g DrasilState
-> Getting ConstantRepr DrasilState ConstantRepr -> ConstantRepr
forall s a. s -> Getting a s a -> a
^. Getting ConstantRepr DrasilState ConstantRepr
forall a. HasChoices a => Lens' a ConstantRepr
Lens' DrasilState ConstantRepr
conRepr) SVariable r
vr r ScopeData
scp) [SVariable r]
vars [SValue r]
vals
      defFunc :: ConstantRepr
-> SVariable r -> r ScopeData -> SValue r -> MS (r smt)
defFunc ConstantRepr
Var = SVariable r -> r ScopeData -> SValue r -> MS (r smt)
forall (r :: * -> *) smt.
DeclStatement r smt =>
SVariable r -> r ScopeData -> SValue r -> MS (r smt)
varDecDef
      defFunc ConstantRepr
Const = SVariable r -> r ScopeData -> SValue r -> MS (r smt)
forall (r :: * -> *) smt.
DeclStatement r smt =>
SVariable r -> r ScopeData -> SValue r -> MS (r smt)
constDecDef
  ConstantStructure -> Structure -> GenState (Maybe (MS (r smt)))
getDecl (DrasilState
g DrasilState
-> Getting ConstantStructure DrasilState ConstantStructure
-> ConstantStructure
forall s a. s -> Getting a s a -> a
^. Getting ConstantStructure DrasilState ConstantStructure
forall a. HasChoices a => Lens' a ConstantStructure
Lens' DrasilState ConstantStructure
conStruct) (DrasilState
g DrasilState -> Getting Structure DrasilState Structure -> Structure
forall s a. s -> Getting a s a -> a
^. Getting Structure DrasilState Structure
forall a. HasChoices a => Lens' a Structure
Lens' DrasilState Structure
inStruct)

-- | Checks if a class is needed to store constants, i.e. if constants are
-- mapped to the constants class in the class definition map.
checkConstClass :: GenState Bool
checkConstClass :: GenState Bool
checkConstClass = do
  DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  String
cName <- InternalConcept -> GenState String
genICName InternalConcept
Constants
  let cs :: [CodeDefinition]
cs = DrasilState
g DrasilState
-> Getting [CodeDefinition] DrasilState [CodeDefinition]
-> [CodeDefinition]
forall s a. s -> Getting a s a -> a
^. Getting [CodeDefinition] DrasilState [CodeDefinition]
forall c. HasCodeSpec c => Lens' c [CodeDefinition]
Lens' DrasilState [CodeDefinition]
constDefns
      checkClass :: [CodeDefinition] -> GenState Bool
      checkClass :: [CodeDefinition] -> GenState Bool
checkClass [] = Bool -> GenState Bool
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
      checkClass [CodeDefinition]
_ = Bool -> GenState Bool
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
  [CodeDefinition] -> GenState Bool
checkClass ([CodeDefinition] -> GenState Bool)
-> [CodeDefinition] -> GenState Bool
forall a b. (a -> b) -> a -> b
$ (CodeDefinition -> Bool) -> [CodeDefinition] -> [CodeDefinition]
forall a. (a -> Bool) -> [a] -> [a]
filter ((String -> Map String String -> Bool)
-> Map String String -> String -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> Map String String -> Bool
forall k a. Ord k => k -> Map k a -> Bool
member ((String -> Bool) -> Map String String -> Map String String
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (String
cName String -> String -> Bool
forall a. Eq a => a -> a -> Bool
==) (DrasilState -> Map String String
clsMap DrasilState
g))
    (String -> Bool)
-> (CodeDefinition -> String) -> CodeDefinition -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CodeDefinition -> String
forall c. CodeIdea c => c -> String
codeName) [CodeDefinition]
cs

-- | Generates a single module containing all input-related components.
genInputModProc
  :: (ProcProg r vis smt md prg, NativeVector r) => GenState [FS (r File)]
genInputModProc :: forall (r :: * -> *) vis smt md prg.
(ProcProg r vis smt md prg, NativeVector r) =>
GenState [FS (r File)]
genInputModProc = do
  String
ipDesc <- GenState [String] -> GenState String
modDesc GenState [String]
inputParametersDesc
  String
cname <- InternalConcept -> GenState String
genICName InternalConcept
InputParameters
  let genMod
        :: (ProcProg r vis smt md prg, NativeVector r) => Bool
        -> GenState (FS (r File))
      genMod :: forall (r :: * -> *) vis smt md prg.
(ProcProg r vis smt md prg, NativeVector r) =>
Bool -> GenState (FS (r File))
genMod Bool
False = String
-> String
-> [GenState (Maybe (MS (r md)))]
-> GenState (FS (r File))
forall (r :: * -> *) vis smt md prg.
ProcProg r vis smt md prg =>
String
-> String
-> [GenState (Maybe (MS (r md)))]
-> GenState (FS (r File))
genModuleProc String
cname String
ipDesc [VisibilityTag -> GenState (Maybe (MS (r md)))
forall (r :: * -> *) vis smt md.
(SharedProg r vis smt md, NativeVector r) =>
VisibilityTag -> GenState (Maybe (MS (r md)))
genInputFormatProc VisibilityTag
Pub,
        VisibilityTag -> GenState (Maybe (MS (r md)))
forall (r :: * -> *) vis smt md.
(SharedProg r vis smt md, NativeVector r) =>
VisibilityTag -> GenState (Maybe (MS (r md)))
genInputDerivedProc VisibilityTag
Pub, VisibilityTag -> GenState (Maybe (MS (r md)))
forall (r :: * -> *) vis smt md.
(SharedProg r vis smt md, NativeVector r) =>
VisibilityTag -> GenState (Maybe (MS (r md)))
genInputConstraintsProc VisibilityTag
Pub]
      genMod Bool
True = String -> GenState (FS (r File))
forall a. HasCallStack => String -> a
error String
"genInputModProc: Procedural renderers do not support bundled inputs"
  Bool
ic <- GenState Bool
checkInputClass
  State DrasilState (FS (r File)) -> GenState [FS (r File)]
forall a b. State a b -> State a [b]
liftS (State DrasilState (FS (r File)) -> GenState [FS (r File)])
-> State DrasilState (FS (r File)) -> GenState [FS (r File)]
forall a b. (a -> b) -> a -> b
$ Bool -> State DrasilState (FS (r File))
forall (r :: * -> *) vis smt md prg.
(ProcProg r vis smt md prg, NativeVector r) =>
Bool -> GenState (FS (r File))
genMod Bool
ic

-- | Returns 'False' if no inputs or constants are mapped to InputParameters in
-- the class definition map.
-- Returns 'True' If any inputs or constants are defined in InputParameters
checkInputClass :: GenState Bool
checkInputClass :: GenState Bool
checkInputClass = do
  DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  String
cname <- InternalConcept -> GenState String
genICName InternalConcept
InputParameters
  let ins :: [CodeVarChunk]
ins = DrasilState
g DrasilState
-> Getting [CodeVarChunk] DrasilState [CodeVarChunk]
-> [CodeVarChunk]
forall s a. s -> Getting a s a -> a
^. Getting [CodeVarChunk] DrasilState [CodeVarChunk]
forall c. HasCodeSpec c => Lens' c [CodeVarChunk]
Lens' DrasilState [CodeVarChunk]
inputs
      cs :: [CodeDefinition]
cs = DrasilState
g DrasilState
-> Getting [CodeDefinition] DrasilState [CodeDefinition]
-> [CodeDefinition]
forall s a. s -> Getting a s a -> a
^. Getting [CodeDefinition] DrasilState [CodeDefinition]
forall c. HasCodeSpec c => Lens' c [CodeDefinition]
Lens' DrasilState [CodeDefinition]
constDefns
      filt :: (CodeIdea c) => [c] -> [c]
      filt :: forall c. CodeIdea c => [c] -> [c]
filt = (c -> Bool) -> [c] -> [c]
forall a. (a -> Bool) -> [a] -> [a]
filter ((String -> Maybe String
forall a. a -> Maybe a
Just String
cname Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
==) (Maybe String -> Bool) -> (c -> Maybe String) -> c -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Map String String -> Maybe String)
-> Map String String -> String -> Maybe String
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> Map String String -> Maybe String
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (DrasilState -> Map String String
clsMap DrasilState
g) (String -> Maybe String) -> (c -> String) -> c -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> String
forall c. CodeIdea c => c -> String
codeName)
      checkClass :: [CodeVarChunk] -> [CodeDefinition] -> GenState Bool
      checkClass :: [CodeVarChunk] -> [CodeDefinition] -> GenState Bool
checkClass [] [] = Bool -> GenState Bool
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
      checkClass [CodeVarChunk]
_ [CodeDefinition]
_ = Bool -> GenState Bool
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
  [CodeVarChunk] -> [CodeDefinition] -> GenState Bool
checkClass ([CodeVarChunk] -> [CodeVarChunk]
forall c. CodeIdea c => [c] -> [c]
filt [CodeVarChunk]
ins) ([CodeDefinition] -> [CodeDefinition]
forall c. CodeIdea c => [c] -> [c]
filt [CodeDefinition]
cs)

-- | If there are no inputs, return nothing.
-- If there are inputs and they are not exported by any module, then they are
-- 'Unbundled' and are declared individually using 'varDec'.
-- If there are inputs and they are exported by a module, they are 'Bundled' in
-- the InputParameters class, so 'inParams' should be declared and constructed,
-- using 'objDecNew' if the inputs are exported by the current module, and
-- 'extObjDecNew' if they are exported by a different module.
getInputDeclProc :: (DeclStatement r smt) => GenState (Maybe (MS (r smt)))
getInputDeclProc :: forall (r :: * -> *) smt.
DeclStatement r smt =>
GenState (Maybe (MS (r smt)))
getInputDeclProc = do
  DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  let scp :: r ScopeData
scp = ScopeType -> r ScopeData
forall (r :: * -> *). ScopeSym r => ScopeType -> r ScopeData
convScope (ScopeType -> r ScopeData) -> ScopeType -> r ScopeData
forall a b. (a -> b) -> a -> b
$ DrasilState -> ScopeType
currentScope DrasilState
g
      getDecl :: ([a], [CodeVarChunk]) -> GenState (Maybe (MS (r smt)))
getDecl ([],[]) = Maybe (MS (r smt)) -> GenState (Maybe (MS (r smt)))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MS (r smt))
forall a. Maybe a
Nothing
      getDecl ([],[CodeVarChunk]
ins) = do
        [SVariable r]
vars <- (CodeVarChunk -> StateT DrasilState Identity (SVariable r))
-> [CodeVarChunk] -> StateT DrasilState Identity [SVariable r]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM CodeVarChunk -> StateT DrasilState Identity (SVariable r)
forall (r :: * -> *).
VariableSym r =>
CodeVarChunk -> GenState (SVariable r)
mkVarProc [CodeVarChunk]
ins
        Maybe (MS (r smt)) -> GenState (Maybe (MS (r smt)))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MS (r smt)) -> GenState (Maybe (MS (r smt))))
-> Maybe (MS (r smt)) -> GenState (Maybe (MS (r smt)))
forall a b. (a -> b) -> a -> b
$ MS (r smt) -> Maybe (MS (r smt))
forall a. a -> Maybe a
Just (MS (r smt) -> Maybe (MS (r smt)))
-> MS (r smt) -> Maybe (MS (r smt))
forall a b. (a -> b) -> a -> b
$ [MS (r smt)] -> MS (r smt)
forall (r :: * -> *) smt.
StatementSym r smt =>
[MS (r smt)] -> MS (r smt)
multi ([MS (r smt)] -> MS (r smt)) -> [MS (r smt)] -> MS (r smt)
forall a b. (a -> b) -> a -> b
$ (SVariable r -> MS (r smt)) -> [SVariable r] -> [MS (r smt)]
forall a b. (a -> b) -> [a] -> [b]
map (SVariable r -> r ScopeData -> MS (r smt)
forall (r :: * -> *) smt.
DeclStatement r smt =>
SVariable r -> r ScopeData -> MS (r smt)
`varDec` r ScopeData
scp) [SVariable r]
vars
      getDecl ([a], [CodeVarChunk])
_ = String -> GenState (Maybe (MS (r smt)))
forall a. HasCallStack => String -> a
error String
"getInputDeclProc: Procedural renderers do not support bundled inputs"
  ([CodeVarChunk], [CodeVarChunk]) -> GenState (Maybe (MS (r smt)))
forall {a}. ([a], [CodeVarChunk]) -> GenState (Maybe (MS (r smt)))
getDecl ((CodeVarChunk -> Bool)
-> [CodeVarChunk] -> ([CodeVarChunk], [CodeVarChunk])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ((String -> Map String String -> Bool)
-> Map String String -> String -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> Map String String -> Bool
forall k a. Ord k => k -> Map k a -> Bool
member (DrasilState -> Map String String
eMap DrasilState
g) (String -> Bool)
-> (CodeVarChunk -> String) -> CodeVarChunk -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CodeVarChunk -> String
forall c. CodeIdea c => c -> String
codeName)
    (DrasilState
g DrasilState
-> Getting [CodeVarChunk] DrasilState [CodeVarChunk]
-> [CodeVarChunk]
forall s a. s -> Getting a s a -> a
^. Getting [CodeVarChunk] DrasilState [CodeVarChunk]
forall c. HasCodeSpec c => Lens' c [CodeVarChunk]
Lens' DrasilState [CodeVarChunk]
inputs))

-- | Generates a module containing calculation functions.
genCalcModProc
  :: (ProcProg r vis smt md prg, NativeVector r) => GenState (FS (r File))
genCalcModProc :: forall (r :: * -> *) vis smt md prg.
(ProcProg r vis smt md prg, NativeVector r) =>
GenState (FS (r File))
genCalcModProc = do
  DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  String
cName <- InternalConcept -> GenState String
genICName InternalConcept
Calculations
  let elmap :: ExtLibMap
elmap = DrasilState -> ExtLibMap
extLibMap DrasilState
g
  String
-> String
-> [String]
-> [GenState (Maybe (MS (r md)))]
-> GenState (FS (r File))
forall (r :: * -> *) vis smt md prg.
ProcProg r vis smt md prg =>
String
-> String
-> [String]
-> [GenState (Maybe (MS (r md)))]
-> GenState (FS (r File))
genModuleWithImportsProc String
cName String
calcModDesc ((ExtLibState -> [String]) -> [ExtLibState] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (ExtLibState -> Getting [String] ExtLibState [String] -> [String]
forall s a. s -> Getting a s a -> a
^. Getting [String] ExtLibState [String]
Lens' ExtLibState [String]
imports) ([ExtLibState] -> [String]) -> [ExtLibState] -> [String]
forall a b. (a -> b) -> a -> b
$
    ExtLibMap -> [ExtLibState]
forall k a. Map k a -> [a]
elems ExtLibMap
elmap) ((CodeDefinition -> GenState (Maybe (MS (r md))))
-> [CodeDefinition] -> [GenState (Maybe (MS (r md)))]
forall a b. (a -> b) -> [a] -> [b]
map ((MS (r md) -> Maybe (MS (r md)))
-> StateT DrasilState Identity (MS (r md))
-> GenState (Maybe (MS (r md)))
forall a b.
(a -> b)
-> StateT DrasilState Identity a -> StateT DrasilState Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MS (r md) -> Maybe (MS (r md))
forall a. a -> Maybe a
Just (StateT DrasilState Identity (MS (r md))
 -> GenState (Maybe (MS (r md))))
-> (CodeDefinition -> StateT DrasilState Identity (MS (r md)))
-> CodeDefinition
-> GenState (Maybe (MS (r md)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CodeDefinition -> StateT DrasilState Identity (MS (r md))
forall (r :: * -> *) vis smt md.
(NativeVector r, SharedProg r vis smt md) =>
CodeDefinition -> GenState (MS (r md))
genCalcFuncProc) (DrasilState
g DrasilState
-> Getting [CodeDefinition] DrasilState [CodeDefinition]
-> [CodeDefinition]
forall s a. s -> Getting a s a -> a
^. Getting [CodeDefinition] DrasilState [CodeDefinition]
forall c. HasCodeSpec c => Lens' c [CodeDefinition]
Lens' DrasilState [CodeDefinition]
execOrder))

-- | Generates a calculation function corresponding to the 'CodeDefinition'.
-- For solving ODEs, the 'ExtLibState' containing the information needed to
-- generate code is found by looking it up in the external library map.
genCalcFuncProc
  :: (NativeVector r, SharedProg r vis smt md)
  => CodeDefinition -> GenState (MS (r md))
genCalcFuncProc :: forall (r :: * -> *) vis smt md.
(NativeVector r, SharedProg r vis smt md) =>
CodeDefinition -> GenState (MS (r md))
genCalcFuncProc CodeDefinition
cdef = do
  DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  (DrasilState -> DrasilState) -> StateT DrasilState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\DrasilState
st -> DrasilState
st {currentScope = Local})
  [CodeVarChunk]
parms <- CodeDefinition -> GenState [CodeVarChunk]
getCalcParams CodeDefinition
cdef
  let nm :: String
nm = CodeDefinition -> String
forall c. CodeIdea c => c -> String
codeName CodeDefinition
cdef
  CodeType
tp <- CodeDefinition -> StateT DrasilState Identity CodeType
forall c. HasSpace c => c -> StateT DrasilState Identity CodeType
codeType CodeDefinition
cdef
  SVariable r
v <- CodeVarChunk -> GenState (SVariable r)
forall (r :: * -> *).
VariableSym r =>
CodeVarChunk -> GenState (SVariable r)
mkVarProc (CodeDefinition -> CodeVarChunk
forall c.
(Quantity c, MayHaveUnit c, Concept c) =>
c -> CodeVarChunk
quantvar CodeDefinition
cdef)
  [MS (r Class)]
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 DefinitionType
Definition -> State DrasilState (MS (r Class))
-> StateT DrasilState Identity [MS (r Class)]
forall a b. State a b -> State a [b]
liftS (State DrasilState (MS (r Class))
 -> StateT DrasilState Identity [MS (r Class)])
-> State DrasilState (MS (r Class))
-> StateT DrasilState Identity [MS (r Class)]
forall a b. (a -> b) -> a -> b
$ CalcType
-> CodeDefinition -> CodeExpr -> State DrasilState (MS (r Class))
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
CalcType -> CodeDefinition -> CodeExpr -> GenState (MS (r Class))
genCalcBlockProc 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
Lens' CodeDefinition CodeExpr
codeExpr)
               DefinitionType
ODE -> StateT DrasilState Identity [MS (r Class)]
-> (ExtLibState -> StateT DrasilState Identity [MS (r Class)])
-> Maybe ExtLibState
-> StateT DrasilState Identity [MS (r Class)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> StateT DrasilState Identity [MS (r Class)]
forall a. HasCallStack => String -> a
error (String -> StateT DrasilState Identity [MS (r Class)])
-> String -> StateT DrasilState Identity [MS (r Class)]
forall a b. (a -> b) -> a -> b
$ String
nm String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" missing from ExtLibMap")
                 (\ExtLibState
el -> do
                   [MS (r smt)]
defStmts <- (FuncStmt -> StateT DrasilState Identity (MS (r smt)))
-> [FuncStmt] -> StateT DrasilState Identity [MS (r smt)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM FuncStmt -> StateT DrasilState Identity (MS (r smt))
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r,
 VariableElim r) =>
FuncStmt -> GenState (MS (r smt))
convStmtProc (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 smt)]
stepStmts <- (FuncStmt -> StateT DrasilState Identity (MS (r smt)))
-> [FuncStmt] -> StateT DrasilState Identity [MS (r smt)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM FuncStmt -> StateT DrasilState Identity (MS (r smt))
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r,
 VariableElim r) =>
FuncStmt -> GenState (MS (r smt))
convStmtProc (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 Class)] -> StateT DrasilState Identity [MS (r Class)]
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return [[MS (r smt)] -> MS (r Class)
forall (r :: * -> *) smt.
BlockSym r smt =>
[MS (r smt)] -> MS (r Class)
block (SVariable r -> r ScopeData -> MS (r smt)
forall (r :: * -> *) smt.
DeclStatement r smt =>
SVariable r -> r ScopeData -> MS (r smt)
varDec SVariable r
v r ScopeData
forall (r :: * -> *). ScopeSym r => r ScopeData
local MS (r smt) -> [MS (r smt)] -> [MS (r smt)]
forall a. a -> [a] -> [a]
: [MS (r smt)]
defStmts),
                     [MS (r smt)] -> MS (r Class)
forall (r :: * -> *) smt.
BlockSym r smt =>
[MS (r smt)] -> MS (r Class)
block [MS (r smt)]
stepStmts,
                     [MS (r smt)] -> MS (r Class)
forall (r :: * -> *) smt.
BlockSym r smt =>
[MS (r smt)] -> MS (r Class)
block [SValue r -> MS (r smt)
forall (r :: * -> *) smt.
ControlStatement r smt =>
SValue r -> MS (r smt)
returnStmt (SValue r -> MS (r smt)) -> SValue r -> MS (r smt)
forall a b. (a -> b) -> a -> b
$ SVariable r -> SValue r
forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
valueOf SVariable r
v]])
                 (String -> ExtLibMap -> Maybe ExtLibState
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
nm (DrasilState -> ExtLibMap
extLibMap DrasilState
g))
  String
calcDesc <- CodeDefinition -> GenState String
forall c. CodeIdea c => c -> GenState String
getCommentBrief CodeDefinition
cdef
  String
desc <- CodeDefinition -> GenState String
forall c. CodeIdea c => c -> GenState String
getCommentBrief CodeDefinition
cdef
  String
-> VS (r TypeData)
-> String
-> [ParameterChunk]
-> Maybe String
-> [MS (r Class)]
-> GenState (MS (r md))
forall (r :: * -> *) vis smt md.
SharedProg r vis smt md =>
String
-> VS (r TypeData)
-> String
-> [ParameterChunk]
-> Maybe String
-> [MS (r Class)]
-> GenState (MS (r md))
publicFuncProc
    String
nm
    (CodeType -> VS (r TypeData)
forall (r :: * -> *). TypeSym r => CodeType -> VS (r TypeData)
convType CodeType
tp)
    (String
"Calculates " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
calcDesc)
    ((CodeVarChunk -> ParameterChunk)
-> [CodeVarChunk] -> [ParameterChunk]
forall a b. (a -> b) -> [a] -> [b]
map CodeVarChunk -> ParameterChunk
forall c. CodeIdea c => c -> ParameterChunk
pcAuto [CodeVarChunk]
parms)
    (String -> Maybe String
forall a. a -> Maybe a
Just String
desc)
    [MS (r Class)]
blcks

-- | Generates a calculation block for the given 'CodeDefinition', and assigns the
-- result to a variable (if 'CalcAssign') or returns the result (if 'CalcReturn').
genCalcBlockProc
  :: (NativeVector r, SharedStatement r smt, TypeElim r)
  => CalcType -> CodeDefinition -> CodeExpr -> GenState (MS (r Block))
genCalcBlockProc :: forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
CalcType -> CodeDefinition -> CodeExpr -> GenState (MS (r Class))
genCalcBlockProc CalcType
t CodeDefinition
v (Case Completeness
c [(CodeExpr, CodeExpr)]
e) = CalcType
-> CodeDefinition
-> Completeness
-> [(CodeExpr, CodeExpr)]
-> GenState (MS (r Class))
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
CalcType
-> CodeDefinition
-> Completeness
-> [(CodeExpr, CodeExpr)]
-> GenState (MS (r Class))
genCaseBlockProc CalcType
t CodeDefinition
v Completeness
c [(CodeExpr, CodeExpr)]
e
genCalcBlockProc CalcType
CalcAssign CodeDefinition
v CodeExpr
e = do
  SVariable r
vv <- CodeVarChunk -> GenState (SVariable r)
forall (r :: * -> *).
VariableSym r =>
CodeVarChunk -> GenState (SVariable r)
mkVarProc (CodeDefinition -> CodeVarChunk
forall c.
(Quantity c, MayHaveUnit c, Concept c) =>
c -> CodeVarChunk
quantvar CodeDefinition
v)
  SValue r
ee <- CodeExpr -> GenState (SValue r)
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
e
  MS (r Class) -> GenState (MS (r Class))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (MS (r Class) -> GenState (MS (r Class)))
-> MS (r Class) -> GenState (MS (r Class))
forall a b. (a -> b) -> a -> b
$ [MS (r smt)] -> MS (r Class)
forall (r :: * -> *) smt.
BlockSym r smt =>
[MS (r smt)] -> MS (r Class)
block [SVariable r -> SValue r -> MS (r smt)
forall (r :: * -> *) smt.
AssignStatement r smt =>
SVariable r -> SValue r -> MS (r smt)
assign SVariable r
vv SValue r
ee]
genCalcBlockProc CalcType
CalcReturn CodeDefinition
_ CodeExpr
e = [MS (r smt)] -> MS (r Class)
forall (r :: * -> *) smt.
BlockSym r smt =>
[MS (r smt)] -> MS (r Class)
block ([MS (r smt)] -> MS (r Class))
-> StateT DrasilState Identity [MS (r smt)]
-> GenState (MS (r Class))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> State DrasilState (MS (r smt))
-> StateT DrasilState Identity [MS (r smt)]
forall a b. State a b -> State a [b]
liftS (SValue r -> MS (r smt)
forall (r :: * -> *) smt.
ControlStatement r smt =>
SValue r -> MS (r smt)
returnStmt (SValue r -> MS (r smt))
-> GenState (SValue r) -> State DrasilState (MS (r smt))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CodeExpr -> GenState (SValue r)
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
e)

-- | Generates a calculation block for a value defined by cases.
-- If the function is defined for every case, the final case is captured by an
-- else clause, otherwise an error-throwing else-clause is generated.
genCaseBlockProc
  :: (NativeVector r, SharedStatement r smt, TypeElim r)
  => CalcType
  -> CodeDefinition
  -> Completeness
  -> [(CodeExpr, CodeExpr)]
  -> GenState (MS (r Block))
genCaseBlockProc :: forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
CalcType
-> CodeDefinition
-> Completeness
-> [(CodeExpr, CodeExpr)]
-> GenState (MS (r Class))
genCaseBlockProc CalcType
_ CodeDefinition
_ Completeness
_ [] = String -> GenState (MS (r Class))
forall a. HasCallStack => String -> a
error (String -> GenState (MS (r Class)))
-> String -> GenState (MS (r Class))
forall a b. (a -> b) -> a -> b
$ String
"Case expression with no cases encountered" String -> String -> String
forall a. [a] -> [a] -> [a]
++
  String
" in code generator"
genCaseBlockProc CalcType
t CodeDefinition
v Completeness
c [(CodeExpr, CodeExpr)]
cs = do
  [(SValue r, MS (r Class))]
ifs <- ((CodeExpr, CodeExpr)
 -> StateT DrasilState Identity (SValue r, MS (r Class)))
-> [(CodeExpr, CodeExpr)]
-> StateT DrasilState Identity [(SValue r, MS (r Class))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\(CodeExpr
e,CodeExpr
r) -> (SValue r -> MS (r Class) -> (SValue r, MS (r Class)))
-> StateT DrasilState Identity (SValue r)
-> GenState (MS (r Class))
-> StateT DrasilState Identity (SValue r, MS (r Class))
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) (CodeExpr -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
r) (CodeExpr -> GenState (MS (r Class))
forall {r :: * -> *} {smt}.
(TypeElim r, NativeVector r, SharedStatement r smt) =>
CodeExpr -> StateT DrasilState Identity (MS (r Class))
calcBody CodeExpr
e)) (Completeness -> [(CodeExpr, CodeExpr)]
ifEs Completeness
c)
  MS (r Class)
els <- Completeness -> GenState (MS (r Class))
forall {r :: * -> *} {smt}.
(SharedStatement r smt, NativeVector r, TypeElim r) =>
Completeness -> StateT DrasilState Identity (MS (r Class))
elseE Completeness
c
  MS (r Class) -> GenState (MS (r Class))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (MS (r Class) -> GenState (MS (r Class)))
-> MS (r Class) -> GenState (MS (r Class))
forall a b. (a -> b) -> a -> b
$ [MS (r smt)] -> MS (r Class)
forall (r :: * -> *) smt.
BlockSym r smt =>
[MS (r smt)] -> MS (r Class)
block [[(SValue r, MS (r Class))] -> MS (r Class) -> MS (r smt)
forall (r :: * -> *) smt.
ControlStatement r smt =>
[(SValue r, MS (r Class))] -> MS (r Class) -> MS (r smt)
ifCond [(SValue r, MS (r Class))]
ifs MS (r Class)
els]
  where calcBody :: CodeExpr -> StateT DrasilState Identity (MS (r Class))
calcBody CodeExpr
e = ([MS (r Class)] -> MS (r Class))
-> StateT DrasilState Identity [MS (r Class)]
-> StateT DrasilState Identity (MS (r Class))
forall a b.
(a -> b)
-> StateT DrasilState Identity a -> StateT DrasilState Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [MS (r Class)] -> MS (r Class)
forall (r :: * -> *) smt.
BodySym r smt =>
[MS (r Class)] -> MS (r Class)
body (StateT DrasilState Identity [MS (r Class)]
 -> StateT DrasilState Identity (MS (r Class)))
-> StateT DrasilState Identity [MS (r Class)]
-> StateT DrasilState Identity (MS (r Class))
forall a b. (a -> b) -> a -> b
$ StateT DrasilState Identity (MS (r Class))
-> StateT DrasilState Identity [MS (r Class)]
forall a b. State a b -> State a [b]
liftS (StateT DrasilState Identity (MS (r Class))
 -> StateT DrasilState Identity [MS (r Class)])
-> StateT DrasilState Identity (MS (r Class))
-> StateT DrasilState Identity [MS (r Class)]
forall a b. (a -> b) -> a -> b
$ CalcType
-> CodeDefinition
-> CodeExpr
-> StateT DrasilState Identity (MS (r Class))
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
CalcType -> CodeDefinition -> CodeExpr -> GenState (MS (r Class))
genCalcBlockProc CalcType
t CodeDefinition
v CodeExpr
e
        ifEs :: Completeness -> [(CodeExpr, CodeExpr)]
ifEs Completeness
Complete = [(CodeExpr, CodeExpr)] -> [(CodeExpr, CodeExpr)]
forall a. HasCallStack => [a] -> [a]
init [(CodeExpr, CodeExpr)]
cs
        ifEs Completeness
Incomplete = [(CodeExpr, CodeExpr)]
cs
        elseE :: Completeness -> StateT DrasilState Identity (MS (r Class))
elseE Completeness
Complete = CodeExpr -> StateT DrasilState Identity (MS (r Class))
forall {r :: * -> *} {smt}.
(TypeElim r, NativeVector r, SharedStatement r smt) =>
CodeExpr -> StateT DrasilState Identity (MS (r Class))
calcBody (CodeExpr -> StateT DrasilState Identity (MS (r Class)))
-> CodeExpr -> StateT DrasilState Identity (MS (r Class))
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. HasCallStack => [a] -> a
last [(CodeExpr, CodeExpr)]
cs
        elseE Completeness
Incomplete = MS (r Class) -> StateT DrasilState Identity (MS (r Class))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (MS (r Class) -> StateT DrasilState Identity (MS (r Class)))
-> MS (r Class) -> StateT DrasilState Identity (MS (r Class))
forall a b. (a -> b) -> a -> b
$ MS (r smt) -> MS (r Class)
forall (r :: * -> *) smt.
BodySym r smt =>
MS (r smt) -> MS (r Class)
oneLiner (MS (r smt) -> MS (r Class)) -> MS (r smt) -> MS (r Class)
forall a b. (a -> b) -> a -> b
$ String -> MS (r smt)
forall (r :: * -> *) smt.
ControlStatement r smt =>
String -> MS (r smt)
throw (String -> MS (r smt)) -> String -> MS (r smt)
forall a b. (a -> b) -> a -> b
$
          String
"Undefined case encountered in function " String -> String -> String
forall a. [a] -> [a] -> [a]
++ CodeDefinition -> String
forall c. CodeIdea c => c -> String
codeName CodeDefinition
v

-- | | Generates a function for reading inputs from a file.
genInputFormatProc
  :: (SharedProg r vis smt md, NativeVector r)
  => VisibilityTag -> GenState (Maybe (MS (r md)))
genInputFormatProc :: forall (r :: * -> *) vis smt md.
(SharedProg r vis smt md, NativeVector r) =>
VisibilityTag -> GenState (Maybe (MS (r md)))
genInputFormatProc VisibilityTag
s = do
  DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  (DrasilState -> DrasilState) -> StateT DrasilState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\DrasilState
st -> DrasilState
st {currentScope = Local})
  DataDesc
dd <- GenState DataDesc
genDataDesc
  String
giName <- InternalConcept -> GenState String
genICName InternalConcept
GetInput
  let getFunc :: VisibilityTag
-> String
-> String
-> [CodeVarChunk]
-> [CodeVarChunk]
-> [MS (r Class)]
-> GenState (MS (r md))
getFunc VisibilityTag
Pub = String
-> String
-> [CodeVarChunk]
-> [CodeVarChunk]
-> [MS (r Class)]
-> GenState (MS (r md))
forall (r :: * -> *) vis smt md.
SharedProg r vis smt md =>
String
-> String
-> [CodeVarChunk]
-> [CodeVarChunk]
-> [MS (r Class)]
-> GenState (MS (r md))
publicInOutFuncProc
      getFunc VisibilityTag
Priv = String
-> String
-> [CodeVarChunk]
-> [CodeVarChunk]
-> [MS (r Class)]
-> GenState (MS (r md))
forall (r :: * -> *) vis smt md.
SharedProg r vis smt md =>
String
-> String
-> [CodeVarChunk]
-> [CodeVarChunk]
-> [MS (r Class)]
-> GenState (MS (r md))
privateInOutFuncProc
      genInFormat
        :: (SharedProg r vis smt md, NativeVector r)
        => Bool -> GenState (Maybe (MS (r md)))
      genInFormat :: forall (r :: * -> *) vis smt md.
(SharedProg r vis smt md, NativeVector r) =>
Bool -> GenState (Maybe (MS (r md)))
genInFormat Bool
False = Maybe (MS (r md))
-> StateT DrasilState Identity (Maybe (MS (r md)))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MS (r md))
forall a. Maybe a
Nothing
      genInFormat Bool
_ = do
        [CodeVarChunk]
ins <- GenState [CodeVarChunk]
getInputFormatIns
        [CodeVarChunk]
outs <- GenState [CodeVarChunk]
getInputFormatOuts
        [MS (r Class)]
bod <- DataDesc -> GenState [MS (r Class)]
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
DataDesc -> GenState [MS (r Class)]
readDataProc DataDesc
dd
        String
desc <- GenState String
inFmtFuncDesc
        MS (r md)
mthd <- VisibilityTag
-> String
-> String
-> [CodeVarChunk]
-> [CodeVarChunk]
-> [MS (r Class)]
-> GenState (MS (r md))
forall {r :: * -> *} {vis} {smt} {md}.
SharedProg r vis smt md =>
VisibilityTag
-> String
-> String
-> [CodeVarChunk]
-> [CodeVarChunk]
-> [MS (r Class)]
-> GenState (MS (r md))
getFunc VisibilityTag
s String
giName String
desc [CodeVarChunk]
ins [CodeVarChunk]
outs [MS (r Class)]
bod
        Maybe (MS (r md))
-> StateT DrasilState Identity (Maybe (MS (r md)))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MS (r md))
 -> StateT DrasilState Identity (Maybe (MS (r md))))
-> Maybe (MS (r md))
-> StateT DrasilState Identity (Maybe (MS (r md)))
forall a b. (a -> b) -> a -> b
$ MS (r md) -> Maybe (MS (r md))
forall a. a -> Maybe a
Just MS (r md)
mthd
  Bool -> GenState (Maybe (MS (r md)))
forall (r :: * -> *) vis smt md.
(SharedProg r vis smt md, NativeVector r) =>
Bool -> GenState (Maybe (MS (r md)))
genInFormat (Bool -> GenState (Maybe (MS (r md))))
-> Bool -> GenState (Maybe (MS (r md)))
forall a b. (a -> b) -> a -> b
$ String
giName String -> Set String -> Bool
forall a. Eq a => a -> Set a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` DrasilState -> Set String
defSet DrasilState
g

-- | Generates a function for calculating derived inputs.
genInputDerivedProc
  :: (SharedProg r vis smt md, NativeVector r)
  => VisibilityTag -> GenState (Maybe (MS (r md)))
genInputDerivedProc :: forall (r :: * -> *) vis smt md.
(SharedProg r vis smt md, NativeVector r) =>
VisibilityTag -> GenState (Maybe (MS (r md)))
genInputDerivedProc VisibilityTag
s = do
  DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  (DrasilState -> DrasilState) -> StateT DrasilState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\DrasilState
st -> DrasilState
st {currentScope = Local})
  String
dvName <- InternalConcept -> GenState String
genICName InternalConcept
DerivedValuesFn
  let dvals :: [CodeDefinition]
dvals = DrasilState
g DrasilState
-> Getting [CodeDefinition] DrasilState [CodeDefinition]
-> [CodeDefinition]
forall s a. s -> Getting a s a -> a
^. Getting [CodeDefinition] DrasilState [CodeDefinition]
forall c. HasCodeSpec c => Lens' c [CodeDefinition]
Lens' DrasilState [CodeDefinition]
derivedInputs
      getFunc :: VisibilityTag
-> String
-> String
-> [CodeVarChunk]
-> [CodeVarChunk]
-> [MS (r Class)]
-> GenState (MS (r md))
getFunc VisibilityTag
Pub = String
-> String
-> [CodeVarChunk]
-> [CodeVarChunk]
-> [MS (r Class)]
-> GenState (MS (r md))
forall (r :: * -> *) vis smt md.
SharedProg r vis smt md =>
String
-> String
-> [CodeVarChunk]
-> [CodeVarChunk]
-> [MS (r Class)]
-> GenState (MS (r md))
publicInOutFuncProc
      getFunc VisibilityTag
Priv = String
-> String
-> [CodeVarChunk]
-> [CodeVarChunk]
-> [MS (r Class)]
-> GenState (MS (r md))
forall (r :: * -> *) vis smt md.
SharedProg r vis smt md =>
String
-> String
-> [CodeVarChunk]
-> [CodeVarChunk]
-> [MS (r Class)]
-> GenState (MS (r md))
privateInOutFuncProc
      genDerived
        :: (SharedProg r vis smt md, NativeVector r)
        => Bool -> GenState (Maybe (MS (r md)))
      genDerived :: forall (r :: * -> *) vis smt md.
(SharedProg r vis smt md, NativeVector r) =>
Bool -> GenState (Maybe (MS (r md)))
genDerived Bool
False = Maybe (MS (r md))
-> StateT DrasilState Identity (Maybe (MS (r md)))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MS (r md))
forall a. Maybe a
Nothing
      genDerived Bool
_ = do
        [CodeVarChunk]
ins <- GenState [CodeVarChunk]
getDerivedIns
        [CodeVarChunk]
outs <- GenState [CodeVarChunk]
getDerivedOuts
        [MS (r Class)]
bod <- (CodeDefinition -> StateT DrasilState Identity (MS (r Class)))
-> [CodeDefinition] -> StateT DrasilState Identity [MS (r Class)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\CodeDefinition
x -> CalcType
-> CodeDefinition
-> CodeExpr
-> StateT DrasilState Identity (MS (r Class))
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
CalcType -> CodeDefinition -> CodeExpr -> GenState (MS (r Class))
genCalcBlockProc 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
Lens' CodeDefinition CodeExpr
codeExpr)) [CodeDefinition]
dvals
        String
desc <- GenState String
dvFuncDesc
        MS (r md)
mthd <- VisibilityTag
-> String
-> String
-> [CodeVarChunk]
-> [CodeVarChunk]
-> [MS (r Class)]
-> GenState (MS (r md))
forall {r :: * -> *} {vis} {smt} {md}.
SharedProg r vis smt md =>
VisibilityTag
-> String
-> String
-> [CodeVarChunk]
-> [CodeVarChunk]
-> [MS (r Class)]
-> GenState (MS (r md))
getFunc VisibilityTag
s String
dvName String
desc [CodeVarChunk]
ins [CodeVarChunk]
outs [MS (r Class)]
bod
        Maybe (MS (r md))
-> StateT DrasilState Identity (Maybe (MS (r md)))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MS (r md))
 -> StateT DrasilState Identity (Maybe (MS (r md))))
-> Maybe (MS (r md))
-> StateT DrasilState Identity (Maybe (MS (r md)))
forall a b. (a -> b) -> a -> b
$ MS (r md) -> Maybe (MS (r md))
forall a. a -> Maybe a
Just MS (r md)
mthd
  Bool -> GenState (Maybe (MS (r md)))
forall (r :: * -> *) vis smt md.
(SharedProg r vis smt md, NativeVector r) =>
Bool -> GenState (Maybe (MS (r md)))
genDerived (Bool -> GenState (Maybe (MS (r md))))
-> Bool -> GenState (Maybe (MS (r md)))
forall a b. (a -> b) -> a -> b
$ String
dvName String -> Set String -> Bool
forall a. Eq a => a -> Set a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` DrasilState -> Set String
defSet DrasilState
g

-- | Generates function that checks constraints on the input.
genInputConstraintsProc
  :: (SharedProg r vis smt md, NativeVector r)
  => VisibilityTag -> GenState (Maybe (MS (r md)))
genInputConstraintsProc :: forall (r :: * -> *) vis smt md.
(SharedProg r vis smt md, NativeVector r) =>
VisibilityTag -> GenState (Maybe (MS (r md)))
genInputConstraintsProc VisibilityTag
s = do
  DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  (DrasilState -> DrasilState) -> StateT DrasilState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\DrasilState
st -> DrasilState
st {currentScope = Local})
  String
icName <- InternalConcept -> GenState String
genICName InternalConcept
InputConstraintsFn
  let cm :: ConstraintCEMap
cm = DrasilState
g DrasilState
-> Getting ConstraintCEMap DrasilState ConstraintCEMap
-> ConstraintCEMap
forall s a. s -> Getting a s a -> a
^. Getting ConstraintCEMap DrasilState ConstraintCEMap
forall c. HasCodeSpec c => Lens' c ConstraintCEMap
Lens' DrasilState ConstraintCEMap
cMap
      getFunc :: VisibilityTag
-> String
-> VS (r TypeData)
-> String
-> [ParameterChunk]
-> Maybe String
-> [MS (r Class)]
-> GenState (MS (r md))
getFunc VisibilityTag
Pub = String
-> VS (r TypeData)
-> String
-> [ParameterChunk]
-> Maybe String
-> [MS (r Class)]
-> GenState (MS (r md))
forall (r :: * -> *) vis smt md.
SharedProg r vis smt md =>
String
-> VS (r TypeData)
-> String
-> [ParameterChunk]
-> Maybe String
-> [MS (r Class)]
-> GenState (MS (r md))
publicFuncProc
      getFunc VisibilityTag
Priv = String
-> VS (r TypeData)
-> String
-> [ParameterChunk]
-> Maybe String
-> [MS (r Class)]
-> GenState (MS (r md))
forall (r :: * -> *) vis smt md.
SharedProg r vis smt md =>
String
-> VS (r TypeData)
-> String
-> [ParameterChunk]
-> Maybe String
-> [MS (r Class)]
-> GenState (MS (r md))
privateFuncProc
      genConstraints
        :: (SharedProg r vis smt md, NativeVector r)
        => Bool -> GenState (Maybe (MS (r md)))
      genConstraints :: forall (r :: * -> *) vis smt md.
(SharedProg r vis smt md, NativeVector r) =>
Bool -> GenState (Maybe (MS (r md)))
genConstraints Bool
False = Maybe (MS (r md))
-> StateT DrasilState Identity (Maybe (MS (r md)))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MS (r md))
forall a. Maybe a
Nothing
      genConstraints Bool
_ = do
        [CodeVarChunk]
parms <- GenState [CodeVarChunk]
getConstraintParams
        let varsList :: [CodeVarChunk]
varsList = (CodeVarChunk -> Bool) -> [CodeVarChunk] -> [CodeVarChunk]
forall a. (a -> Bool) -> [a] -> [a]
filter (\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 => Getter c UID
Getter CodeVarChunk UID
uid) ConstraintCEMap
cm) (DrasilState
g DrasilState
-> Getting [CodeVarChunk] DrasilState [CodeVarChunk]
-> [CodeVarChunk]
forall s a. s -> Getting a s a -> a
^. Getting [CodeVarChunk] DrasilState [CodeVarChunk]
forall c. HasCodeSpec c => Lens' c [CodeVarChunk]
Lens' DrasilState [CodeVarChunk]
inputs)
            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 smt)]
sf <- [(CodeVarChunk, [ConstraintCE])] -> GenState [MS (r smt)]
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
[(CodeVarChunk, [ConstraintCE])] -> GenState [MS (r smt)]
sfwrCBodyProc [(CodeVarChunk, [ConstraintCE])]
sfwrCs
        [MS (r smt)]
ph <- [(CodeVarChunk, [ConstraintCE])] -> GenState [MS (r smt)]
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
[(CodeVarChunk, [ConstraintCE])] -> GenState [MS (r smt)]
physCBodyProc [(CodeVarChunk, [ConstraintCE])]
physCs
        String
desc <- GenState String
inConsFuncDesc
        MS (r md)
mthd <- VisibilityTag
-> String
-> VS (r TypeData)
-> String
-> [ParameterChunk]
-> Maybe String
-> [MS (r Class)]
-> GenState (MS (r md))
forall {r :: * -> *} {vis} {smt} {md}.
SharedProg r vis smt md =>
VisibilityTag
-> String
-> VS (r TypeData)
-> String
-> [ParameterChunk]
-> Maybe String
-> [MS (r Class)]
-> GenState (MS (r md))
getFunc VisibilityTag
s String
icName VS (r TypeData)
forall (r :: * -> *). TypeSym r => VS (r TypeData)
void String
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 String
forall a. Maybe a
Nothing [[MS (r smt)] -> MS (r Class)
forall (r :: * -> *) smt.
BlockSym r smt =>
[MS (r smt)] -> MS (r Class)
block [MS (r smt)]
sf, [MS (r smt)] -> MS (r Class)
forall (r :: * -> *) smt.
BlockSym r smt =>
[MS (r smt)] -> MS (r Class)
block [MS (r smt)]
ph]
        Maybe (MS (r md))
-> StateT DrasilState Identity (Maybe (MS (r md)))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MS (r md))
 -> StateT DrasilState Identity (Maybe (MS (r md))))
-> Maybe (MS (r md))
-> StateT DrasilState Identity (Maybe (MS (r md)))
forall a b. (a -> b) -> a -> b
$ MS (r md) -> Maybe (MS (r md))
forall a. a -> Maybe a
Just MS (r md)
mthd
  Bool -> GenState (Maybe (MS (r md)))
forall (r :: * -> *) vis smt md.
(SharedProg r vis smt md, NativeVector r) =>
Bool -> GenState (Maybe (MS (r md)))
genConstraints (Bool -> GenState (Maybe (MS (r md))))
-> Bool -> GenState (Maybe (MS (r md)))
forall a b. (a -> b) -> a -> b
$ String
icName String -> Set String -> Bool
forall a. Eq a => a -> Set a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` DrasilState -> Set String
defSet DrasilState
g

-- | Generates input constraints code block for checking software constraints.
sfwrCBodyProc
  :: (NativeVector r, SharedStatement r smt, TypeElim r)
 => [(CodeVarChunk, [ConstraintCE])] -> GenState [MS (r smt)]
sfwrCBodyProc :: forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
[(CodeVarChunk, [ConstraintCE])] -> GenState [MS (r smt)]
sfwrCBodyProc [(CodeVarChunk, [ConstraintCE])]
cs = do
  DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  let cb :: ConstraintBehaviour
cb = DrasilState
g DrasilState
-> Getting ConstraintBehaviour DrasilState ConstraintBehaviour
-> ConstraintBehaviour
forall s a. s -> Getting a s a -> a
^. Getting ConstraintBehaviour DrasilState ConstraintBehaviour
forall a. HasChoices a => Lens' a ConstraintBehaviour
Lens' DrasilState ConstraintBehaviour
onSfwrC
  ConstraintBehaviour
-> [(CodeVarChunk, [ConstraintCE])] -> GenState [MS (r smt)]
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
ConstraintBehaviour
-> [(CodeVarChunk, [ConstraintCE])] -> GenState [MS (r smt)]
chooseConstrProc ConstraintBehaviour
cb [(CodeVarChunk, [ConstraintCE])]
cs

-- | Generates input constraints code block for checking physical constraints.
physCBodyProc
  :: (NativeVector r, SharedStatement r smt, TypeElim r)
  => [(CodeVarChunk, [ConstraintCE])] -> GenState [MS (r smt)]
physCBodyProc :: forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
[(CodeVarChunk, [ConstraintCE])] -> GenState [MS (r smt)]
physCBodyProc [(CodeVarChunk, [ConstraintCE])]
cs = do
  DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  let cb :: ConstraintBehaviour
cb = DrasilState
g DrasilState
-> Getting ConstraintBehaviour DrasilState ConstraintBehaviour
-> ConstraintBehaviour
forall s a. s -> Getting a s a -> a
^. Getting ConstraintBehaviour DrasilState ConstraintBehaviour
forall a. HasChoices a => Lens' a ConstraintBehaviour
Lens' DrasilState ConstraintBehaviour
onPhysC
  ConstraintBehaviour
-> [(CodeVarChunk, [ConstraintCE])] -> GenState [MS (r smt)]
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
ConstraintBehaviour
-> [(CodeVarChunk, [ConstraintCE])] -> GenState [MS (r smt)]
chooseConstrProc ConstraintBehaviour
cb [(CodeVarChunk, [ConstraintCE])]
cs

-- | Generates conditional statements for checking constraints, where the
-- bodies depend on user's choice of constraint violation behaviour.
chooseConstrProc
  :: (NativeVector r, SharedStatement r smt, TypeElim r)
  => ConstraintBehaviour -> [(CodeVarChunk, [ConstraintCE])] -> GenState [MS (r smt)]
chooseConstrProc :: forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
ConstraintBehaviour
-> [(CodeVarChunk, [ConstraintCE])] -> GenState [MS (r smt)]
chooseConstrProc ConstraintBehaviour
cb [(CodeVarChunk, [ConstraintCE])]
cs = do
  let ch :: [(CodeVarChunk, ConstraintCE)]
ch = ((CodeVarChunk, [ConstraintCE]) -> [(CodeVarChunk, ConstraintCE)])
-> [(CodeVarChunk, [ConstraintCE])]
-> [(CodeVarChunk, ConstraintCE)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(CodeVarChunk
s, [ConstraintCE]
ns) -> [(CodeVarChunk
s, ConstraintCE
n) | ConstraintCE
n <- [ConstraintCE]
ns]) [(CodeVarChunk, [ConstraintCE])]
cs
  -- Generate variable declarations based on constraints
  [MS (r smt)]
varDecs <- ((CodeVarChunk, ConstraintCE)
 -> StateT DrasilState Identity (MS (r smt)))
-> [(CodeVarChunk, ConstraintCE)] -> GenState [MS (r smt)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\case
    (CodeVarChunk
q, Elem ConstraintReason
_ CodeExpr
e) -> CodeVarChunk
-> CodeExpr -> StateT DrasilState Identity (MS (r smt))
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
CodeVarChunk -> CodeExpr -> GenState (MS (r smt))
constrVarDecProc CodeVarChunk
q CodeExpr
e
    (CodeVarChunk, ConstraintCE)
_             -> MS (r smt) -> StateT DrasilState Identity (MS (r smt))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return MS (r smt)
forall (r :: * -> *) smt. StatementSym r smt => MS (r smt)
emptyStmt) [(CodeVarChunk, ConstraintCE)]
ch
  [[SValue r]]
conds <- ((CodeVarChunk, [ConstraintCE])
 -> StateT DrasilState Identity [SValue r])
-> [(CodeVarChunk, [ConstraintCE])]
-> StateT DrasilState Identity [[SValue r]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\(CodeVarChunk
q,[ConstraintCE]
cns) -> (ConstraintCE -> StateT DrasilState Identity (SValue r))
-> [ConstraintCE] -> StateT DrasilState Identity [SValue r]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (CodeExpr -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc (CodeExpr -> StateT DrasilState Identity (SValue r))
-> (ConstraintCE -> CodeExpr)
-> ConstraintCE
-> StateT DrasilState Identity (SValue r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CodeVarChunk -> ConstraintCE -> CodeExpr
forall c. (IsChunk c, HasSymbol c) => c -> ConstraintCE -> CodeExpr
renderC CodeVarChunk
q) [ConstraintCE]
cns) [(CodeVarChunk, [ConstraintCE])]
cs
  [[MS (r Class)]]
bods <- ((CodeVarChunk, [ConstraintCE])
 -> StateT DrasilState Identity [MS (r Class)])
-> [(CodeVarChunk, [ConstraintCE])]
-> StateT DrasilState Identity [[MS (r Class)]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ConstraintBehaviour
-> (CodeVarChunk, [ConstraintCE])
-> StateT DrasilState Identity [MS (r Class)]
forall {r :: * -> *} {smt}.
(SharedStatement r smt, TypeElim r, NativeVector r) =>
ConstraintBehaviour
-> (CodeVarChunk, [ConstraintCE]) -> GenState [MS (r Class)]
chooseCB ConstraintBehaviour
cb) [(CodeVarChunk, [ConstraintCE])]
cs
  let bodies :: [MS (r smt)]
bodies = [[MS (r smt)]] -> [MS (r smt)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[MS (r smt)]] -> [MS (r smt)]) -> [[MS (r smt)]] -> [MS (r smt)]
forall a b. (a -> b) -> a -> b
$ ([SValue r] -> [MS (r Class)] -> [MS (r smt)])
-> [[SValue r]] -> [[MS (r Class)]] -> [[MS (r smt)]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ((SValue r -> MS (r Class) -> MS (r smt))
-> [SValue r] -> [MS (r Class)] -> [MS (r smt)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\SValue r
cond MS (r Class)
bod -> [(SValue r, MS (r Class))] -> MS (r smt)
forall (r :: * -> *) smt.
ControlStatement r smt =>
[(SValue r, MS (r Class))] -> MS (r smt)
ifNoElse [(SValue r -> SValue r
forall (r :: * -> *). BooleanExpression r => SValue r -> SValue r
(?!) SValue r
cond, MS (r Class)
bod)])) [[SValue r]]
conds [[MS (r Class)]]
bods
  [MS (r smt)] -> GenState [MS (r smt)]
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([MS (r smt)] -> GenState [MS (r smt)])
-> [MS (r smt)] -> GenState [MS (r smt)]
forall a b. (a -> b) -> a -> b
$ [MS (r smt)] -> [MS (r smt)] -> [MS (r smt)]
forall a. [a] -> [a] -> [a]
interleave [MS (r smt)]
varDecs [MS (r smt)]
bodies
  where chooseCB :: ConstraintBehaviour
-> (CodeVarChunk, [ConstraintCE]) -> GenState [MS (r Class)]
chooseCB ConstraintBehaviour
Warning = (CodeVarChunk, [ConstraintCE]) -> GenState [MS (r Class)]
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
(CodeVarChunk, [ConstraintCE]) -> GenState [MS (r Class)]
constrWarnProc
        chooseCB ConstraintBehaviour
Exception = (CodeVarChunk, [ConstraintCE]) -> GenState [MS (r Class)]
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
(CodeVarChunk, [ConstraintCE]) -> GenState [MS (r Class)]
constrExcProc

-- | Generates body defining constraint violation behaviour if Warning chosen from 'chooseConstr'.
-- Prints a \"Warning\" message followed by a message that says
-- what value was \"suggested\".
constrWarnProc
  :: (NativeVector r, SharedStatement r smt, TypeElim r)
  => (CodeVarChunk, [ConstraintCE]) -> GenState [MS (r Body)]
constrWarnProc :: forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
(CodeVarChunk, [ConstraintCE]) -> GenState [MS (r Class)]
constrWarnProc (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 smt)]]
msgs <- (ConstraintCE -> StateT DrasilState Identity [MS (r smt)])
-> [ConstraintCE] -> StateT DrasilState Identity [[MS (r smt)]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (CodeVarChunk
-> String
-> ConstraintCE
-> StateT DrasilState Identity [MS (r smt)]
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
CodeVarChunk -> String -> ConstraintCE -> GenState [MS (r smt)]
constraintViolatedMsgProc CodeVarChunk
q String
"suggested") [ConstraintCE]
cs
  [MS (r Class)] -> GenState [MS (r Class)]
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([MS (r Class)] -> GenState [MS (r Class)])
-> [MS (r Class)] -> GenState [MS (r Class)]
forall a b. (a -> b) -> a -> b
$ ([MS (r smt)] -> MS (r Class)) -> [[MS (r smt)]] -> [MS (r Class)]
forall a b. (a -> b) -> [a] -> [b]
map ([MS (r smt)] -> MS (r Class)
forall (r :: * -> *) smt.
BodySym r smt =>
[MS (r smt)] -> MS (r Class)
bodyStatements ([MS (r smt)] -> MS (r Class))
-> ([MS (r smt)] -> [MS (r smt)]) -> [MS (r smt)] -> MS (r Class)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> MS (r smt)
forall (r :: * -> *) smt. IOStatement r smt => String -> MS (r smt)
printStr String
"Warning: " MS (r smt) -> [MS (r smt)] -> [MS (r smt)]
forall a. a -> [a] -> [a]
:)) [[MS (r smt)]]
msgs

-- | Generates body defining constraint violation behaviour if Exception chosen from 'chooseConstr'.
-- Prints a message that says what value was \"expected\",
-- followed by throwing an exception.
constrExcProc
  :: (NativeVector r, SharedStatement r smt, TypeElim r)
  => (CodeVarChunk, [ConstraintCE]) -> GenState [MS (r Body)]
constrExcProc :: forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
(CodeVarChunk, [ConstraintCE]) -> GenState [MS (r Class)]
constrExcProc (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 smt)]]
msgs <- (ConstraintCE -> StateT DrasilState Identity [MS (r smt)])
-> [ConstraintCE] -> StateT DrasilState Identity [[MS (r smt)]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (CodeVarChunk
-> String
-> ConstraintCE
-> StateT DrasilState Identity [MS (r smt)]
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
CodeVarChunk -> String -> ConstraintCE -> GenState [MS (r smt)]
constraintViolatedMsgProc CodeVarChunk
q String
"expected") [ConstraintCE]
cs
  [MS (r Class)] -> GenState [MS (r Class)]
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([MS (r Class)] -> GenState [MS (r Class)])
-> [MS (r Class)] -> GenState [MS (r Class)]
forall a b. (a -> b) -> a -> b
$ ([MS (r smt)] -> MS (r Class)) -> [[MS (r smt)]] -> [MS (r Class)]
forall a b. (a -> b) -> [a] -> [b]
map ([MS (r smt)] -> MS (r Class)
forall (r :: * -> *) smt.
BodySym r smt =>
[MS (r smt)] -> MS (r Class)
bodyStatements ([MS (r smt)] -> MS (r Class))
-> ([MS (r smt)] -> [MS (r smt)]) -> [MS (r smt)] -> MS (r Class)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([MS (r smt)] -> [MS (r smt)] -> [MS (r smt)]
forall a. [a] -> [a] -> [a]
++ [String -> MS (r smt)
forall (r :: * -> *) smt.
ControlStatement r smt =>
String -> MS (r smt)
throw String
"InputError"])) [[MS (r smt)]]
msgs

-- | Generate a set variable dec
constrVarDecProc
  :: (NativeVector r, SharedStatement r smt, TypeElim r)
  => CodeVarChunk -> CodeExpr ->
  GenState (MS (r smt))
constrVarDecProc :: forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
CodeVarChunk -> CodeExpr -> GenState (MS (r smt))
constrVarDecProc CodeVarChunk
v CodeExpr
e = do
  SValue r
lb <- CodeExpr -> GenState (SValue r)
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
e
  CodeType
t <- CodeVarChunk -> StateT DrasilState Identity CodeType
forall c. HasSpace c => c -> StateT DrasilState Identity CodeType
codeType CodeVarChunk
v
  let mkValue :: SVariable r
mkValue = String -> VS (r TypeData) -> SVariable r
forall (r :: * -> *).
VariableSym r =>
String -> VS (r TypeData) -> SVariable r
var (String
"set_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ CodeVarChunk -> String
forall x. HasSymbol x => x -> String
showHasSymbImpl CodeVarChunk
v) (VS (r TypeData) -> VS (r TypeData)
forall (r :: * -> *).
TypeSym r =>
VS (r TypeData) -> VS (r TypeData)
setType (CodeType -> VS (r TypeData)
forall (r :: * -> *). TypeSym r => CodeType -> VS (r TypeData)
convType CodeType
t))
  MS (r smt) -> GenState (MS (r smt))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (SVariable r -> r ScopeData -> SValue r -> MS (r smt)
forall (r :: * -> *) smt.
DeclStatement r smt =>
SVariable r -> r ScopeData -> SValue r -> MS (r smt)
setDecDef SVariable r
mkValue r ScopeData
forall (r :: * -> *). ScopeSym r => r ScopeData
local SValue r
lb)

-- | Generates statements that print a message for when a constraint is violated.
-- Message includes the name of the cosntraint quantity, its value, and a
-- description of the constraint that is violated.
constraintViolatedMsgProc
  :: (NativeVector r, SharedStatement r smt, TypeElim r)
  => CodeVarChunk -> String -> ConstraintCE -> GenState [MS (r smt)]
constraintViolatedMsgProc :: forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
CodeVarChunk -> String -> ConstraintCE -> GenState [MS (r smt)]
constraintViolatedMsgProc CodeVarChunk
q String
s ConstraintCE
c = do
  [MS (r smt)]
pc <- ConstraintCE -> GenState [MS (r smt)]
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
ConstraintCE -> GenState [MS (r smt)]
printConstraintProc ConstraintCE
c
  SValue r
v <- CodeVarChunk -> GenState (SValue r)
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
CodeVarChunk -> GenState (SValue r)
mkValProc (CodeVarChunk -> CodeVarChunk
forall c.
(Quantity c, MayHaveUnit c, Concept c) =>
c -> CodeVarChunk
quantvar CodeVarChunk
q)
  [MS (r smt)] -> GenState [MS (r smt)]
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([MS (r smt)] -> GenState [MS (r smt)])
-> [MS (r smt)] -> GenState [MS (r smt)]
forall a b. (a -> b) -> a -> b
$ [String -> MS (r smt)
forall (r :: * -> *) smt. IOStatement r smt => String -> MS (r smt)
printStr (String -> MS (r smt)) -> String -> MS (r smt)
forall a b. (a -> b) -> a -> b
$ CodeVarChunk -> String
forall c. CodeIdea c => c -> String
codeName CodeVarChunk
q String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" has value ",
    SValue r -> MS (r smt)
forall (r :: * -> *) smt.
IOStatement r smt =>
SValue r -> MS (r smt)
print SValue r
v,
    String -> MS (r smt)
forall (r :: * -> *) smt. IOStatement r smt => String -> MS (r smt)
printStr (String -> MS (r smt)) -> String -> MS (r smt)
forall a b. (a -> b) -> a -> b
$ String
", but is " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" to be "] [MS (r smt)] -> [MS (r smt)] -> [MS (r smt)]
forall a. [a] -> [a] -> [a]
++ [MS (r smt)]
pc

-- | Generates statements to print descriptions of constraints, using words and
-- the constrained values. Constrained values are followed by printing the
-- expression they originated from, using printExpr.
printConstraintProc
  :: (NativeVector r, SharedStatement r smt, TypeElim r)
  => ConstraintCE -> GenState [MS (r smt)]
printConstraintProc :: forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
ConstraintCE -> GenState [MS (r smt)]
printConstraintProc ConstraintCE
c = do
  DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  let db :: PrintingInformation
db = DrasilState -> PrintingInformation
printfo DrasilState
g
      printConstraint'
        :: (NativeVector r, SharedStatement r smt, TypeElim r)
        => ConstraintCE -> GenState [MS (r smt)]
      printConstraint' :: forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
ConstraintCE -> GenState [MS (r smt)]
printConstraint' (Range ConstraintReason
_ (Bounded (Inclusive
_, CodeExpr
e1) (Inclusive
_, CodeExpr
e2))) = do
        SValue r
lb <- CodeExpr -> GenState (SValue r)
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
e1
        SValue r
ub <- CodeExpr -> GenState (SValue r)
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
e2
        [MS (r smt)] -> GenState [MS (r smt)]
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([MS (r smt)] -> GenState [MS (r smt)])
-> [MS (r smt)] -> GenState [MS (r smt)]
forall a b. (a -> b) -> a -> b
$ [String -> MS (r smt)
forall (r :: * -> *) smt. IOStatement r smt => String -> MS (r smt)
printStr String
"between ", SValue r -> MS (r smt)
forall (r :: * -> *) smt.
IOStatement r smt =>
SValue r -> MS (r smt)
print SValue r
lb] [MS (r smt)] -> [MS (r smt)] -> [MS (r smt)]
forall a. [a] -> [a] -> [a]
++ CodeExpr -> PrintingInformation -> [MS (r smt)]
forall (r :: * -> *) smt.
IOStatement r smt =>
CodeExpr -> PrintingInformation -> [MS (r smt)]
printExpr CodeExpr
e1 PrintingInformation
db [MS (r smt)] -> [MS (r smt)] -> [MS (r smt)]
forall a. [a] -> [a] -> [a]
++
          [String -> MS (r smt)
forall (r :: * -> *) smt. IOStatement r smt => String -> MS (r smt)
printStr String
" and ", SValue r -> MS (r smt)
forall (r :: * -> *) smt.
IOStatement r smt =>
SValue r -> MS (r smt)
print SValue r
ub] [MS (r smt)] -> [MS (r smt)] -> [MS (r smt)]
forall a. [a] -> [a] -> [a]
++ CodeExpr -> PrintingInformation -> [MS (r smt)]
forall (r :: * -> *) smt.
IOStatement r smt =>
CodeExpr -> PrintingInformation -> [MS (r smt)]
printExpr CodeExpr
e2 PrintingInformation
db [MS (r smt)] -> [MS (r smt)] -> [MS (r smt)]
forall a. [a] -> [a] -> [a]
++ [String -> MS (r smt)
forall (r :: * -> *) smt. IOStatement r smt => String -> MS (r smt)
printStrLn String
"."]
      printConstraint' (Range ConstraintReason
_ (UpTo (Inclusive
_, CodeExpr
e))) = do
        SValue r
ub <- CodeExpr -> GenState (SValue r)
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
e
        [MS (r smt)] -> GenState [MS (r smt)]
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([MS (r smt)] -> GenState [MS (r smt)])
-> [MS (r smt)] -> GenState [MS (r smt)]
forall a b. (a -> b) -> a -> b
$ [String -> MS (r smt)
forall (r :: * -> *) smt. IOStatement r smt => String -> MS (r smt)
printStr String
"below ", SValue r -> MS (r smt)
forall (r :: * -> *) smt.
IOStatement r smt =>
SValue r -> MS (r smt)
print SValue r
ub] [MS (r smt)] -> [MS (r smt)] -> [MS (r smt)]
forall a. [a] -> [a] -> [a]
++ CodeExpr -> PrintingInformation -> [MS (r smt)]
forall (r :: * -> *) smt.
IOStatement r smt =>
CodeExpr -> PrintingInformation -> [MS (r smt)]
printExpr CodeExpr
e PrintingInformation
db [MS (r smt)] -> [MS (r smt)] -> [MS (r smt)]
forall a. [a] -> [a] -> [a]
++
          [String -> MS (r smt)
forall (r :: * -> *) smt. IOStatement r smt => String -> MS (r smt)
printStrLn String
"."]
      printConstraint' (Range ConstraintReason
_ (UpFrom (Inclusive
_, CodeExpr
e))) = do
        SValue r
lb <- CodeExpr -> GenState (SValue r)
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
e
        [MS (r smt)] -> GenState [MS (r smt)]
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([MS (r smt)] -> GenState [MS (r smt)])
-> [MS (r smt)] -> GenState [MS (r smt)]
forall a b. (a -> b) -> a -> b
$ [String -> MS (r smt)
forall (r :: * -> *) smt. IOStatement r smt => String -> MS (r smt)
printStr String
"above ", SValue r -> MS (r smt)
forall (r :: * -> *) smt.
IOStatement r smt =>
SValue r -> MS (r smt)
print SValue r
lb] [MS (r smt)] -> [MS (r smt)] -> [MS (r smt)]
forall a. [a] -> [a] -> [a]
++ CodeExpr -> PrintingInformation -> [MS (r smt)]
forall (r :: * -> *) smt.
IOStatement r smt =>
CodeExpr -> PrintingInformation -> [MS (r smt)]
printExpr CodeExpr
e PrintingInformation
db [MS (r smt)] -> [MS (r smt)] -> [MS (r smt)]
forall a. [a] -> [a] -> [a]
++ [String -> MS (r smt)
forall (r :: * -> *) smt. IOStatement r smt => String -> MS (r smt)
printStrLn String
"."]
      printConstraint' (Elem ConstraintReason
_ CodeExpr
e) = do
        SValue r
lb <- CodeExpr -> GenState (SValue r)
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
e
        [MS (r smt)] -> GenState [MS (r smt)]
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([MS (r smt)] -> GenState [MS (r smt)])
-> [MS (r smt)] -> GenState [MS (r smt)]
forall a b. (a -> b) -> a -> b
$ [String -> MS (r smt)
forall (r :: * -> *) smt. IOStatement r smt => String -> MS (r smt)
printStr String
"an element of the set ", SValue r -> MS (r smt)
forall (r :: * -> *) smt.
IOStatement r smt =>
SValue r -> MS (r smt)
print SValue r
lb] [MS (r smt)] -> [MS (r smt)] -> [MS (r smt)]
forall a. [a] -> [a] -> [a]
++ [String -> MS (r smt)
forall (r :: * -> *) smt. IOStatement r smt => String -> MS (r smt)
printStrLn String
"."]
  ConstraintCE -> GenState [MS (r smt)]
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
ConstraintCE -> GenState [MS (r smt)]
printConstraint' ConstraintCE
c

-- | Generates a module containing the function for printing outputs.
genOutputModProc
  :: (ProcProg r vis smt md prg, NativeVector r) => GenState [FS (r File)]
genOutputModProc :: forall (r :: * -> *) vis smt md prg.
(ProcProg r vis smt md prg, NativeVector r) =>
GenState [FS (r File)]
genOutputModProc = do
  String
ofName <- InternalConcept -> GenState String
genICName InternalConcept
OutputFormat
  String
ofDesc <- GenState [String] -> GenState String
modDesc (GenState [String] -> GenState String)
-> GenState [String] -> GenState String
forall a b. (a -> b) -> a -> b
$ GenState String -> GenState [String]
forall a b. State a b -> State a [b]
liftS GenState String
outputFormatDesc
  State DrasilState (FS (r File)) -> GenState [FS (r File)]
forall a b. State a b -> State a [b]
liftS (State DrasilState (FS (r File)) -> GenState [FS (r File)])
-> State DrasilState (FS (r File)) -> GenState [FS (r File)]
forall a b. (a -> b) -> a -> b
$ String
-> String
-> [GenState (Maybe (MS (r md)))]
-> State DrasilState (FS (r File))
forall (r :: * -> *) vis smt md prg.
ProcProg r vis smt md prg =>
String
-> String
-> [GenState (Maybe (MS (r md)))]
-> GenState (FS (r File))
genModuleProc String
ofName String
ofDesc [GenState (Maybe (MS (r md)))
forall (r :: * -> *) vis smt md.
(SharedProg r vis smt md, NativeVector r) =>
GenState (Maybe (MS (r md)))
genOutputFormatProc]

-- | Generates a function for printing output values.
genOutputFormatProc
  :: (SharedProg r vis smt md, NativeVector r)
  => GenState (Maybe (MS (r md)))
genOutputFormatProc :: forall (r :: * -> *) vis smt md.
(SharedProg r vis smt md, NativeVector r) =>
GenState (Maybe (MS (r md)))
genOutputFormatProc = do
  DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  (DrasilState -> DrasilState) -> StateT DrasilState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\DrasilState
st -> DrasilState
st {currentScope = Local})
  String
woName <- InternalConcept -> GenState String
genICName InternalConcept
WriteOutput
  let genOutput
        :: (NativeVector r, SharedProg r vis smt md)
        => Maybe String -> GenState (Maybe (MS (r md)))
      genOutput :: forall (r :: * -> *) vis smt md.
(NativeVector r, SharedProg r vis smt md) =>
Maybe String -> GenState (Maybe (MS (r md)))
genOutput Maybe String
Nothing = Maybe (MS (r md))
-> StateT DrasilState Identity (Maybe (MS (r md)))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MS (r md))
forall a. Maybe a
Nothing
      genOutput (Just String
_) = do
        let l_outfile :: String
l_outfile = String
"outputfile"
            var_outfile :: SVariable r
var_outfile = String -> VS (r TypeData) -> SVariable r
forall (r :: * -> *).
VariableSym r =>
String -> VS (r TypeData) -> SVariable r
var String
l_outfile VS (r TypeData)
forall (r :: * -> *). TypeSym r => VS (r TypeData)
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
        let outs :: [CodeVarChunk]
outs = (CodeVarChunk -> CodeVarChunk) -> [CodeVarChunk] -> [CodeVarChunk]
forall a b. (a -> b) -> [a] -> [b]
map (DrasilState -> CodeVarChunk -> CodeVarChunk
resolveOutputDefType DrasilState
g) (DrasilState
g DrasilState
-> Getting [CodeVarChunk] DrasilState [CodeVarChunk]
-> [CodeVarChunk]
forall s a. s -> Getting a s a -> a
^. Getting [CodeVarChunk] DrasilState [CodeVarChunk]
forall c. HasCodeSpec c => Lens' c [CodeVarChunk]
Lens' DrasilState [CodeVarChunk]
outputs)
        [[MS (r smt)]]
outp <- (CodeVarChunk -> StateT DrasilState Identity [MS (r smt)])
-> [CodeVarChunk] -> StateT DrasilState Identity [[MS (r smt)]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\CodeVarChunk
x -> do
          SValue r
v <- CodeVarChunk -> GenState (SValue r)
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
CodeVarChunk -> GenState (SValue r)
mkValProc CodeVarChunk
x
          [MS (r smt)] -> StateT DrasilState Identity [MS (r smt)]
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([MS (r smt)] -> StateT DrasilState Identity [MS (r smt)])
-> [MS (r smt)] -> StateT DrasilState Identity [MS (r smt)]
forall a b. (a -> b) -> a -> b
$
            SValue r -> String -> MS (r smt)
forall (r :: * -> *) smt.
IOStatement r smt =>
SValue r -> String -> MS (r smt)
printFileStr SValue r
v_outfile (CodeVarChunk -> String
forall c. CodeIdea c => c -> String
codeName CodeVarChunk
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" = ")
            MS (r smt) -> [MS (r smt)] -> [MS (r smt)]
forall a. a -> [a] -> [a]
: SValue r -> SValue r -> Space -> [MS (r smt)]
forall (r :: * -> *) smt.
SharedStatement r smt =>
SValue r -> SValue r -> Space -> [MS (r smt)]
writeOutputValue SValue r
v_outfile SValue r
v (CodeVarChunk
x CodeVarChunk -> Getting Space CodeVarChunk Space -> Space
forall s a. s -> Getting a s a -> a
^. Getting Space CodeVarChunk Space
forall c. HasSpace c => Getter c Space
Getter CodeVarChunk Space
typ) ) [CodeVarChunk]
outs
        String
desc <- GenState String
woFuncDesc
        MS (r md)
mthd <- String
-> VS (r TypeData)
-> String
-> [ParameterChunk]
-> Maybe String
-> [MS (r Class)]
-> GenState (MS (r md))
forall (r :: * -> *) vis smt md.
SharedProg r vis smt md =>
String
-> VS (r TypeData)
-> String
-> [ParameterChunk]
-> Maybe String
-> [MS (r Class)]
-> GenState (MS (r md))
publicFuncProc String
woName VS (r TypeData)
forall (r :: * -> *). TypeSym r => VS (r TypeData)
void String
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 String
forall a. Maybe a
Nothing
          [[MS (r smt)] -> MS (r Class)
forall (r :: * -> *) smt.
BlockSym r smt =>
[MS (r smt)] -> MS (r Class)
block ([MS (r smt)] -> MS (r Class)) -> [MS (r smt)] -> MS (r Class)
forall a b. (a -> b) -> a -> b
$ [
          SVariable r -> r ScopeData -> MS (r smt)
forall (r :: * -> *) smt.
DeclStatement r smt =>
SVariable r -> r ScopeData -> MS (r smt)
varDec SVariable r
var_outfile r ScopeData
forall (r :: * -> *). ScopeSym r => r ScopeData
local,
          SVariable r -> SValue r -> MS (r smt)
forall (r :: * -> *) smt.
IOStatement r smt =>
SVariable r -> SValue r -> MS (r smt)
openFileW SVariable r
var_outfile (String -> SValue r
forall (r :: * -> *). Literal r => String -> SValue r
litString String
"output.txt") ] [MS (r smt)] -> [MS (r smt)] -> [MS (r smt)]
forall a. [a] -> [a] -> [a]
++
          [[MS (r smt)]] -> [MS (r smt)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[MS (r smt)]]
outp [MS (r smt)] -> [MS (r smt)] -> [MS (r smt)]
forall a. [a] -> [a] -> [a]
++ [ SValue r -> MS (r smt)
forall (r :: * -> *) smt.
IOStatement r smt =>
SValue r -> MS (r smt)
closeFile SValue r
v_outfile ]]
        Maybe (MS (r md))
-> StateT DrasilState Identity (Maybe (MS (r md)))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MS (r md))
 -> StateT DrasilState Identity (Maybe (MS (r md))))
-> Maybe (MS (r md))
-> StateT DrasilState Identity (Maybe (MS (r md)))
forall a b. (a -> b) -> a -> b
$ MS (r md) -> Maybe (MS (r md))
forall a. a -> Maybe a
Just MS (r md)
mthd
  Maybe String -> GenState (Maybe (MS (r md)))
forall (r :: * -> *) vis smt md.
(NativeVector r, SharedProg r vis smt md) =>
Maybe String -> GenState (Maybe (MS (r md)))
genOutput (Maybe String -> GenState (Maybe (MS (r md))))
-> Maybe String -> GenState (Maybe (MS (r md)))
forall a b. (a -> b) -> a -> b
$ String -> Map String String -> Maybe String
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
woName (DrasilState -> Map String String
eMap DrasilState
g)

writeOutputValue
  :: (SharedStatement r smt)
  => SValue r -> SValue r -> Space -> [MS (r smt)]
writeOutputValue :: forall (r :: * -> *) smt.
SharedStatement r smt =>
SValue r -> SValue r -> Space -> [MS (r smt)]
writeOutputValue SValue r
out = SValue r -> Space -> [MS (r smt)]
writeTop
  where
    writeTop :: SValue r -> Space -> [MS (r smt)]
writeTop SValue r
curr (Vect Space
inner) =
      let idx :: SVariable r
idx = String -> VS (r TypeData) -> SVariable r
forall (r :: * -> *).
VariableSym r =>
String -> VS (r TypeData) -> SVariable r
var String
"list_i1" VS (r TypeData)
forall (r :: * -> *). TypeSym r => VS (r TypeData)
int
          vIdx :: SValue r
vIdx = SVariable r -> SValue r
forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
valueOf SVariable r
idx
          elemAt :: SValue r
elemAt = SValue r -> SValue r -> SValue r
forall (r :: * -> *) smt.
List r smt =>
SValue r -> SValue r -> SValue r
listAccess SValue r
curr SValue r
vIdx
      in [ SValue r -> String -> MS (r smt)
forall (r :: * -> *) smt.
IOStatement r smt =>
SValue r -> String -> MS (r smt)
printFileStr SValue r
out String
"["
         , SVariable r
-> SValue r -> SValue r -> SValue r -> MS (r Class) -> MS (r smt)
forall (r :: * -> *) smt.
ControlStatement r smt =>
SVariable r
-> SValue r -> SValue r -> SValue r -> MS (r Class) -> MS (r smt)
forRange SVariable r
idx (Integer -> SValue r
forall (r :: * -> *). Literal r => Integer -> SValue r
litInt Integer
0) (SValue r -> SValue r
forall (r :: * -> *) smt. List r smt => SValue r -> SValue r
listSize SValue r
curr) (Integer -> SValue r
forall (r :: * -> *). Literal r => Integer -> SValue r
litInt Integer
1) (MS (r Class) -> MS (r smt)) -> MS (r Class) -> MS (r smt)
forall a b. (a -> b) -> a -> b
$ [MS (r smt)] -> MS (r Class)
forall (r :: * -> *) smt.
BodySym r smt =>
[MS (r smt)] -> MS (r Class)
bodyStatements ([MS (r smt)] -> MS (r Class)) -> [MS (r smt)] -> MS (r Class)
forall a b. (a -> b) -> a -> b
$
             Integer -> SValue r -> Space -> [MS (r smt)]
forall {t}.
(Show t, Num t) =>
t -> SValue r -> Space -> [MS (r smt)]
writeInner (Integer
2 :: Integer) SValue r
elemAt Space
inner [MS (r smt)] -> [MS (r smt)] -> [MS (r smt)]
forall a. [a] -> [a] -> [a]
++
             [[(SValue r, MS (r Class))] -> MS (r smt)
forall (r :: * -> *) smt.
ControlStatement r smt =>
[(SValue r, MS (r Class))] -> MS (r smt)
ifNoElse [(SValue r
vIdx SValue r -> SValue r -> SValue r
forall (r :: * -> *).
Comparison r =>
SValue r -> SValue r -> SValue r
?< (SValue r -> SValue r
forall (r :: * -> *) smt. List r smt => SValue r -> SValue r
listSize SValue r
curr SValue r -> SValue r -> SValue r
forall (r :: * -> *).
NumericExpression r =>
SValue r -> SValue r -> SValue r
#- Integer -> SValue r
forall (r :: * -> *). Literal r => Integer -> SValue r
litInt Integer
1),
               [MS (r smt)] -> MS (r Class)
forall (r :: * -> *) smt.
BodySym r smt =>
[MS (r smt)] -> MS (r Class)
bodyStatements [SValue r -> String -> MS (r smt)
forall (r :: * -> *) smt.
IOStatement r smt =>
SValue r -> String -> MS (r smt)
printFileStr SValue r
out String
", "])]]
         , SValue r -> String -> MS (r smt)
forall (r :: * -> *) smt.
IOStatement r smt =>
SValue r -> String -> MS (r smt)
printFileStrLn SValue r
out String
"]"
         ]
    writeTop SValue r
curr Space
_ = [SValue r -> SValue r -> MS (r smt)
forall (r :: * -> *) smt.
IOStatement r smt =>
SValue r -> SValue r -> MS (r smt)
printFileLn SValue r
out SValue r
curr]
    writeInner :: t -> SValue r -> Space -> [MS (r smt)]
writeInner t
n SValue r
curr (Vect Space
inner) =
      let idx :: SVariable r
idx = String -> VS (r TypeData) -> SVariable r
forall (r :: * -> *).
VariableSym r =>
String -> VS (r TypeData) -> SVariable r
var (String
"list_i" String -> String -> String
forall a. [a] -> [a] -> [a]
++ t -> String
forall a. Show a => a -> String
show t
n) VS (r TypeData)
forall (r :: * -> *). TypeSym r => VS (r TypeData)
int
          vIdx :: SValue r
vIdx = SVariable r -> SValue r
forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
valueOf SVariable r
idx
          elemAt :: SValue r
elemAt = SValue r -> SValue r -> SValue r
forall (r :: * -> *) smt.
List r smt =>
SValue r -> SValue r -> SValue r
listAccess SValue r
curr SValue r
vIdx
      in [ SValue r -> String -> MS (r smt)
forall (r :: * -> *) smt.
IOStatement r smt =>
SValue r -> String -> MS (r smt)
printFileStr SValue r
out String
"["
         , SVariable r
-> SValue r -> SValue r -> SValue r -> MS (r Class) -> MS (r smt)
forall (r :: * -> *) smt.
ControlStatement r smt =>
SVariable r
-> SValue r -> SValue r -> SValue r -> MS (r Class) -> MS (r smt)
forRange SVariable r
idx (Integer -> SValue r
forall (r :: * -> *). Literal r => Integer -> SValue r
litInt Integer
0) (SValue r -> SValue r
forall (r :: * -> *) smt. List r smt => SValue r -> SValue r
listSize SValue r
curr) (Integer -> SValue r
forall (r :: * -> *). Literal r => Integer -> SValue r
litInt Integer
1) (MS (r Class) -> MS (r smt)) -> MS (r Class) -> MS (r smt)
forall a b. (a -> b) -> a -> b
$ [MS (r smt)] -> MS (r Class)
forall (r :: * -> *) smt.
BodySym r smt =>
[MS (r smt)] -> MS (r Class)
bodyStatements ([MS (r smt)] -> MS (r Class)) -> [MS (r smt)] -> MS (r Class)
forall a b. (a -> b) -> a -> b
$
             t -> SValue r -> Space -> [MS (r smt)]
writeInner (t
n t -> t -> t
forall a. Num a => a -> a -> a
+ t
1) SValue r
elemAt Space
inner [MS (r smt)] -> [MS (r smt)] -> [MS (r smt)]
forall a. [a] -> [a] -> [a]
++
             [[(SValue r, MS (r Class))] -> MS (r smt)
forall (r :: * -> *) smt.
ControlStatement r smt =>
[(SValue r, MS (r Class))] -> MS (r smt)
ifNoElse [(SValue r
vIdx SValue r -> SValue r -> SValue r
forall (r :: * -> *).
Comparison r =>
SValue r -> SValue r -> SValue r
?< (SValue r -> SValue r
forall (r :: * -> *) smt. List r smt => SValue r -> SValue r
listSize SValue r
curr SValue r -> SValue r -> SValue r
forall (r :: * -> *).
NumericExpression r =>
SValue r -> SValue r -> SValue r
#- Integer -> SValue r
forall (r :: * -> *). Literal r => Integer -> SValue r
litInt Integer
1),
               [MS (r smt)] -> MS (r Class)
forall (r :: * -> *) smt.
BodySym r smt =>
[MS (r smt)] -> MS (r Class)
bodyStatements [SValue r -> String -> MS (r smt)
forall (r :: * -> *) smt.
IOStatement r smt =>
SValue r -> String -> MS (r smt)
printFileStr SValue r
out String
", "])]]
         , SValue r -> String -> MS (r smt)
forall (r :: * -> *) smt.
IOStatement r smt =>
SValue r -> String -> MS (r smt)
printFileStr SValue r
out String
"]"
         ]
    writeInner t
_ SValue r
curr Space
_ = [SValue r -> SValue r -> MS (r smt)
forall (r :: * -> *) smt.
IOStatement r smt =>
SValue r -> SValue r -> MS (r smt)
printFile SValue r
out SValue r
curr]