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 (SVariable, SValue, CS, FS, MS, CSStateVar, Class, OOProg,
  BodySym(..), bodyStatements, oneLiner, BlockSym(..), AttachmentSym(..),
  TypeSym(..), VariableSym(..), ScopeSym(..), ScopeData, Literal(..),
  VariableValue(..), CommandLineArgs(..), NumericExpression(..),
  BooleanExpression(..), Comparison(..), List(..), ListStatement(..),
  EmptyStatement(emptyStmt), MultiStatement(multi), ValueStatement,
  AssignStatement(..), DeclStatement(..), OODeclStatement(..), objDecNewNoParams,
  extObjDecNewNoParams, PrintConsole(..), FileHandling(..), PrintFile(..),
  ControlStatement(..), ifNoElse, VisibilitySym(..), MethodSym(..),
  StateVarSym(..), pubDVar, convType, convTypeOO, VisibilityTag(..), TypeElim,
  VariableElim, Set, Reference, Argument, ValueExpression, MathConstant, Array,
  StringStatement, FuncAppStatement, SelfSym, InternalValueExp,
  OOValueExpression)
import Drasil.GProc (ProcProg, NativeVector, ReadFile)

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 stmt mthd stvr attch prg file mod bod block) => GenState (FS (r file))
genMain :: forall (r :: * -> *) vis stmt mthd stvr attch prg file mod bod
       block.
OOProg r vis stmt mthd stvr attch prg file mod bod block =>
GenState (FS (r file))
genMain = String
-> String
-> [GenState (Maybe (MS (r mthd)))]
-> [GenState (Maybe (CS (r Class)))]
-> GenState (FS (r file))
forall (r :: * -> *) vis stmt mthd stvr attch prg file mod bod
       block.
OOProg r vis stmt mthd stvr attch prg file mod bod block =>
String
-> String
-> [GenState (Maybe (MS (r mthd)))]
-> [GenState (Maybe (CS (r Class)))]
-> GenState (FS (r file))
genModule String
"Control" String
"Controls the flow of the program"
  [GenState (Maybe (MS (r mthd)))
forall (r :: * -> *) vis stmt mthd stvr attch prg file mod bod
       block.
OOProg r vis stmt mthd stvr attch prg file mod bod block =>
GenState (Maybe (MS (r mthd)))
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 stmt mthd stvr attch prg file mod bod block)
  => GenState (Maybe (MS (r mthd)))
genMainFunc :: forall (r :: * -> *) vis stmt mthd stvr attch prg file mod bod
       block.
OOProg r vis stmt mthd stvr attch prg file mod bod block =>
GenState (Maybe (MS (r mthd)))
genMainFunc = do
    g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
    let mainFunc ImplementationType
Library = Maybe (MS (r mthd))
-> StateT DrasilState Identity (Maybe (MS (r mthd)))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MS (r mthd))
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})
          v_filename <- Input -> GenState (SVariable r)
forall (r :: * -> *).
(SelfSym r, VariableElim r, VariableValue r) =>
Input -> GenState (SVariable r)
mkVar (DefinedQuantityDict -> Input
forall c. (Quantity c, MayHaveUnit c, Concept c) => c -> Input
quantvar DefinedQuantityDict
inFileName)
          co <- initConsts
          ip <- getInputDecl
          ics <- genAllInputCalls
          varDef <- mapM genCalcCall (g ^. execOrder)
          wo <- genOutputCall
          return $ Just $
            (if CommentFunc `elem` g ^. commented
              then docMain
              else mainFunction)
            $ bodyStatements $ initLogFileVar (g ^. logKind) mainFn
              ++ [varDecDef v_filename mainFn (arg 0)]
              -- Constants must be declared before inputs because some derived
              -- input definitions or input constraints may use the constants
              ++ catMaybes [co, ip] ++ ics ++ catMaybes (varDef ++ [wo])
    mainFunc $ g ^. 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
  ::
    ( Argument r
    , Literal r
    , MathConstant r
    , VariableValue r
    , BooleanExpression r
    , Comparison r
    , NumericExpression r
    , SelfSym r
    , InternalValueExp r
    , OOValueExpression r
    , List r
    , Reference r
    , Set r
    , MultiStatement r stmt
    , OODeclStatement r stmt bod
    , TypeElim r
    , VariableElim r
    )
  => GenState (Maybe (MS (r stmt)))
getInputDecl :: forall (r :: * -> *) stmt bod.
(Argument r, Literal r, MathConstant r, VariableValue r,
 BooleanExpression r, Comparison r, NumericExpression r, SelfSym r,
 InternalValueExp r, OOValueExpression r, List r, Reference r,
 Set r, MultiStatement r stmt, OODeclStatement r stmt bod,
 TypeElim r, VariableElim r) =>
GenState (Maybe (MS (r stmt)))
getInputDecl = do
  g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  let 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
  v_params <- mkVar (quantvar inParams)
  constrParams <- getInConstructorParams
  cps <- mapM mkVal constrParams
  cname <- genICName InputParameters
  let getDecl ([],[]) = ([Input], [Input])
-> ConstantRepr
-> ConstantStructure
-> StateT DrasilState Identity (Maybe (MS (r stmt)))
constIns ((Input -> Bool) -> [Input] -> ([Input], [Input])
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) -> (Input -> String) -> Input -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        Input -> String
forall c. CodeIdea c => c -> String
codeName) ((Const -> Input) -> [Const] -> [Input]
forall a b. (a -> b) -> [a] -> [b]
map Const -> Input
forall c. (Quantity c, MayHaveUnit c, Concept c) => c -> Input
quantvar ([Const] -> [Input]) -> [Const] -> [Input]
forall a b. (a -> b) -> a -> b
$ DrasilState
g DrasilState -> Getting [Const] DrasilState [Const] -> [Const]
forall s a. s -> Getting a s a -> a
^. Getting [Const] DrasilState [Const]
forall c. HasCodeSpec c => Lens' c [Const]
Lens' DrasilState [Const]
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 ([],[Input]
ins) = do
        vars <- (Input -> GenState (SVariable r))
-> [Input] -> 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 Input -> GenState (SVariable r)
forall (r :: * -> *).
(SelfSym r, VariableElim r, VariableValue r) =>
Input -> GenState (SVariable r)
mkVar [Input]
ins
        return $ Just $ multi $ map (`varDec` scp) vars
      getDecl (Input
i:[Input]
_,[]) = Maybe (MS (r stmt))
-> StateT DrasilState Identity (Maybe (MS (r stmt)))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MS (r stmt))
 -> StateT DrasilState Identity (Maybe (MS (r stmt))))
-> Maybe (MS (r stmt))
-> StateT DrasilState Identity (Maybe (MS (r stmt)))
forall a b. (a -> b) -> a -> b
$ MS (r stmt) -> Maybe (MS (r stmt))
forall a. a -> Maybe a
Just (MS (r stmt) -> Maybe (MS (r stmt)))
-> MS (r stmt) -> Maybe (MS (r stmt))
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
! Input -> String
forall c. CodeIdea c => c -> String
codeName Input
i then SVariable r -> r ScopeData -> [SValue r] -> MS (r stmt)
forall (r :: * -> *) stmt bod.
OODeclStatement r stmt bod =>
SVariable r -> r ScopeData -> [SValue r] -> MS (r stmt)
objDecNew
        else String -> SVariable r -> r ScopeData -> [SValue r] -> MS (r stmt)
forall (r :: * -> *) stmt bod.
OODeclStatement r stmt bod =>
String -> SVariable r -> r ScopeData -> [SValue r] -> MS (r stmt)
extObjDecNew String
cname) SVariable r
v_params r ScopeData
scp [SValue r]
cps
      getDecl ([Input], [Input])
_ = String -> StateT DrasilState Identity (Maybe (MS (r stmt)))
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 ([],[]) ConstantRepr
_ ConstantStructure
_ = Maybe (MS (r stmt))
-> StateT DrasilState Identity (Maybe (MS (r stmt)))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MS (r stmt))
forall a. Maybe a
Nothing
      -- If Const is chosen, don't declare an object because constants are static and accessed through class
      constIns ([Input], [Input])
cs ConstantRepr
Var ConstantStructure
WithInputs = ([Input], [Input])
-> StateT DrasilState Identity (Maybe (MS (r stmt)))
getDecl ([Input], [Input])
cs
      constIns ([Input], [Input])
_ ConstantRepr
_ ConstantStructure
_ = Maybe (MS (r stmt))
-> StateT DrasilState Identity (Maybe (MS (r stmt)))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MS (r stmt))
forall a. Maybe a
Nothing
  getDecl (partition (flip member (eMap g) . codeName)
    (g ^. 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
  ::
    ( Argument r
    , MathConstant r
    , VariableValue r
    , Literal r
    , BooleanExpression r
    , Comparison r
    , NumericExpression r
    , SelfSym r
    , InternalValueExp r
    , OOValueExpression r
    , List r
    , Reference r
    , Set r
    , MultiStatement r stmt
    , OODeclStatement r stmt bod
    , TypeElim r
    , VariableElim r
    )
  => GenState (Maybe (MS (r stmt)))
initConsts :: forall (r :: * -> *) stmt bod.
(Argument r, MathConstant r, VariableValue r, Literal r,
 BooleanExpression r, Comparison r, NumericExpression r, SelfSym r,
 InternalValueExp r, OOValueExpression r, List r, Reference r,
 Set r, MultiStatement r stmt, OODeclStatement r stmt bod,
 TypeElim r, VariableElim r) =>
GenState (Maybe (MS (r stmt)))
initConsts = do
  g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  let 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
  v_consts <- mkVar (quantvar consts)
  cname <- genICName Constants
  let cs = DrasilState
g DrasilState -> Getting [Const] DrasilState [Const] -> [Const]
forall s a. s -> Getting a s a -> a
^. Getting [Const] DrasilState [Const]
forall c. HasCodeSpec c => Lens' c [Const]
Lens' DrasilState [Const]
constDefns
      getDecl (Store Structure
Unbundled) Structure
_ = StateT DrasilState Identity (Maybe (MS (r stmt)))
declVars
      getDecl (Store Structure
Bundled) Structure
_ = (DrasilState -> Maybe (MS (r stmt)))
-> StateT DrasilState Identity (Maybe (MS (r stmt)))
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (\DrasilState
s -> [Const] -> ConstantRepr -> Maybe (MS (r stmt))
declObj [Const]
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 = StateT DrasilState Identity (Maybe (MS (r stmt)))
declVars
      getDecl ConstantStructure
WithInputs Structure
Bundled = Maybe (MS (r stmt))
-> StateT DrasilState Identity (Maybe (MS (r stmt)))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MS (r stmt))
forall a. Maybe a
Nothing
      getDecl ConstantStructure
Inline Structure
_ = Maybe (MS (r stmt))
-> StateT DrasilState Identity (Maybe (MS (r stmt)))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MS (r stmt))
forall a. Maybe a
Nothing
      declVars = do
        vars <- (Const -> GenState (SVariable r))
-> [Const] -> 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 (Input -> GenState (SVariable r)
forall (r :: * -> *).
(SelfSym r, VariableElim r, VariableValue r) =>
Input -> GenState (SVariable r)
mkVar (Input -> GenState (SVariable r))
-> (Const -> Input) -> Const -> GenState (SVariable r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Const -> Input
forall c. (Quantity c, MayHaveUnit c, Concept c) => c -> Input
quantvar) [Const]
cs
        vals <- mapM (convExpr . (^. codeExpr)) cs
        return $ Just $ multi $
          zipWith (\SVariable r
vr -> ConstantRepr
-> SVariable r -> r ScopeData -> SValue r -> MS (r stmt)
forall {r :: * -> *} {stmt} {bod}.
DeclStatement r stmt bod =>
ConstantRepr
-> SVariable r -> r ScopeData -> SValue r -> MS (r stmt)
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) vars vals
      defFunc ConstantRepr
Var = SVariable r -> r ScopeData -> SValue r -> MS (r stmt)
forall (r :: * -> *) stmt bod.
DeclStatement r stmt bod =>
SVariable r -> r ScopeData -> SValue r -> MS (r stmt)
varDecDef
      defFunc ConstantRepr
Const = SVariable r -> r ScopeData -> SValue r -> MS (r stmt)
forall (r :: * -> *) stmt bod.
DeclStatement r stmt bod =>
SVariable r -> r ScopeData -> SValue r -> MS (r stmt)
constDecDef
      declObj [] ConstantRepr
_ = Maybe (MS (r stmt))
forall a. Maybe a
Nothing
      declObj (Const
c:[Const]
_) ConstantRepr
Var = MS (r stmt) -> Maybe (MS (r stmt))
forall a. a -> Maybe a
Just (MS (r stmt) -> Maybe (MS (r stmt)))
-> MS (r stmt) -> Maybe (MS (r stmt))
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
! Const -> String
forall c. CodeIdea c => c -> String
codeName Const
c
        then SVariable r -> r ScopeData -> MS (r stmt)
forall (r :: * -> *) stmt bod.
OODeclStatement r stmt bod =>
SVariable r -> r ScopeData -> MS (r stmt)
objDecNewNoParams else String -> SVariable r -> r ScopeData -> MS (r stmt)
forall (r :: * -> *) stmt bod.
OODeclStatement r stmt bod =>
String -> SVariable r -> r ScopeData -> MS (r stmt)
extObjDecNewNoParams String
cname) SVariable r
v_consts r ScopeData
scp
      declObj [Const]
_ ConstantRepr
Const = Maybe (MS (r stmt))
forall a. Maybe a
Nothing
  getDecl (g ^. conStruct) (g ^. 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 stmt bod) => [Logging] -> r ScopeData -> [MS (r stmt)]
initLogFileVar :: forall (r :: * -> *) stmt bod.
DeclStatement r stmt bod =>
[Logging] -> r ScopeData -> [MS (r stmt)]
initLogFileVar [Logging]
l r ScopeData
scp = [SVariable r -> r ScopeData -> MS (r stmt)
forall (r :: * -> *) stmt bod.
DeclStatement r stmt bod =>
SVariable r -> r ScopeData -> MS (r stmt)
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 stmt mthd stvr attch prg file mod bod block) => GenState [FS (r file)]
genInputMod :: forall (r :: * -> *) vis stmt mthd stvr attch prg file mod bod
       block.
OOProg r vis stmt mthd stvr attch prg file mod bod block =>
GenState [FS (r file)]
genInputMod = do
  ipDesc <- GenState [String] -> GenState String
modDesc GenState [String]
inputParametersDesc
  cname <- genICName InputParameters
  let genMod
        :: (OOProg r vis stmt mthd stvr attch prg file mod bod block)
        => Maybe (CS (r Class)) -> GenState (FS (r file))
      genMod Maybe (CS (r Class))
Nothing = String
-> String
-> [GenState (Maybe (MS (r mthd)))]
-> [GenState (Maybe (CS (r Class)))]
-> GenState (FS (r file))
forall (r :: * -> *) vis stmt mthd stvr attch prg file mod bod
       block.
OOProg r vis stmt mthd stvr attch prg file mod bod block =>
String
-> String
-> [GenState (Maybe (MS (r mthd)))]
-> [GenState (Maybe (CS (r Class)))]
-> GenState (FS (r file))
genModule String
cname String
ipDesc [VisibilityTag -> GenState (Maybe (MS (r mthd)))
forall (r :: * -> *) vis stmt mthd stvr attch prg file mod bod
       block.
OOProg r vis stmt mthd stvr attch prg file mod bod block =>
VisibilityTag -> GenState (Maybe (MS (r mthd)))
genInputFormat VisibilityTag
Pub,
        VisibilityTag -> GenState (Maybe (MS (r mthd)))
forall (r :: * -> *) vis stmt mthd stvr attch prg file mod bod
       block.
OOProg r vis stmt mthd stvr attch prg file mod bod block =>
VisibilityTag -> GenState (Maybe (MS (r mthd)))
genInputDerived VisibilityTag
Pub, VisibilityTag -> GenState (Maybe (MS (r mthd)))
forall (r :: * -> *) vis stmt mthd stvr attch prg file mod bod
       block.
OOProg r vis stmt mthd stvr attch prg file mod bod block =>
VisibilityTag -> GenState (Maybe (MS (r mthd)))
genInputConstraints VisibilityTag
Pub] []
      genMod Maybe (CS (r Class))
_ = String
-> String
-> [GenState (Maybe (MS (r mthd)))]
-> [GenState (Maybe (CS (r Class)))]
-> GenState (FS (r file))
forall (r :: * -> *) vis stmt mthd stvr attch prg file mod bod
       block.
OOProg r vis stmt mthd stvr attch prg file mod bod block =>
String
-> String
-> [GenState (Maybe (MS (r mthd)))]
-> [GenState (Maybe (CS (r Class)))]
-> GenState (FS (r file))
genModule String
cname String
ipDesc [] [ClassType -> GenState (Maybe (CS (r Class)))
forall (r :: * -> *) vis stmt mthd stvr attch prg file mod bod
       block.
OOProg r vis stmt mthd stvr attch prg file mod bod block =>
ClassType -> GenState (Maybe (CS (r Class)))
genInputClass ClassType
Primary]
  ic <- genInputClass Primary
  liftS $ genMod 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 stvr attch) => ConstantRepr ->
  (SVariable r -> SValue r -> CSStateVar r stvr)
constVarFunc :: forall (r :: * -> *) vis stvr attch.
StateVarSym r vis stvr attch =>
ConstantRepr -> SVariable r -> SValue r -> CSStateVar r stvr
constVarFunc ConstantRepr
Var = r vis -> r attch -> SVariable r -> SValue r -> CSStateVar r stvr
forall (r :: * -> *) vis stvr attch.
StateVarSym r vis stvr attch =>
r vis -> r attch -> SVariable r -> SValue r -> CSStateVar r stvr
stateVarDef r vis
forall {k} (r :: k -> *) (vis :: k). VisibilitySym r vis => r vis
public r attch
forall {k} (r :: k -> *) (attch :: k).
AttachmentSym r attch =>
r attch
instanceLevel
constVarFunc ConstantRepr
Const = r vis -> SVariable r -> SValue r -> CSStateVar r stvr
forall (r :: * -> *) vis stvr attch.
StateVarSym r vis stvr attch =>
r vis -> SVariable r -> SValue r -> CSStateVar r stvr
constVar r vis
forall {k} (r :: k -> *) (vis :: k). 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 stmt mthd stvr attch prg file mod bod block)
  => ClassType -> GenState (Maybe (CS (r Class)))
genInputClass :: forall (r :: * -> *) vis stmt mthd stvr attch prg file mod bod
       block.
OOProg r vis stmt mthd stvr attch prg file mod bod block =>
ClassType -> GenState (Maybe (CS (r Class)))
genInputClass ClassType
scp = do
  g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  modify (\DrasilState
st -> DrasilState
st {currentScope = Local})
  cname <- genICName InputParameters
  let ins = DrasilState
g DrasilState -> Getting [Input] DrasilState [Input] -> [Input]
forall s a. s -> Getting a s a -> a
^. Getting [Input] DrasilState [Input]
forall c. HasCodeSpec c => Lens' c [Input]
Lens' DrasilState [Input]
inputs
      cs = DrasilState
g DrasilState -> Getting [Const] DrasilState [Const] -> [Const]
forall s a. s -> Getting a s a -> a
^. Getting [Const] DrasilState [Const]
forall c. HasCodeSpec c => Lens' c [Const]
Lens' DrasilState [Const]
constDefns
      filt :: (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 stmt mthd stvr attch prg file mod bod block) => GenState [MS (r mthd)]
      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 mthd)]] -> [MS (r mthd)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[MS (r mthd)]] -> [MS (r mthd)])
-> StateT DrasilState Identity [[MS (r mthd)]]
-> StateT DrasilState Identity [MS (r mthd)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (StateT DrasilState Identity (Maybe (MS (r mthd)))
 -> StateT DrasilState Identity [MS (r mthd)])
-> [StateT DrasilState Identity (Maybe (MS (r mthd)))]
-> StateT DrasilState Identity [[MS (r mthd)]]
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 mthd)) -> [MS (r mthd)])
-> StateT DrasilState Identity (Maybe (MS (r mthd)))
-> StateT DrasilState Identity [MS (r mthd)]
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 mthd)) -> [MS (r mthd)]
forall a. Maybe a -> [a]
maybeToList) [StateT DrasilState Identity (Maybe (MS (r mthd)))
forall (r :: * -> *) vis stmt mthd stvr attch prg file mod bod
       block.
OOProg r vis stmt mthd stvr attch prg file mod bod block =>
GenState (Maybe (MS (r mthd)))
genInputConstructor]
        else [MS (r mthd)] -> StateT DrasilState Identity [MS (r mthd)]
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return []
      methods
        :: (OOProg r vis stmt mthd stvr attch prg file mod bod block) => GenState [MS (r mthd)]
      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 mthd)]] -> [MS (r mthd)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[MS (r mthd)]] -> [MS (r mthd)])
-> StateT DrasilState Identity [[MS (r mthd)]]
-> StateT DrasilState Identity [MS (r mthd)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (StateT DrasilState Identity (Maybe (MS (r mthd)))
 -> StateT DrasilState Identity [MS (r mthd)])
-> [StateT DrasilState Identity (Maybe (MS (r mthd)))]
-> StateT DrasilState Identity [[MS (r mthd)]]
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 mthd)) -> [MS (r mthd)])
-> StateT DrasilState Identity (Maybe (MS (r mthd)))
-> StateT DrasilState Identity [MS (r mthd)]
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 mthd)) -> [MS (r mthd)]
forall a. Maybe a -> [a]
maybeToList) [VisibilityTag -> StateT DrasilState Identity (Maybe (MS (r mthd)))
forall (r :: * -> *) vis stmt mthd stvr attch prg file mod bod
       block.
OOProg r vis stmt mthd stvr attch prg file mod bod block =>
VisibilityTag -> GenState (Maybe (MS (r mthd)))
genInputFormat VisibilityTag
Priv,
        VisibilityTag -> StateT DrasilState Identity (Maybe (MS (r mthd)))
forall (r :: * -> *) vis stmt mthd stvr attch prg file mod bod
       block.
OOProg r vis stmt mthd stvr attch prg file mod bod block =>
VisibilityTag -> GenState (Maybe (MS (r mthd)))
genInputDerived VisibilityTag
Priv, VisibilityTag -> StateT DrasilState Identity (Maybe (MS (r mthd)))
forall (r :: * -> *) vis stmt mthd stvr attch prg file mod bod
       block.
OOProg r vis stmt mthd stvr attch prg file mod bod block =>
VisibilityTag -> GenState (Maybe (MS (r mthd)))
genInputConstraints VisibilityTag
Priv]
        else [MS (r mthd)] -> StateT DrasilState Identity [MS (r mthd)]
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return []
      genClass
        :: (OOProg r vis stmt mthd stvr attch prg file mod bod block)
        => [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 [Input]
inps [Const]
csts = do
        vals <- (Const -> StateT DrasilState Identity (SValue r))
-> [Const] -> 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 :: * -> *).
(Argument r, MathConstant r, VariableValue r, Literal r,
 BooleanExpression r, Comparison r, NumericExpression r, SelfSym r,
 InternalValueExp r, OOValueExpression r, List r, Reference r,
 Set r, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr (CodeExpr -> StateT DrasilState Identity (SValue r))
-> (Const -> CodeExpr)
-> Const
-> StateT DrasilState Identity (SValue r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Const -> Getting CodeExpr Const CodeExpr -> CodeExpr
forall s a. s -> Getting a s a -> a
^. Getting CodeExpr Const CodeExpr
forall c. DefiningCodeExpr c => Lens' c CodeExpr
Lens' Const CodeExpr
codeExpr)) [Const]
csts
        inputVars <- mapM (\Input
x -> (CodeType -> CSStateVar r stvr)
-> StateT DrasilState Identity CodeType
-> StateT DrasilState Identity (CSStateVar r stvr)
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 stvr
forall (r :: * -> *) vis stvr attch.
StateVarSym r vis stvr attch =>
SVariable r -> CSStateVar r stvr
pubDVar (SVariable r -> CSStateVar r stvr)
-> (CodeType -> SVariable r) -> CodeType -> CSStateVar r stvr
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 (Input -> String
forall c. CodeIdea c => c -> String
codeName Input
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) (Input -> StateT DrasilState Identity CodeType
forall c. HasSpace c => c -> StateT DrasilState Identity CodeType
codeType Input
x)) inps
        constVars <- zipWithM (\Const
c SValue r
vl -> (CodeType -> CSStateVar r stvr)
-> StateT DrasilState Identity CodeType
-> StateT DrasilState Identity (CSStateVar r stvr)
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 stvr
forall (r :: * -> *) vis stvr attch.
StateVarSym r vis stvr attch =>
ConstantRepr -> SVariable r -> SValue r -> CSStateVar r stvr
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 (Const -> String
forall c. CodeIdea c => c -> String
codeName Const
c) (CodeType -> VS (r TypeData)
forall (r :: * -> *). OOTypeSym r => CodeType -> VS (r TypeData)
convTypeOO CodeType
t)) SValue r
vl) (Const -> StateT DrasilState Identity CodeType
forall c. HasSpace c => c -> StateT DrasilState Identity CodeType
codeType Const
c))
          csts vals
        let getFunc ClassType
Primary = String
-> Maybe String
-> String
-> [CSStateVar r stvr]
-> GenState [MS (r mthd)]
-> GenState [MS (r mthd)]
-> GenState (CS (r Class))
forall (r :: * -> *) vis mthd stvr attch.
ClassSym r vis mthd stvr attch =>
String
-> Maybe String
-> String
-> [CSStateVar r stvr]
-> GenState [MS (r mthd)]
-> GenState [MS (r mthd)]
-> GenState (CS (r Class))
primaryClass
            getFunc ClassType
Auxiliary = String
-> Maybe String
-> String
-> [CSStateVar r stvr]
-> GenState [MS (r mthd)]
-> GenState [MS (r mthd)]
-> GenState (CS (r Class))
forall (r :: * -> *) vis mthd stvr attch.
ClassSym r vis mthd stvr attch =>
String
-> Maybe String
-> String
-> [CSStateVar r stvr]
-> GenState [MS (r mthd)]
-> GenState [MS (r mthd)]
-> GenState (CS (r Class))
auxClass
            f = ClassType
-> String
-> Maybe String
-> String
-> [CSStateVar r stvr]
-> GenState [MS (r mthd)]
-> GenState [MS (r mthd)]
-> GenState (CS (r Class))
forall {r :: * -> *} {vis} {stvr} {attch} {mthd}.
ClassSym r vis mthd stvr attch =>
ClassType
-> String
-> Maybe String
-> String
-> [CSStateVar r stvr]
-> GenState [MS (r mthd)]
-> GenState [MS (r mthd)]
-> GenState (CS (r Class))
getFunc ClassType
scp
        icDesc <- inputClassDesc
        c <- f cname Nothing icDesc (inputVars ++ constVars) constructors methods
        return $ Just c
  genClass (filt ins) (filt 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 stmt mthd stvr attch prg file mod bod block)
  => GenState (Maybe (MS (r mthd)))
genInputConstructor :: forall (r :: * -> *) vis stmt mthd stvr attch prg file mod bod
       block.
OOProg r vis stmt mthd stvr attch prg file mod bod block =>
GenState (Maybe (MS (r mthd)))
genInputConstructor = do
  g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  ipName <- genICName InputParameters
  giName <- genICName GetInput
  dvName <- genICName DerivedValuesFn
  icName <- genICName InputConstraintsFn
  let ds = DrasilState -> Set String
defSet DrasilState
g
      genCtor Bool
False = Maybe (MS (r mthd))
-> StateT DrasilState Identity (Maybe (MS (r mthd)))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MS (r mthd))
forall a. Maybe a
Nothing
      genCtor Bool
True = do
        cdesc <- GenState String
inputConstructorDesc
        cparams <- getInConstructorParams
        ics <- genAllInputCalls
        ctor <- genConstructor ipName cdesc (map pcAuto cparams)
          [block ics]
        return $ Just ctor
  genCtor $ any (`elem` ds) [giName,
    dvName, icName]

-- | Generates a function for calculating derived inputs.
genInputDerived
  :: (OOProg r vis stmt mthd stvr attch prg file mod bod block)
  => VisibilityTag -> GenState (Maybe (MS (r mthd)))
genInputDerived :: forall (r :: * -> *) vis stmt mthd stvr attch prg file mod bod
       block.
OOProg r vis stmt mthd stvr attch prg file mod bod block =>
VisibilityTag -> GenState (Maybe (MS (r mthd)))
genInputDerived VisibilityTag
s = do
  g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  modify (\DrasilState
st -> DrasilState
st {currentScope = Local})
  dvName <- genICName DerivedValuesFn
  let dvals = DrasilState
g DrasilState -> Getting [Const] DrasilState [Const] -> [Const]
forall s a. s -> Getting a s a -> a
^. Getting [Const] DrasilState [Const]
forall c. HasCodeSpec c => Lens' c [Const]
Lens' DrasilState [Const]
derivedInputs
      getFunc VisibilityTag
Pub = String
-> String
-> [Input]
-> [Input]
-> [MS (r block)]
-> GenState (MS (r mthd))
forall (r :: * -> *) vis stmt mthd stvr attch prg file mod bod
       block.
OOProg r vis stmt mthd stvr attch prg file mod bod block =>
String
-> String
-> [Input]
-> [Input]
-> [MS (r block)]
-> GenState (MS (r mthd))
publicInOutFunc
      getFunc VisibilityTag
Priv = String
-> String
-> [Input]
-> [Input]
-> [MS (r block)]
-> GenState (MS (r mthd))
forall (r :: * -> *) vis stmt mthd stvr attch prg file mod bod
       block.
OOProg r vis stmt mthd stvr attch prg file mod bod block =>
String
-> String
-> [Input]
-> [Input]
-> [MS (r block)]
-> GenState (MS (r mthd))
privateInOutMethod
      genDerived
        :: (OOProg r vis stmt mthd stvr attch prg file mod bod block)
        => Bool -> GenState (Maybe (MS (r mthd)))
      genDerived Bool
False = Maybe (MS (r mthd))
-> StateT DrasilState Identity (Maybe (MS (r mthd)))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MS (r mthd))
forall a. Maybe a
Nothing
      genDerived Bool
_ = do
        ins <- GenState [Input]
getDerivedIns
        outs <- getDerivedOuts
        bod <- mapM (\Const
x -> CalcType
-> Const -> CodeExpr -> StateT DrasilState Identity (MS (r block))
forall (r :: * -> *) block stmt bod.
(BlockSym r block stmt, BodySym r bod block, Argument r,
 MathConstant r, VariableValue r, Literal r, BooleanExpression r,
 Comparison r, NumericExpression r, SelfSym r, InternalValueExp r,
 OOValueExpression r, List r, Reference r, Set r,
 AssignStatement r stmt, ControlStatement r stmt bod, TypeElim r,
 VariableElim r) =>
CalcType -> Const -> CodeExpr -> GenState (MS (r block))
genCalcBlock CalcType
CalcAssign Const
x (Const
x Const -> Getting CodeExpr Const CodeExpr -> CodeExpr
forall s a. s -> Getting a s a -> a
^. Getting CodeExpr Const CodeExpr
forall c. DefiningCodeExpr c => Lens' c CodeExpr
Lens' Const CodeExpr
codeExpr)) dvals
        desc <- dvFuncDesc
        mthd <- getFunc s dvName desc ins outs bod
        return $ Just mthd
  genDerived $ dvName `elem` defSet g

-- | Generates function that checks constraints on the input.
genInputConstraints
  :: (OOProg r vis stmt mthd stvr attch prg file mod bod block)
  => VisibilityTag -> GenState (Maybe (MS (r mthd)))
genInputConstraints :: forall (r :: * -> *) vis stmt mthd stvr attch prg file mod bod
       block.
OOProg r vis stmt mthd stvr attch prg file mod bod block =>
VisibilityTag -> GenState (Maybe (MS (r mthd)))
genInputConstraints VisibilityTag
s = do
  g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  modify (\DrasilState
st -> DrasilState
st {currentScope = Local})
  icName <- genICName InputConstraintsFn
  let 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
Pub = String
-> VS (r TypeData)
-> String
-> [ParameterChunk]
-> Maybe String
-> [MS (r block)]
-> GenState (MS (r mthd))
forall (r :: * -> *) vis stmt mthd stvr attch prg file mod bod
       block.
OOProg r vis stmt mthd stvr attch prg file mod bod block =>
String
-> VS (r TypeData)
-> String
-> [ParameterChunk]
-> Maybe String
-> [MS (r block)]
-> GenState (MS (r mthd))
publicFunc
      getFunc VisibilityTag
Priv = String
-> VS (r TypeData)
-> String
-> [ParameterChunk]
-> Maybe String
-> [MS (r block)]
-> GenState (MS (r mthd))
forall (r :: * -> *) vis stmt mthd stvr attch prg file mod bod
       block.
OOProg r vis stmt mthd stvr attch prg file mod bod block =>
String
-> VS (r TypeData)
-> String
-> [ParameterChunk]
-> Maybe String
-> [MS (r block)]
-> GenState (MS (r mthd))
privateMethod
      genConstraints
        :: (OOProg r vis stmt mthd stvr attch prg file mod bod block)
        => Bool -> GenState (Maybe (MS (r mthd)))
      genConstraints Bool
False = Maybe (MS (r mthd))
-> StateT DrasilState Identity (Maybe (MS (r mthd)))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MS (r mthd))
forall a. Maybe a
Nothing
      genConstraints Bool
_ = do
        parms <- GenState [Input]
getConstraintParams
        let varsList = (Input -> Bool) -> [Input] -> [Input]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Input
i -> UID -> ConstraintCEMap -> Bool
forall k a. Ord k => k -> Map k a -> Bool
member (Input
i Input -> Getting UID Input UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID Input UID
forall c. HasUID c => Getter c UID
Getter Input UID
uid) ConstraintCEMap
cm) (DrasilState
g DrasilState -> Getting [Input] DrasilState [Input] -> [Input]
forall s a. s -> Getting a s a -> a
^. Getting [Input] DrasilState [Input]
forall c. HasCodeSpec c => Lens' c [Input]
Lens' DrasilState [Input]
inputs)
            sfwrCs   = (Input -> (Input, [ConstraintCE]))
-> [Input] -> [(Input, [ConstraintCE])]
forall a b. (a -> b) -> [a] -> [b]
map (ConstraintCEMap -> Input -> (Input, [ConstraintCE])
forall q. HasUID q => ConstraintCEMap -> q -> (q, [ConstraintCE])
sfwrLookup ConstraintCEMap
cm) [Input]
varsList
            physCs   = (Input -> (Input, [ConstraintCE]))
-> [Input] -> [(Input, [ConstraintCE])]
forall a b. (a -> b) -> [a] -> [b]
map (ConstraintCEMap -> Input -> (Input, [ConstraintCE])
forall q. HasUID q => ConstraintCEMap -> q -> (q, [ConstraintCE])
physLookup ConstraintCEMap
cm) [Input]
varsList
        sf <- sfwrCBody sfwrCs
        ph <- physCBody physCs
        desc <- inConsFuncDesc
        mthd <- getFunc s icName void desc (map pcAuto parms)
          Nothing [block sf, block ph]
        return $ Just mthd
  genConstraints $ icName `elem` defSet g

-- | Generates input constraints code block for checking software constraints.
sfwrCBody
  ::
    ( BlockSym r block stmt
    , BodySym r bod block
    , Argument r
    , MathConstant r
    , VariableValue r
    , Literal r
    , BooleanExpression r
    , Comparison r
    , NumericExpression r
    , SelfSym r
    , InternalValueExp r
    , OOValueExpression r
    , List r
    , Reference r
    , Set r
    , EmptyStatement r stmt
    , DeclStatement r stmt bod
    , ControlStatement r stmt bod
    , PrintConsole r stmt
    , TypeElim r
    , VariableElim r
    )
  => [(CodeVarChunk, [ConstraintCE])] -> GenState [MS (r stmt)]
sfwrCBody :: forall (r :: * -> *) block stmt bod.
(BlockSym r block stmt, BodySym r bod block, Argument r,
 MathConstant r, VariableValue r, Literal r, BooleanExpression r,
 Comparison r, NumericExpression r, SelfSym r, InternalValueExp r,
 OOValueExpression r, List r, Reference r, Set r,
 EmptyStatement r stmt, DeclStatement r stmt bod,
 ControlStatement r stmt bod, PrintConsole r stmt, TypeElim r,
 VariableElim r) =>
[(Input, [ConstraintCE])] -> GenState [MS (r stmt)]
sfwrCBody [(Input, [ConstraintCE])]
cs = do
  g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  let 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
  chooseConstr cb cs

-- | Generates input constraints code block for checking physical constraints.
physCBody
  ::
    ( BlockSym r block stmt
    , BodySym r bod block
    , Argument r
    , MathConstant r
    , VariableValue r
    , Literal r
    , BooleanExpression r
    , Comparison r
    , NumericExpression r
    , SelfSym r
    , InternalValueExp r
    , OOValueExpression r
    , List r
    , Reference r
    , Set r
    , EmptyStatement r stmt
    , DeclStatement r stmt bod
    , ControlStatement r stmt bod
    , PrintConsole r stmt
    , TypeElim r
    , VariableElim r
    )
  => [(CodeVarChunk, [ConstraintCE])] -> GenState [MS (r stmt)]
physCBody :: forall (r :: * -> *) block stmt bod.
(BlockSym r block stmt, BodySym r bod block, Argument r,
 MathConstant r, VariableValue r, Literal r, BooleanExpression r,
 Comparison r, NumericExpression r, SelfSym r, InternalValueExp r,
 OOValueExpression r, List r, Reference r, Set r,
 EmptyStatement r stmt, DeclStatement r stmt bod,
 ControlStatement r stmt bod, PrintConsole r stmt, TypeElim r,
 VariableElim r) =>
[(Input, [ConstraintCE])] -> GenState [MS (r stmt)]
physCBody [(Input, [ConstraintCE])]
cs = do
  g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  let 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
  chooseConstr cb cs

-- | Generates conditional statements for checking constraints, where the
-- bodies depend on user's choice of constraint violation behaviour.
chooseConstr
  ::
    ( BlockSym r block stmt
    , BodySym r bod block
    , Argument r
    , MathConstant r
    , VariableValue r
    , Literal r
    , BooleanExpression r
    , Comparison r
    , NumericExpression r
    , SelfSym r
    , InternalValueExp r
    , OOValueExpression r
    , List r
    , Reference r
    , Set r
    , EmptyStatement r stmt
    , DeclStatement r stmt bod
    , ControlStatement r stmt bod
    , PrintConsole r stmt
    , TypeElim r
    , VariableElim r
    )
  => ConstraintBehaviour
  -> [(CodeVarChunk, [ConstraintCE])]
  -> GenState [MS (r stmt)]
chooseConstr :: forall (r :: * -> *) block stmt bod.
(BlockSym r block stmt, BodySym r bod block, Argument r,
 MathConstant r, VariableValue r, Literal r, BooleanExpression r,
 Comparison r, NumericExpression r, SelfSym r, InternalValueExp r,
 OOValueExpression r, List r, Reference r, Set r,
 EmptyStatement r stmt, DeclStatement r stmt bod,
 ControlStatement r stmt bod, PrintConsole r stmt, TypeElim r,
 VariableElim r) =>
ConstraintBehaviour
-> [(Input, [ConstraintCE])] -> GenState [MS (r stmt)]
chooseConstr ConstraintBehaviour
cb [(Input, [ConstraintCE])]
cs = do
  let ch :: [(Input, ConstraintCE)]
ch = ((Input, [ConstraintCE]) -> [(Input, ConstraintCE)])
-> [(Input, [ConstraintCE])] -> [(Input, ConstraintCE)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(Input
s, [ConstraintCE]
ns) -> [(Input
s, ConstraintCE
n) | ConstraintCE
n <- [ConstraintCE]
ns]) [(Input, [ConstraintCE])]
cs
  -- Generate variable declarations based on constraints
  varDecs <- ((Input, ConstraintCE)
 -> StateT DrasilState Identity (MS (r stmt)))
-> [(Input, ConstraintCE)]
-> StateT DrasilState Identity [MS (r stmt)]
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
    (Input
q, Elem ConstraintReason
_ CodeExpr
e) -> Input -> CodeExpr -> StateT DrasilState Identity (MS (r stmt))
forall (r :: * -> *) stmt bod.
(Argument r, MathConstant r, VariableValue r, Literal r,
 BooleanExpression r, Comparison r, NumericExpression r, SelfSym r,
 InternalValueExp r, OOValueExpression r, List r, Reference r,
 Set r, DeclStatement r stmt bod, TypeElim r, VariableElim r) =>
Input -> CodeExpr -> GenState (MS (r stmt))
constrVarDec Input
q CodeExpr
e
    (Input, ConstraintCE)
_             -> MS (r stmt) -> StateT DrasilState Identity (MS (r stmt))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return MS (r stmt)
forall {k} (r :: k -> *) (stmt :: k).
EmptyStatement r stmt =>
MS (r stmt)
emptyStmt) [(Input, ConstraintCE)]
ch
  -- Generate conditions for constraints
  conds <- mapM (\(Input
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 :: * -> *).
(Argument r, MathConstant r, VariableValue r, Literal r,
 BooleanExpression r, Comparison r, NumericExpression r, SelfSym r,
 InternalValueExp r, OOValueExpression r, List r, Reference r,
 Set r, 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
. Input -> ConstraintCE -> CodeExpr
forall c. (IsChunk c, HasSymbol c) => c -> ConstraintCE -> CodeExpr
renderC Input
q) [ConstraintCE]
cns) cs
  -- Generate bodies based on constraint behavior
  bods <- mapM (chooseCB cb) cs
  let bodies = [[MS (r stmt)]] -> [MS (r stmt)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[MS (r stmt)]] -> [MS (r stmt)])
-> [[MS (r stmt)]] -> [MS (r stmt)]
forall a b. (a -> b) -> a -> b
$ ([SValue r] -> [MS (r bod)] -> [MS (r stmt)])
-> [[SValue r]] -> [[MS (r bod)]] -> [[MS (r stmt)]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ((SValue r -> MS (r bod) -> MS (r stmt))
-> [SValue r] -> [MS (r bod)] -> [MS (r stmt)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\SValue r
cond MS (r bod)
bod -> [(SValue r, MS (r bod))] -> MS (r stmt)
forall (r :: * -> *) bod block stmt.
(BodySym r bod block, ControlStatement r stmt bod) =>
[(SValue r, MS (r bod))] -> MS (r stmt)
ifNoElse [(SValue r -> SValue r
forall (r :: * -> *). BooleanExpression r => SValue r -> SValue r
(?!) SValue r
cond, MS (r bod)
bod)])) [[SValue r]]
conds [[MS (r bod)]]
bods
  return $ interleave varDecs bodies
  where chooseCB :: ConstraintBehaviour
-> (Input, [ConstraintCE]) -> GenState [MS (r bod)]
chooseCB ConstraintBehaviour
Warning = (Input, [ConstraintCE]) -> GenState [MS (r bod)]
forall (r :: * -> *) stmt block bod.
(Argument r, MathConstant r, VariableValue r, Literal r,
 BooleanExpression r, Comparison r, NumericExpression r, SelfSym r,
 InternalValueExp r, OOValueExpression r, List r, Reference r,
 Set r, PrintConsole r stmt, BlockSym r block stmt,
 BodySym r bod block, TypeElim r, VariableElim r) =>
(Input, [ConstraintCE]) -> GenState [MS (r bod)]
constrWarn
        chooseCB ConstraintBehaviour
Exception = (Input, [ConstraintCE]) -> GenState [MS (r bod)]
forall (r :: * -> *) block stmt bod.
(BlockSym r block stmt, BodySym r bod block, Argument r,
 MathConstant r, VariableValue r, Literal r, BooleanExpression r,
 Comparison r, NumericExpression r, SelfSym r, InternalValueExp r,
 OOValueExpression r, List r, Reference r, Set r,
 ControlStatement r stmt bod, PrintConsole r stmt, TypeElim r,
 VariableElim r) =>
(Input, [ConstraintCE]) -> GenState [MS (r bod)]
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
  ::
    ( Argument r
    , MathConstant r
    , VariableValue r
    , Literal r
    , BooleanExpression r
    , Comparison r
    , NumericExpression r
    , SelfSym r
    , InternalValueExp r
    , OOValueExpression r
    , List r
    , Reference r
    , Set r
    , PrintConsole r stmt
    , BlockSym r block stmt
    , BodySym r bod block
    , TypeElim r
    , VariableElim r
    )
  => (CodeVarChunk, [ConstraintCE]) -> GenState [MS (r bod)]
constrWarn :: forall (r :: * -> *) stmt block bod.
(Argument r, MathConstant r, VariableValue r, Literal r,
 BooleanExpression r, Comparison r, NumericExpression r, SelfSym r,
 InternalValueExp r, OOValueExpression r, List r, Reference r,
 Set r, PrintConsole r stmt, BlockSym r block stmt,
 BodySym r bod block, TypeElim r, VariableElim r) =>
(Input, [ConstraintCE]) -> GenState [MS (r bod)]
constrWarn (Input, [ConstraintCE])
c = do
  let q :: Input
q = (Input, [ConstraintCE]) -> Input
forall a b. (a, b) -> a
fst (Input, [ConstraintCE])
c
      cs :: [ConstraintCE]
cs = (Input, [ConstraintCE]) -> [ConstraintCE]
forall a b. (a, b) -> b
snd (Input, [ConstraintCE])
c
  msgs <- (ConstraintCE -> StateT DrasilState Identity [MS (r stmt)])
-> [ConstraintCE] -> StateT DrasilState Identity [[MS (r stmt)]]
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 (Input
-> String
-> ConstraintCE
-> StateT DrasilState Identity [MS (r stmt)]
forall (r :: * -> *) stmt.
(Argument r, MathConstant r, VariableValue r, Literal r,
 BooleanExpression r, Comparison r, NumericExpression r, SelfSym r,
 InternalValueExp r, OOValueExpression r, List r, Reference r,
 Set r, PrintConsole r stmt, TypeElim r, VariableElim r) =>
Input -> String -> ConstraintCE -> GenState [MS (r stmt)]
constraintViolatedMsg Input
q String
"suggested") [ConstraintCE]
cs
  return $ map (bodyStatements . (printStr "Warning: " :)) 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
  ::
    ( BlockSym r block stmt
    , BodySym r bod block
    , Argument r
    , MathConstant r
    , VariableValue r
    , Literal r
    , BooleanExpression r
    , Comparison r
    , NumericExpression r
    , SelfSym r
    , InternalValueExp r
    , OOValueExpression r
    , List r
    , Reference r
    , Set r
    , ControlStatement r stmt bod
    , PrintConsole r stmt
    , TypeElim r
    , VariableElim r
    )
  => (CodeVarChunk, [ConstraintCE]) -> GenState [MS (r bod)]
constrExc :: forall (r :: * -> *) block stmt bod.
(BlockSym r block stmt, BodySym r bod block, Argument r,
 MathConstant r, VariableValue r, Literal r, BooleanExpression r,
 Comparison r, NumericExpression r, SelfSym r, InternalValueExp r,
 OOValueExpression r, List r, Reference r, Set r,
 ControlStatement r stmt bod, PrintConsole r stmt, TypeElim r,
 VariableElim r) =>
(Input, [ConstraintCE]) -> GenState [MS (r bod)]
constrExc (Input, [ConstraintCE])
c = do
  let q :: Input
q = (Input, [ConstraintCE]) -> Input
forall a b. (a, b) -> a
fst (Input, [ConstraintCE])
c
      cs :: [ConstraintCE]
cs = (Input, [ConstraintCE]) -> [ConstraintCE]
forall a b. (a, b) -> b
snd (Input, [ConstraintCE])
c
  msgs <- (ConstraintCE -> StateT DrasilState Identity [MS (r stmt)])
-> [ConstraintCE] -> StateT DrasilState Identity [[MS (r stmt)]]
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 (Input
-> String
-> ConstraintCE
-> StateT DrasilState Identity [MS (r stmt)]
forall (r :: * -> *) stmt.
(Argument r, MathConstant r, VariableValue r, Literal r,
 BooleanExpression r, Comparison r, NumericExpression r, SelfSym r,
 InternalValueExp r, OOValueExpression r, List r, Reference r,
 Set r, PrintConsole r stmt, TypeElim r, VariableElim r) =>
Input -> String -> ConstraintCE -> GenState [MS (r stmt)]
constraintViolatedMsg Input
q String
"expected") [ConstraintCE]
cs
  return $ map (bodyStatements . (++ [throw "InputError"])) msgs

-- | Generates set variable dec
constrVarDec
  ::
    ( Argument r
    , MathConstant r
    , VariableValue r
    , Literal r
    , BooleanExpression r
    , Comparison r
    , NumericExpression r
    , SelfSym r
    , InternalValueExp r
    , OOValueExpression r
    , List r
    , Reference r
    , Set r
    , DeclStatement r stmt bod
    , TypeElim r
    , VariableElim r
    )
  => CodeVarChunk -> CodeExpr -> GenState (MS (r stmt))
constrVarDec :: forall (r :: * -> *) stmt bod.
(Argument r, MathConstant r, VariableValue r, Literal r,
 BooleanExpression r, Comparison r, NumericExpression r, SelfSym r,
 InternalValueExp r, OOValueExpression r, List r, Reference r,
 Set r, DeclStatement r stmt bod, TypeElim r, VariableElim r) =>
Input -> CodeExpr -> GenState (MS (r stmt))
constrVarDec Input
v CodeExpr
e = do
  lb <- CodeExpr -> GenState (SValue r)
forall (r :: * -> *).
(Argument r, MathConstant r, VariableValue r, Literal r,
 BooleanExpression r, Comparison r, NumericExpression r, SelfSym r,
 InternalValueExp r, OOValueExpression r, List r, Reference r,
 Set r, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr CodeExpr
e
  t <- codeType v
  let 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]
++ Input -> String
forall x. HasSymbol x => x -> String
showHasSymbImpl Input
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))
  return (setDecDef mkValue local 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
  ::
    ( Argument r
    , MathConstant r
    , VariableValue r
    , Literal r
    , BooleanExpression r
    , Comparison r
    , NumericExpression r
    , SelfSym r
    , InternalValueExp r
    , OOValueExpression r
    , List r
    , Reference r
    , Set r
    , PrintConsole r stmt
    , TypeElim r
    , VariableElim r
    )
  => CodeVarChunk -> String -> ConstraintCE -> GenState [MS (r stmt)]
constraintViolatedMsg :: forall (r :: * -> *) stmt.
(Argument r, MathConstant r, VariableValue r, Literal r,
 BooleanExpression r, Comparison r, NumericExpression r, SelfSym r,
 InternalValueExp r, OOValueExpression r, List r, Reference r,
 Set r, PrintConsole r stmt, TypeElim r, VariableElim r) =>
Input -> String -> ConstraintCE -> GenState [MS (r stmt)]
constraintViolatedMsg Input
q String
s ConstraintCE
c = do
  pc <- String -> ConstraintCE -> GenState [MS (r stmt)]
forall (r :: * -> *) stmt.
(Argument r, MathConstant r, VariableValue r, Literal r,
 BooleanExpression r, Comparison r, NumericExpression r, SelfSym r,
 InternalValueExp r, OOValueExpression r, List r, Reference r,
 Set r, PrintConsole r stmt, TypeElim r, VariableElim r) =>
String -> ConstraintCE -> GenState [MS (r stmt)]
printConstraint (Input -> String
forall x. HasSymbol x => x -> String
showHasSymbImpl Input
q) ConstraintCE
c
  v <- mkVal (quantvar q)
  return $ [printStr $ codeName q ++ " has value ",
    print v,
    printStr $ ", but is " ++ s ++ " to be "] ++ 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
  ::
    ( Argument r
    , MathConstant r
    , VariableValue r
    , Literal r
    , BooleanExpression r
    , Comparison r
    , NumericExpression r
    , SelfSym r
    , InternalValueExp r
    , OOValueExpression r
    , List r
    , Reference r
    , Set r
    , PrintConsole r stmt
    , TypeElim r
    , VariableElim r
    )
  => String -> ConstraintCE -> GenState [MS (r stmt)]
printConstraint :: forall (r :: * -> *) stmt.
(Argument r, MathConstant r, VariableValue r, Literal r,
 BooleanExpression r, Comparison r, NumericExpression r, SelfSym r,
 InternalValueExp r, OOValueExpression r, List r, Reference r,
 Set r, PrintConsole r stmt, TypeElim r, VariableElim r) =>
String -> ConstraintCE -> GenState [MS (r stmt)]
printConstraint String
v ConstraintCE
c = do
  g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  let db = DrasilState -> PrintingInformation
printfo DrasilState
g
      printConstraint'
        ::
          ( Argument r
          , MathConstant r
          , VariableValue r
          , Literal r
          , BooleanExpression r
          , Comparison r
          , NumericExpression r
          , SelfSym r
          , InternalValueExp r
          , OOValueExpression r
          , List r
          , Reference r
          , Set r
          , PrintConsole r stmt
          , TypeElim r
          , VariableElim r
          )
        => String -> ConstraintCE -> GenState [MS (r stmt)]
      printConstraint' String
_ (Range ConstraintReason
_ (Bounded (Inclusive
_, CodeExpr
e1) (Inclusive
_, CodeExpr
e2))) = do
        lb <- CodeExpr -> GenState (SValue r)
forall (r :: * -> *).
(Argument r, MathConstant r, VariableValue r, Literal r,
 BooleanExpression r, Comparison r, NumericExpression r, SelfSym r,
 InternalValueExp r, OOValueExpression r, List r, Reference r,
 Set r, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr CodeExpr
e1
        ub <- convExpr e2
        return $ [printStr "between ", print lb] ++ printExpr e1 db ++
          [printStr " and ", print ub] ++ printExpr e2 db ++ [printStrLn "."]
      printConstraint' String
_ (Range ConstraintReason
_ (UpTo (Inclusive
_, CodeExpr
e))) = do
        ub <- CodeExpr -> GenState (SValue r)
forall (r :: * -> *).
(Argument r, MathConstant r, VariableValue r, Literal r,
 BooleanExpression r, Comparison r, NumericExpression r, SelfSym r,
 InternalValueExp r, OOValueExpression r, List r, Reference r,
 Set r, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr CodeExpr
e
        return $ [printStr "below ", print ub] ++ printExpr e db ++
          [printStrLn "."]
      printConstraint' String
_ (Range ConstraintReason
_ (UpFrom (Inclusive
_, CodeExpr
e))) = do
        lb <- CodeExpr -> GenState (SValue r)
forall (r :: * -> *).
(Argument r, MathConstant r, VariableValue r, Literal r,
 BooleanExpression r, Comparison r, NumericExpression r, SelfSym r,
 InternalValueExp r, OOValueExpression r, List r, Reference r,
 Set r, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr CodeExpr
e
        return $ [printStr "above ", print lb] ++ printExpr e db ++ [printStrLn "."]
      printConstraint' String
name (Elem ConstraintReason
_ CodeExpr
e) = do
        lb <- CodeExpr -> GenState (SValue r)
forall (r :: * -> *).
(Argument r, MathConstant r, VariableValue r, Literal r,
 BooleanExpression r, Comparison r, NumericExpression r, SelfSym r,
 InternalValueExp r, OOValueExpression r, List r, Reference r,
 Set r, 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)
        return $ [printStr "an element of the set ", print lb] ++ [printStrLn "."]
  printConstraint' v 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 :: (PrintConsole r stmt) => CodeExpr -> PrintingInformation -> [MS (r stmt)]
printExpr :: forall (r :: * -> *) stmt.
PrintConsole r stmt =>
CodeExpr -> PrintingInformation -> [MS (r stmt)]
printExpr Lit{} PrintingInformation
_     = []
printExpr CodeExpr
e     PrintingInformation
pinfo = [String -> MS (r stmt)
forall (r :: * -> *) stmt.
PrintConsole r stmt =>
String -> MS (r stmt)
printStr (String -> MS (r stmt)) -> String -> MS (r stmt)
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 stmt mthd stvr attch prg file mod bod block)
  => VisibilityTag -> GenState (Maybe (MS (r mthd)))
genInputFormat :: forall (r :: * -> *) vis stmt mthd stvr attch prg file mod bod
       block.
OOProg r vis stmt mthd stvr attch prg file mod bod block =>
VisibilityTag -> GenState (Maybe (MS (r mthd)))
genInputFormat VisibilityTag
s = do
  g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  modify (\DrasilState
st -> DrasilState
st {currentScope = Local})
  dd <- genDataDesc
  giName <- genICName GetInput
  let getFunc VisibilityTag
Pub = String
-> String
-> [Input]
-> [Input]
-> [MS (r block)]
-> GenState (MS (r mthd))
forall (r :: * -> *) vis stmt mthd stvr attch prg file mod bod
       block.
OOProg r vis stmt mthd stvr attch prg file mod bod block =>
String
-> String
-> [Input]
-> [Input]
-> [MS (r block)]
-> GenState (MS (r mthd))
publicInOutFunc
      getFunc VisibilityTag
Priv = String
-> String
-> [Input]
-> [Input]
-> [MS (r block)]
-> GenState (MS (r mthd))
forall (r :: * -> *) vis stmt mthd stvr attch prg file mod bod
       block.
OOProg r vis stmt mthd stvr attch prg file mod bod block =>
String
-> String
-> [Input]
-> [Input]
-> [MS (r block)]
-> GenState (MS (r mthd))
privateInOutMethod
      genInFormat
        :: (OOProg r vis stmt mthd stvr attch prg file mod bod block)
        => Bool -> GenState (Maybe (MS (r mthd)))
      genInFormat Bool
False = Maybe (MS (r mthd))
-> StateT DrasilState Identity (Maybe (MS (r mthd)))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MS (r mthd))
forall a. Maybe a
Nothing
      genInFormat Bool
_ = do
        ins <- GenState [Input]
getInputFormatIns
        outs <- getInputFormatOuts
        bod <- readData dd
        desc <- inFmtFuncDesc
        mthd <- getFunc s giName desc ins outs bod
        return $ Just mthd
  genInFormat $ giName `elem` defSet 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
  g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  return $ junkLine :
    intersperse junkLine (map singleton (g ^. 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
  g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  dd <- genDataDesc
  if hasSampleInput (getSoftwareDossierFiles g) then return . Just $ sampleInput
    (printfo g) dd (getSampleData g) else return Nothing

----- CONSTANTS -----

-- | Generates a module containing the class where constants are stored.
genConstMod
  :: (OOProg r vis stmt mthd stvr attch prg file mod bod block) => GenState [FS (r file)]
genConstMod :: forall (r :: * -> *) vis stmt mthd stvr attch prg file mod bod
       block.
OOProg r vis stmt mthd stvr attch prg file mod bod block =>
GenState [FS (r file)]
genConstMod = do
  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
  cName <- genICName Constants
  liftS $ genModule cName cDesc [] [genConstClass 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 stmt mthd stvr attch prg file mod bod block)
  => ClassType -> GenState (Maybe (CS (r Class)))
genConstClass :: forall (r :: * -> *) vis stmt mthd stvr attch prg file mod bod
       block.
OOProg r vis stmt mthd stvr attch prg file mod bod block =>
ClassType -> GenState (Maybe (CS (r Class)))
genConstClass ClassType
scp = do
  g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  modify (\DrasilState
st -> DrasilState
st {currentScope = Local})
  cname <- genICName Constants
  let cs = DrasilState
g DrasilState -> Getting [Const] DrasilState [Const] -> [Const]
forall s a. s -> Getting a s a -> a
^. Getting [Const] DrasilState [Const]
forall c. HasCodeSpec c => Lens' c [Const]
Lens' DrasilState [Const]
constDefns
      genClass
        :: (OOProg r vis stmt mthd stvr attch prg file mod bod block)
        => [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 [Const]
vs = do
        vals <- (Const -> StateT DrasilState Identity (SValue r))
-> [Const] -> 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 :: * -> *).
(Argument r, MathConstant r, VariableValue r, Literal r,
 BooleanExpression r, Comparison r, NumericExpression r, SelfSym r,
 InternalValueExp r, OOValueExpression r, List r, Reference r,
 Set r, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr (CodeExpr -> StateT DrasilState Identity (SValue r))
-> (Const -> CodeExpr)
-> Const
-> StateT DrasilState Identity (SValue r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Const -> Getting CodeExpr Const CodeExpr -> CodeExpr
forall s a. s -> Getting a s a -> a
^. Getting CodeExpr Const CodeExpr
forall c. DefiningCodeExpr c => Lens' c CodeExpr
Lens' Const CodeExpr
codeExpr)) [Const]
vs
        vars <- mapM (\Const
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 (Const -> String
forall c. CodeIdea c => c -> String
codeName Const
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)
          (Const -> StateT DrasilState Identity CodeType
forall c. HasSpace c => c -> StateT DrasilState Identity CodeType
codeType Const
x)) vs
        let constVars = (SVariable r -> SValue r -> CSStateVar r stvr)
-> [SVariable r] -> [SValue r] -> [CSStateVar r stvr]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (ConstantRepr -> SVariable r -> SValue r -> CSStateVar r stvr
forall (r :: * -> *) vis stvr attch.
StateVarSym r vis stvr attch =>
ConstantRepr -> SVariable r -> SValue r -> CSStateVar r stvr
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
Primary = String
-> Maybe String
-> String
-> [CSStateVar r stvr]
-> GenState [MS (r mthd)]
-> GenState [MS (r mthd)]
-> GenState (CS (r Class))
forall (r :: * -> *) vis mthd stvr attch.
ClassSym r vis mthd stvr attch =>
String
-> Maybe String
-> String
-> [CSStateVar r stvr]
-> GenState [MS (r mthd)]
-> GenState [MS (r mthd)]
-> GenState (CS (r Class))
primaryClass
            getFunc ClassType
Auxiliary = String
-> Maybe String
-> String
-> [CSStateVar r stvr]
-> GenState [MS (r mthd)]
-> GenState [MS (r mthd)]
-> GenState (CS (r Class))
forall (r :: * -> *) vis mthd stvr attch.
ClassSym r vis mthd stvr attch =>
String
-> Maybe String
-> String
-> [CSStateVar r stvr]
-> GenState [MS (r mthd)]
-> GenState [MS (r mthd)]
-> GenState (CS (r Class))
auxClass
            f = ClassType
-> String
-> Maybe String
-> String
-> [CSStateVar r stvr]
-> GenState [MS (r mthd)]
-> GenState [MS (r mthd)]
-> GenState (CS (r Class))
forall {r :: * -> *} {vis} {stvr} {attch} {mthd}.
ClassSym r vis mthd stvr attch =>
ClassType
-> String
-> Maybe String
-> String
-> [CSStateVar r stvr]
-> GenState [MS (r mthd)]
-> GenState [MS (r mthd)]
-> GenState (CS (r Class))
getFunc ClassType
scp
        cDesc <- constClassDesc
        cls <- f cname Nothing cDesc constVars (return []) (return [])
        return $ Just cls
  genClass $ filter (flip member (Map.filter (cname ==) (clsMap g))
    . codeName) cs

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

-- | Generates a module containing calculation functions.
genCalcMod
  :: (OOProg r vis stmt mthd stvr attch prg file mod bod block) => GenState (FS (r file))
genCalcMod :: forall (r :: * -> *) vis stmt mthd stvr attch prg file mod bod
       block.
OOProg r vis stmt mthd stvr attch prg file mod bod block =>
GenState (FS (r file))
genCalcMod = do
  g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  cName <- genICName Calculations
  let elmap = DrasilState -> ExtLibMap
extLibMap DrasilState
g
  genModuleWithImports cName calcModDesc (concatMap (^. imports) $
    elems elmap) (map (fmap Just . genCalcFunc) (g ^. 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 stmt mthd stvr attch prg file mod bod block)
  => CodeDefinition -> GenState (MS (r mthd))
genCalcFunc :: forall (r :: * -> *) vis stmt mthd stvr attch prg file mod bod
       block.
OOProg r vis stmt mthd stvr attch prg file mod bod block =>
Const -> GenState (MS (r mthd))
genCalcFunc Const
cdef = do
  g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  modify (\DrasilState
st -> DrasilState
st {currentScope = Local})
  parms <- getCalcParams cdef
  let nm = Const -> String
forall c. CodeIdea c => c -> String
codeName Const
cdef
  tp <- codeType cdef
  v <- mkVar (quantvar cdef)
  blcks <- case cdef ^. defType
            of DefinitionType
Definition -> State DrasilState (MS (r block))
-> StateT DrasilState Identity [MS (r block)]
forall a b. State a b -> State a [b]
liftS (State DrasilState (MS (r block))
 -> StateT DrasilState Identity [MS (r block)])
-> State DrasilState (MS (r block))
-> StateT DrasilState Identity [MS (r block)]
forall a b. (a -> b) -> a -> b
$ CalcType -> Const -> CodeExpr -> State DrasilState (MS (r block))
forall (r :: * -> *) block stmt bod.
(BlockSym r block stmt, BodySym r bod block, Argument r,
 MathConstant r, VariableValue r, Literal r, BooleanExpression r,
 Comparison r, NumericExpression r, SelfSym r, InternalValueExp r,
 OOValueExpression r, List r, Reference r, Set r,
 AssignStatement r stmt, ControlStatement r stmt bod, TypeElim r,
 VariableElim r) =>
CalcType -> Const -> CodeExpr -> GenState (MS (r block))
genCalcBlock CalcType
CalcReturn Const
cdef
                 (Const
cdef Const -> Getting CodeExpr Const CodeExpr -> CodeExpr
forall s a. s -> Getting a s a -> a
^. Getting CodeExpr Const CodeExpr
forall c. DefiningCodeExpr c => Lens' c CodeExpr
Lens' Const CodeExpr
codeExpr)
               DefinitionType
ODE -> StateT DrasilState Identity [MS (r block)]
-> (ExtLibState -> StateT DrasilState Identity [MS (r block)])
-> Maybe ExtLibState
-> StateT DrasilState Identity [MS (r block)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> StateT DrasilState Identity [MS (r block)]
forall a. HasCallStack => String -> a
error (String -> StateT DrasilState Identity [MS (r block)])
-> String -> StateT DrasilState Identity [MS (r block)]
forall a b. (a -> b) -> a -> b
$ String
nm String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" missing from ExtLibMap")
                 (\ExtLibState
el -> do
                   defStmts <- (FuncStmt -> StateT DrasilState Identity (MS (r stmt)))
-> [FuncStmt] -> StateT DrasilState Identity [MS (r stmt)]
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 stmt))
forall (r :: * -> *) block stmt bod.
(BlockSym r block stmt, BodySym r bod block, Argument r,
 MathConstant r, VariableValue r, Literal r, BooleanExpression r,
 Comparison r, NumericExpression r, SelfSym r, InternalValueExp r,
 OOValueExpression r, Array r, List r, ListStatement r stmt,
 Reference r, Set r, MultiStatement r stmt, ValueStatement r stmt,
 AssignStatement r stmt, ControlStatement r stmt bod,
 DeclStatement r stmt bod, TypeElim r, VariableElim r) =>
FuncStmt -> GenState (MS (r stmt))
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)
                   stepStmts <- mapM convStmt (el ^. steps)
                   return [block (varDec v local : defStmts),
                     block stepStmts,
                     block [returnStmt $ valueOf 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))
  calcDesc <- getCommentBrief cdef
  desc <- getCommentBrief cdef
  publicFunc
    nm
    (convTypeOO tp)
    ("Calculates " ++ calcDesc)
    (map pcAuto parms)
    (Just desc)
    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
  ::
    ( BlockSym r block stmt
    , BodySym r bod block
    , Argument r
    , MathConstant r
    , VariableValue r
    , Literal r
    , BooleanExpression r
    , Comparison r
    , NumericExpression r
    , SelfSym r
    , InternalValueExp r
    , OOValueExpression r
    , List r
    , Reference r
    , Set r
    , AssignStatement r stmt
    , ControlStatement r stmt bod
    , TypeElim r
    , VariableElim r
    )
   => CalcType -> CodeDefinition -> CodeExpr -> GenState (MS (r block))
genCalcBlock :: forall (r :: * -> *) block stmt bod.
(BlockSym r block stmt, BodySym r bod block, Argument r,
 MathConstant r, VariableValue r, Literal r, BooleanExpression r,
 Comparison r, NumericExpression r, SelfSym r, InternalValueExp r,
 OOValueExpression r, List r, Reference r, Set r,
 AssignStatement r stmt, ControlStatement r stmt bod, TypeElim r,
 VariableElim r) =>
CalcType -> Const -> CodeExpr -> GenState (MS (r block))
genCalcBlock CalcType
t Const
v (Case Completeness
c [(CodeExpr, CodeExpr)]
e) = CalcType
-> Const
-> Completeness
-> [(CodeExpr, CodeExpr)]
-> GenState (MS (r block))
forall (r :: * -> *) block stmt bod.
(BlockSym r block stmt, BodySym r bod block, Argument r,
 MathConstant r, VariableValue r, Literal r, BooleanExpression r,
 Comparison r, NumericExpression r, SelfSym r, InternalValueExp r,
 OOValueExpression r, List r, Reference r, Set r,
 AssignStatement r stmt, ControlStatement r stmt bod, TypeElim r,
 VariableElim r) =>
CalcType
-> Const
-> Completeness
-> [(CodeExpr, CodeExpr)]
-> GenState (MS (r block))
genCaseBlock CalcType
t Const
v Completeness
c [(CodeExpr, CodeExpr)]
e
genCalcBlock CalcType
CalcAssign Const
v CodeExpr
e = do
  vv <- Input -> GenState (SVariable r)
forall (r :: * -> *).
(SelfSym r, VariableElim r, VariableValue r) =>
Input -> GenState (SVariable r)
mkVar (Const -> Input
forall c. (Quantity c, MayHaveUnit c, Concept c) => c -> Input
quantvar Const
v)
  ee <- convExpr e
  return $ block [assign vv ee]
genCalcBlock CalcType
CalcReturn Const
_ CodeExpr
e = [MS (r stmt)] -> MS (r block)
forall {k} (r :: k -> *) (block :: k) (stmt :: k).
BlockSym r block stmt =>
[MS (r stmt)] -> MS (r block)
block ([MS (r stmt)] -> MS (r block))
-> StateT DrasilState Identity [MS (r stmt)]
-> GenState (MS (r block))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> State DrasilState (MS (r stmt))
-> StateT DrasilState Identity [MS (r stmt)]
forall a b. State a b -> State a [b]
liftS (SValue r -> MS (r stmt)
forall (r :: * -> *) stmt bod.
ControlStatement r stmt bod =>
SValue r -> MS (r stmt)
returnStmt (SValue r -> MS (r stmt))
-> GenState (SValue r) -> State DrasilState (MS (r stmt))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CodeExpr -> GenState (SValue r)
forall (r :: * -> *).
(Argument r, MathConstant r, VariableValue r, Literal r,
 BooleanExpression r, Comparison r, NumericExpression r, SelfSym r,
 InternalValueExp r, OOValueExpression r, List r, Reference r,
 Set r, 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
  ::
    ( BlockSym r block stmt
    , BodySym r bod block
    , Argument r
    , MathConstant r
    , VariableValue r
    , Literal r
    , BooleanExpression r
    , Comparison r
    , NumericExpression r
    , SelfSym r
    , InternalValueExp r
    , OOValueExpression r
    , List r
    , Reference r
    , Set r
    , AssignStatement r stmt
    , ControlStatement r stmt bod
    , TypeElim r
    , VariableElim r
    )
  => CalcType
  -> CodeDefinition
  -> Completeness
  -> [(CodeExpr, CodeExpr)]
  -> GenState (MS (r block))
genCaseBlock :: forall (r :: * -> *) block stmt bod.
(BlockSym r block stmt, BodySym r bod block, Argument r,
 MathConstant r, VariableValue r, Literal r, BooleanExpression r,
 Comparison r, NumericExpression r, SelfSym r, InternalValueExp r,
 OOValueExpression r, List r, Reference r, Set r,
 AssignStatement r stmt, ControlStatement r stmt bod, TypeElim r,
 VariableElim r) =>
CalcType
-> Const
-> Completeness
-> [(CodeExpr, CodeExpr)]
-> GenState (MS (r block))
genCaseBlock CalcType
_ Const
_ Completeness
_ [] = String -> GenState (MS (r block))
forall a. HasCallStack => String -> a
error (String -> GenState (MS (r block)))
-> String -> GenState (MS (r block))
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 Const
v Completeness
c [(CodeExpr, CodeExpr)]
cs = do
  ifs <- ((CodeExpr, CodeExpr)
 -> StateT DrasilState Identity (SValue r, MS (r bod)))
-> [(CodeExpr, CodeExpr)]
-> StateT DrasilState Identity [(SValue r, MS (r bod))]
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 bod) -> (SValue r, MS (r bod)))
-> StateT DrasilState Identity (SValue r)
-> StateT DrasilState Identity (MS (r bod))
-> StateT DrasilState Identity (SValue r, MS (r bod))
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 :: * -> *).
(Argument r, MathConstant r, VariableValue r, Literal r,
 BooleanExpression r, Comparison r, NumericExpression r, SelfSym r,
 InternalValueExp r, OOValueExpression r, List r, Reference r,
 Set r, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr CodeExpr
r) (CodeExpr -> StateT DrasilState Identity (MS (r bod))
calcBody CodeExpr
e)) (Completeness -> [(CodeExpr, CodeExpr)]
ifEs Completeness
c)
  els <- elseE c
  return $ block [ifCond ifs els]
  where calcBody :: CodeExpr -> StateT DrasilState Identity (MS (r bod))
calcBody CodeExpr
e = ([MS (r block)] -> MS (r bod))
-> StateT DrasilState Identity [MS (r block)]
-> StateT DrasilState Identity (MS (r bod))
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 block)] -> MS (r bod)
forall {k} (r :: k -> *) (bod :: k) (block :: k).
BodySym r bod block =>
[MS (r block)] -> MS (r bod)
body (StateT DrasilState Identity [MS (r block)]
 -> StateT DrasilState Identity (MS (r bod)))
-> StateT DrasilState Identity [MS (r block)]
-> StateT DrasilState Identity (MS (r bod))
forall a b. (a -> b) -> a -> b
$ GenState (MS (r block))
-> StateT DrasilState Identity [MS (r block)]
forall a b. State a b -> State a [b]
liftS (GenState (MS (r block))
 -> StateT DrasilState Identity [MS (r block)])
-> GenState (MS (r block))
-> StateT DrasilState Identity [MS (r block)]
forall a b. (a -> b) -> a -> b
$ CalcType -> Const -> CodeExpr -> GenState (MS (r block))
forall (r :: * -> *) block stmt bod.
(BlockSym r block stmt, BodySym r bod block, Argument r,
 MathConstant r, VariableValue r, Literal r, BooleanExpression r,
 Comparison r, NumericExpression r, SelfSym r, InternalValueExp r,
 OOValueExpression r, List r, Reference r, Set r,
 AssignStatement r stmt, ControlStatement r stmt bod, TypeElim r,
 VariableElim r) =>
CalcType -> Const -> CodeExpr -> GenState (MS (r block))
genCalcBlock CalcType
t Const
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 bod))
elseE Completeness
Complete = CodeExpr -> StateT DrasilState Identity (MS (r bod))
calcBody (CodeExpr -> StateT DrasilState Identity (MS (r bod)))
-> CodeExpr -> StateT DrasilState Identity (MS (r bod))
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 bod) -> StateT DrasilState Identity (MS (r bod))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (MS (r bod) -> StateT DrasilState Identity (MS (r bod)))
-> MS (r bod) -> StateT DrasilState Identity (MS (r bod))
forall a b. (a -> b) -> a -> b
$ MS (r stmt) -> MS (r bod)
forall {k} (r :: k -> *) (block :: k) (stmt :: k) (bod :: k).
(BlockSym r block stmt, BodySym r bod block) =>
MS (r stmt) -> MS (r bod)
oneLiner (MS (r stmt) -> MS (r bod)) -> MS (r stmt) -> MS (r bod)
forall a b. (a -> b) -> a -> b
$ String -> MS (r stmt)
forall (r :: * -> *) stmt bod.
ControlStatement r stmt bod =>
String -> MS (r stmt)
throw (String -> MS (r stmt)) -> String -> MS (r stmt)
forall a b. (a -> b) -> a -> b
$
          String
"Undefined case encountered in function " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Const -> String
forall c. CodeIdea c => c -> String
codeName Const
v

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

-- | Generates a module containing the function for printing outputs.
genOutputMod
  :: (OOProg r vis stmt mthd stvr attch prg file mod bod block) => GenState [FS (r file)]
genOutputMod :: forall (r :: * -> *) vis stmt mthd stvr attch prg file mod bod
       block.
OOProg r vis stmt mthd stvr attch prg file mod bod block =>
GenState [FS (r file)]
genOutputMod = do
  ofName <- InternalConcept -> GenState String
genICName InternalConcept
OutputFormat
  ofDesc <- modDesc $ liftS outputFormatDesc
  liftS $ genModule ofName ofDesc [genOutputFormat] []

-- | Generates a function for printing output values.
genOutputFormat
  :: (OOProg r vis stmt mthd stvr attch prg file mod bod block)
  => GenState (Maybe (MS (r mthd)))
genOutputFormat :: forall (r :: * -> *) vis stmt mthd stvr attch prg file mod bod
       block.
OOProg r vis stmt mthd stvr attch prg file mod bod block =>
GenState (Maybe (MS (r mthd)))
genOutputFormat = do
  g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  modify (\DrasilState
st -> DrasilState
st {currentScope = Local})
  woName <- genICName WriteOutput
  let genOutput
        :: (OOProg r vis stmt mthd stvr attch prg file mod bod block)
        => Maybe String -> GenState (Maybe (MS (r mthd)))
      genOutput Maybe String
Nothing = Maybe (MS (r mthd))
-> StateT DrasilState Identity (Maybe (MS (r mthd)))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MS (r mthd))
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
        parms <- GenState [Input]
getOutputParams
        let outs = (Input -> Input) -> [Input] -> [Input]
forall a b. (a -> b) -> [a] -> [b]
map (DrasilState -> Input -> Input
resolveOutputDefType DrasilState
g) (DrasilState
g DrasilState -> Getting [Input] DrasilState [Input] -> [Input]
forall s a. s -> Getting a s a -> a
^. Getting [Input] DrasilState [Input]
forall c. HasCodeSpec c => Lens' c [Input]
Lens' DrasilState [Input]
outputs)
        outp <- mapM (\Input
x -> do
          v <- Input -> GenState (SValue r)
forall (r :: * -> *).
(Argument r, Literal r, MathConstant r, VariableValue r,
 BooleanExpression r, Comparison r, NumericExpression r, SelfSym r,
 InternalValueExp r, OOValueExpression r, List r, Reference r,
 Set r, TypeElim r, VariableElim r) =>
Input -> GenState (SValue r)
mkVal Input
x
          return $
            printFileStr v_outfile (codeName x ++ " = ")
            : writeOutputValue v_outfile v (x ^. typ) ) outs
        desc <- woFuncDesc
        mthd <- publicFunc woName void desc (map pcAuto parms) Nothing
          [block $ [
          varDec var_outfile local,
          openFileW var_outfile (litString "output.txt") ] ++
          concat outp ++ [ closeFile v_outfile ]]
        return $ Just mthd
  genOutput $ Map.lookup woName (eMap g)

-- Procedural Versions --

-- | Generates a controller module.
genMainProc
  :: (NativeVector r, ProcProg r vis stmt mthd prg file mod bod block)
  => GenState (FS (r file))
genMainProc :: forall (r :: * -> *) vis stmt mthd prg file mod bod block.
(NativeVector r,
 ProcProg r vis stmt mthd prg file mod bod block) =>
GenState (FS (r file))
genMainProc = String
-> String
-> [GenState (Maybe (MS (r mthd)))]
-> GenState (FS (r file))
forall (r :: * -> *) vis stmt mthd prg file mod bod block.
ProcProg r vis stmt mthd prg file mod bod block =>
String
-> String
-> [GenState (Maybe (MS (r mthd)))]
-> GenState (FS (r file))
genModuleProc String
"Control" String
"Controls the flow of the program"
  [GenState (Maybe (MS (r mthd)))
forall (r :: * -> *) block stmt bod vis mthd.
(BlockSym r block stmt, BodySym r bod block, CommandLineArgs r,
 MathConstant r, VariableValue r, BooleanExpression r, Comparison r,
 NumericExpression r, ValueExpression r, MultiStatement r stmt,
 ValueStatement r stmt, DeclStatement r stmt bod,
 FuncAppStatement r stmt, Argument r, List r, NativeVector r,
 Reference r, Set r, MethodSym r vis mthd bod, TypeElim r) =>
GenState (Maybe (MS (r mthd)))
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
  ::
    ( BlockSym r block stmt
    , BodySym r bod block
    , CommandLineArgs r
    , MathConstant r
    , VariableValue r
    , BooleanExpression r
    , Comparison r
    , NumericExpression r
    , ValueExpression r
    , MultiStatement r stmt
    , ValueStatement r stmt
    , DeclStatement r stmt bod
    , FuncAppStatement r stmt
    , Argument r
    , List r
    , NativeVector r
    , Reference r
    , Set r
    , MethodSym r vis mthd bod
    , TypeElim r
    )
  => GenState (Maybe (MS (r mthd)))
genMainFuncProc :: forall (r :: * -> *) block stmt bod vis mthd.
(BlockSym r block stmt, BodySym r bod block, CommandLineArgs r,
 MathConstant r, VariableValue r, BooleanExpression r, Comparison r,
 NumericExpression r, ValueExpression r, MultiStatement r stmt,
 ValueStatement r stmt, DeclStatement r stmt bod,
 FuncAppStatement r stmt, Argument r, List r, NativeVector r,
 Reference r, Set r, MethodSym r vis mthd bod, TypeElim r) =>
GenState (Maybe (MS (r mthd)))
genMainFuncProc = do
    g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
    let mainFunc ImplementationType
Library = Maybe (MS (r mthd))
-> StateT DrasilState Identity (Maybe (MS (r mthd)))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MS (r mthd))
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})
          v_filename <- Input -> GenState (SVariable r)
forall (r :: * -> *).
VariableSym r =>
Input -> GenState (SVariable r)
mkVarProc (DefinedQuantityDict -> Input
forall c. (Quantity c, MayHaveUnit c, Concept c) => c -> Input
quantvar DefinedQuantityDict
inFileName)
          co <- initConstsProc
          ip <- getInputDeclProc
          ics <- genAllInputCallsProc
          varDef <- mapM genCalcCallProc (g ^. execOrder)
          wo <- genOutputCallProc
          return $ Just $
            (if CommentFunc `elem` g ^. commented
              then docMain
              else mainFunction)
            $ bodyStatements $ initLogFileVar (g ^. logKind) mainFn
              ++ [varDecDef v_filename mainFn (arg 0)]
              -- Constants must be declared before inputs because some derived
              -- input definitions or input constraints may use the constants
              ++ catMaybes [co, ip] ++ ics ++ catMaybes (varDef ++ [wo])
    mainFunc $ g ^. 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
  ::
    ( MathConstant r
    , VariableValue r
    , BooleanExpression r
    , Comparison r
    , NumericExpression r
    , ValueExpression r
    , DeclStatement r stmt bod
    , Argument r
    , List r
    , NativeVector r
    , Reference r
    , Set r
    , MultiStatement r stmt
    , TypeElim r
    )
  => GenState (Maybe (MS (r stmt)))
initConstsProc :: forall (r :: * -> *) stmt bod.
(MathConstant r, VariableValue r, BooleanExpression r,
 Comparison r, NumericExpression r, ValueExpression r,
 DeclStatement r stmt bod, Argument r, List r, NativeVector r,
 Reference r, Set r, MultiStatement r stmt, TypeElim r) =>
GenState (Maybe (MS (r stmt)))
initConstsProc = do
  g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  let 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 = DrasilState
g DrasilState -> Getting [Const] DrasilState [Const] -> [Const]
forall s a. s -> Getting a s a -> a
^. Getting [Const] DrasilState [Const]
forall c. HasCodeSpec c => Lens' c [Const]
Lens' DrasilState [Const]
constDefns
      getDecl (Store Structure
Unbundled) Structure
_ = StateT DrasilState Identity (Maybe (MS (r stmt)))
declVars
      getDecl (Store Structure
Bundled) Structure
_ = String -> StateT DrasilState Identity (Maybe (MS (r stmt)))
forall a. HasCallStack => String -> a
error String
"initConstsProc: Procedural renderers do not support bundled constants."
      getDecl ConstantStructure
WithInputs Structure
Unbundled = StateT DrasilState Identity (Maybe (MS (r stmt)))
declVars
      getDecl ConstantStructure
WithInputs Structure
Bundled = Maybe (MS (r stmt))
-> StateT DrasilState Identity (Maybe (MS (r stmt)))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MS (r stmt))
forall a. Maybe a
Nothing
      getDecl ConstantStructure
Inline Structure
_ = Maybe (MS (r stmt))
-> StateT DrasilState Identity (Maybe (MS (r stmt)))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MS (r stmt))
forall a. Maybe a
Nothing
      declVars = do
        vars <- (Const -> StateT DrasilState Identity (SVariable r))
-> [Const] -> 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 (Input -> StateT DrasilState Identity (SVariable r)
forall (r :: * -> *).
VariableSym r =>
Input -> GenState (SVariable r)
mkVarProc (Input -> StateT DrasilState Identity (SVariable r))
-> (Const -> Input)
-> Const
-> StateT DrasilState Identity (SVariable r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Const -> Input
forall c. (Quantity c, MayHaveUnit c, Concept c) => c -> Input
quantvar) [Const]
cs
        vals <- mapM (convExprProc . (^. codeExpr)) cs
        return $ Just $ multi $
          zipWith (\SVariable r
vr -> ConstantRepr
-> SVariable r -> r ScopeData -> SValue r -> MS (r stmt)
forall {r :: * -> *} {stmt} {bod}.
DeclStatement r stmt bod =>
ConstantRepr
-> SVariable r -> r ScopeData -> SValue r -> MS (r stmt)
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) vars vals
      defFunc ConstantRepr
Var = SVariable r -> r ScopeData -> SValue r -> MS (r stmt)
forall (r :: * -> *) stmt bod.
DeclStatement r stmt bod =>
SVariable r -> r ScopeData -> SValue r -> MS (r stmt)
varDecDef
      defFunc ConstantRepr
Const = SVariable r -> r ScopeData -> SValue r -> MS (r stmt)
forall (r :: * -> *) stmt bod.
DeclStatement r stmt bod =>
SVariable r -> r ScopeData -> SValue r -> MS (r stmt)
constDecDef
  getDecl (g ^. conStruct) (g ^. 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
  g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  cName <- genICName Constants
  let cs = DrasilState
g DrasilState -> Getting [Const] DrasilState [Const] -> [Const]
forall s a. s -> Getting a s a -> a
^. Getting [Const] DrasilState [Const]
forall c. HasCodeSpec c => Lens' c [Const]
Lens' DrasilState [Const]
constDefns
      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 [Const]
_ = Bool -> GenState Bool
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
  checkClass $ filter (flip member (Map.filter (cName ==) (clsMap g))
    . codeName) cs

-- | Generates a single module containing all input-related components.
genInputModProc
  :: (NativeVector r, ProcProg r vis stmt mthd prg file mod bod block)
  => GenState [FS (r file)]
genInputModProc :: forall (r :: * -> *) vis stmt mthd prg file mod bod block.
(NativeVector r,
 ProcProg r vis stmt mthd prg file mod bod block) =>
GenState [FS (r file)]
genInputModProc = do
  ipDesc <- GenState [String] -> GenState String
modDesc GenState [String]
inputParametersDesc
  cname <- genICName InputParameters
  let genMod
        :: (NativeVector r, ProcProg r vis stmt mthd prg file mod bod block)
        => Bool -> GenState (FS (r file))
      genMod Bool
False = String
-> String
-> [GenState (Maybe (MS (r mthd)))]
-> GenState (FS (r file))
forall (r :: * -> *) vis stmt mthd prg file mod bod block.
ProcProg r vis stmt mthd prg file mod bod block =>
String
-> String
-> [GenState (Maybe (MS (r mthd)))]
-> GenState (FS (r file))
genModuleProc String
cname String
ipDesc [VisibilityTag -> GenState (Maybe (MS (r mthd)))
forall (r :: * -> *) block stmt bod vis mthd.
(BlockSym r block stmt, BodySym r bod block, NativeVector r,
 MathConstant r, VariableValue r, BooleanExpression r, Comparison r,
 NumericExpression r, ValueExpression r, MultiStatement r stmt,
 DeclStatement r stmt bod, ControlStatement r stmt bod,
 StringStatement r stmt, FileHandling r stmt, PrintFile r stmt,
 ReadFile r stmt, Argument r, List r, ListStatement r stmt,
 Reference r, Set r, MethodSym r vis mthd bod, TypeElim r,
 VariableElim r) =>
VisibilityTag -> GenState (Maybe (MS (r mthd)))
genInputFormatProc VisibilityTag
Pub,
        VisibilityTag -> GenState (Maybe (MS (r mthd)))
forall (r :: * -> *) block stmt bod vis mthd.
(BlockSym r block stmt, BodySym r bod block, NativeVector r,
 MathConstant r, VariableValue r, BooleanExpression r, Comparison r,
 NumericExpression r, ValueExpression r, Argument r, Array r,
 List r, Reference r, Set r, MultiStatement r stmt,
 DeclStatement r stmt bod, AssignStatement r stmt,
 ControlStatement r stmt bod, StringStatement r stmt,
 FileHandling r stmt, PrintFile r stmt, ReadFile r stmt,
 MethodSym r vis mthd bod, TypeElim r, VariableElim r) =>
VisibilityTag -> GenState (Maybe (MS (r mthd)))
genInputDerivedProc VisibilityTag
Pub, VisibilityTag -> GenState (Maybe (MS (r mthd)))
forall (r :: * -> *) block stmt bod vis mthd.
(BlockSym r block stmt, BodySym r bod block, MathConstant r,
 VariableValue r, BooleanExpression r, Comparison r,
 NumericExpression r, ValueExpression r, Argument r, NativeVector r,
 Reference r, Set r, List r, EmptyStatement r stmt,
 MultiStatement r stmt, DeclStatement r stmt bod,
 PrintConsole r stmt, FileHandling r stmt, PrintFile r stmt,
 ControlStatement r stmt bod, MethodSym r vis mthd bod, TypeElim r,
 VariableElim r) =>
VisibilityTag -> GenState (Maybe (MS (r mthd)))
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"
  ic <- checkInputClass
  liftS $ genMod 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
  g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  cname <- genICName InputParameters
  let ins = DrasilState
g DrasilState -> Getting [Input] DrasilState [Input] -> [Input]
forall s a. s -> Getting a s a -> a
^. Getting [Input] DrasilState [Input]
forall c. HasCodeSpec c => Lens' c [Input]
Lens' DrasilState [Input]
inputs
      cs = DrasilState
g DrasilState -> Getting [Const] DrasilState [Const] -> [Const]
forall s a. s -> Getting a s a -> a
^. Getting [Const] DrasilState [Const]
forall c. HasCodeSpec c => Lens' c [Const]
Lens' DrasilState [Const]
constDefns
      filt :: (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 [] [] = Bool -> GenState Bool
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
      checkClass [Input]
_ [Const]
_ = Bool -> GenState Bool
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
  checkClass (filt ins) (filt 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
  :: (MultiStatement r stmt, DeclStatement r stmt bod)
  => GenState (Maybe (MS (r stmt)))
getInputDeclProc :: forall (r :: * -> *) stmt bod.
(MultiStatement r stmt, DeclStatement r stmt bod) =>
GenState (Maybe (MS (r stmt)))
getInputDeclProc = do
  g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  let 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 ([],[]) = Maybe (MS (r stmt))
-> StateT DrasilState Identity (Maybe (MS (r stmt)))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MS (r stmt))
forall a. Maybe a
Nothing
      getDecl ([],[Input]
ins) = do
        vars <- (Input -> StateT DrasilState Identity (SVariable r))
-> [Input] -> 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 Input -> StateT DrasilState Identity (SVariable r)
forall (r :: * -> *).
VariableSym r =>
Input -> GenState (SVariable r)
mkVarProc [Input]
ins
        return $ Just $ multi $ map (`varDec` scp) vars
      getDecl ([Input], [Input])
_ = String -> StateT DrasilState Identity (Maybe (MS (r stmt)))
forall a. HasCallStack => String -> a
error String
"getInputDeclProc: Procedural renderers do not support bundled inputs"
  getDecl (partition (flip member (eMap g) . codeName)
    (g ^. inputs))

-- | Generates a module containing calculation functions.
genCalcModProc
  :: (NativeVector r, ProcProg r vis stmt mthd prg file mod bod block)
  => GenState (FS (r file))
genCalcModProc :: forall (r :: * -> *) vis stmt mthd prg file mod bod block.
(NativeVector r,
 ProcProg r vis stmt mthd prg file mod bod block) =>
GenState (FS (r file))
genCalcModProc = do
  g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  cName <- genICName Calculations
  let elmap = DrasilState -> ExtLibMap
extLibMap DrasilState
g
  genModuleWithImportsProc cName calcModDesc (concatMap (^. imports) $
    elems elmap) (map (fmap Just . genCalcFuncProc) (g ^. 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
  ::
    ( BlockSym r block stmt
    , BodySym r bod block
    , NativeVector r
    , MathConstant r
    , VariableValue r
    , BooleanExpression r
    , Comparison r
    , NumericExpression r
    , ValueExpression r
    , Argument r
    , Array r
    , List r
    , ListStatement r stmt
    , Reference r
    , Set r
    , MultiStatement r stmt
    , ValueStatement r stmt
    , DeclStatement r stmt bod
    , AssignStatement r stmt
    , ControlStatement r stmt bod
    , StringStatement r stmt
    , FileHandling r stmt
    , PrintFile r stmt
    , ReadFile r stmt
    , MethodSym r vis mthd bod
    , TypeElim r
    , VariableElim r
    )
  => CodeDefinition -> GenState (MS (r mthd))
genCalcFuncProc :: forall (r :: * -> *) block stmt bod vis mthd.
(BlockSym r block stmt, BodySym r bod block, NativeVector r,
 MathConstant r, VariableValue r, BooleanExpression r, Comparison r,
 NumericExpression r, ValueExpression r, Argument r, Array r,
 List r, ListStatement r stmt, Reference r, Set r,
 MultiStatement r stmt, ValueStatement r stmt,
 DeclStatement r stmt bod, AssignStatement r stmt,
 ControlStatement r stmt bod, StringStatement r stmt,
 FileHandling r stmt, PrintFile r stmt, ReadFile r stmt,
 MethodSym r vis mthd bod, TypeElim r, VariableElim r) =>
Const -> GenState (MS (r mthd))
genCalcFuncProc Const
cdef = do
  g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  modify (\DrasilState
st -> DrasilState
st {currentScope = Local})
  parms <- getCalcParams cdef
  let nm = Const -> String
forall c. CodeIdea c => c -> String
codeName Const
cdef
  tp <- codeType cdef
  v <- mkVarProc (quantvar cdef)
  blcks <- case cdef ^. defType
            of DefinitionType
Definition -> State DrasilState (MS (r block))
-> StateT DrasilState Identity [MS (r block)]
forall a b. State a b -> State a [b]
liftS (State DrasilState (MS (r block))
 -> StateT DrasilState Identity [MS (r block)])
-> State DrasilState (MS (r block))
-> StateT DrasilState Identity [MS (r block)]
forall a b. (a -> b) -> a -> b
$ CalcType -> Const -> CodeExpr -> State DrasilState (MS (r block))
forall (r :: * -> *) block stmt bod.
(BlockSym r block stmt, BodySym r bod block, NativeVector r,
 MathConstant r, VariableValue r, BooleanExpression r, Comparison r,
 NumericExpression r, ValueExpression r, Argument r, Array r,
 List r, Reference r, Set r, DeclStatement r stmt bod,
 AssignStatement r stmt, ControlStatement r stmt bod,
 StringStatement r stmt, FileHandling r stmt, PrintFile r stmt,
 ReadFile r stmt, TypeElim r) =>
CalcType -> Const -> CodeExpr -> GenState (MS (r block))
genCalcBlockProc CalcType
CalcReturn Const
cdef
                 (Const
cdef Const -> Getting CodeExpr Const CodeExpr -> CodeExpr
forall s a. s -> Getting a s a -> a
^. Getting CodeExpr Const CodeExpr
forall c. DefiningCodeExpr c => Lens' c CodeExpr
Lens' Const CodeExpr
codeExpr)
               DefinitionType
ODE -> StateT DrasilState Identity [MS (r block)]
-> (ExtLibState -> StateT DrasilState Identity [MS (r block)])
-> Maybe ExtLibState
-> StateT DrasilState Identity [MS (r block)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> StateT DrasilState Identity [MS (r block)]
forall a. HasCallStack => String -> a
error (String -> StateT DrasilState Identity [MS (r block)])
-> String -> StateT DrasilState Identity [MS (r block)]
forall a b. (a -> b) -> a -> b
$ String
nm String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" missing from ExtLibMap")
                 (\ExtLibState
el -> do
                   defStmts <- (FuncStmt -> StateT DrasilState Identity (MS (r stmt)))
-> [FuncStmt] -> StateT DrasilState Identity [MS (r stmt)]
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 stmt))
forall (r :: * -> *) block stmt bod.
(BlockSym r block stmt, BodySym r bod block, MathConstant r,
 VariableValue r, BooleanExpression r, NumericExpression r,
 ValueExpression r, Comparison r, Argument r, Array r, List r,
 ListStatement r stmt, NativeVector r, Reference r, Set r,
 MultiStatement r stmt, ValueStatement r stmt,
 DeclStatement r stmt bod, AssignStatement r stmt,
 ControlStatement r stmt bod, TypeElim r, VariableElim r) =>
FuncStmt -> GenState (MS (r stmt))
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)
                   stepStmts <- mapM convStmtProc (el ^. steps)
                   return [block (varDec v local : defStmts),
                     block stepStmts,
                     block [returnStmt $ valueOf 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))
  calcDesc <- getCommentBrief cdef
  desc <- getCommentBrief cdef
  publicFuncProc
    nm
    (convType tp)
    ("Calculates " ++ calcDesc)
    (map pcAuto parms)
    (Just desc)
    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
  ::
    ( BlockSym r block stmt
    , BodySym r bod block
    , NativeVector r
    , MathConstant r
    , VariableValue r
    , BooleanExpression r
    , Comparison r
    , NumericExpression r
    , ValueExpression r
    , Argument r
    , Array r
    , List r
    , Reference r
    , Set r
    , DeclStatement r stmt bod
    , AssignStatement r stmt
    , ControlStatement r stmt bod
    , StringStatement r stmt
    , FileHandling r stmt
    , PrintFile r stmt
    , ReadFile r stmt
    , TypeElim r
    )
  => CalcType -> CodeDefinition -> CodeExpr -> GenState (MS (r block))
genCalcBlockProc :: forall (r :: * -> *) block stmt bod.
(BlockSym r block stmt, BodySym r bod block, NativeVector r,
 MathConstant r, VariableValue r, BooleanExpression r, Comparison r,
 NumericExpression r, ValueExpression r, Argument r, Array r,
 List r, Reference r, Set r, DeclStatement r stmt bod,
 AssignStatement r stmt, ControlStatement r stmt bod,
 StringStatement r stmt, FileHandling r stmt, PrintFile r stmt,
 ReadFile r stmt, TypeElim r) =>
CalcType -> Const -> CodeExpr -> GenState (MS (r block))
genCalcBlockProc CalcType
t Const
v (Case Completeness
c [(CodeExpr, CodeExpr)]
e) = CalcType
-> Const
-> Completeness
-> [(CodeExpr, CodeExpr)]
-> GenState (MS (r block))
forall (r :: * -> *) block stmt bod.
(BlockSym r block stmt, BodySym r bod block, NativeVector r,
 MathConstant r, VariableValue r, BooleanExpression r, Comparison r,
 NumericExpression r, ValueExpression r, DeclStatement r stmt bod,
 AssignStatement r stmt, ControlStatement r stmt bod,
 StringStatement r stmt, FileHandling r stmt, ReadFile r stmt,
 PrintFile r stmt, Argument r, Array r, List r, Reference r, Set r,
 TypeElim r) =>
CalcType
-> Const
-> Completeness
-> [(CodeExpr, CodeExpr)]
-> GenState (MS (r block))
genCaseBlockProc CalcType
t Const
v Completeness
c [(CodeExpr, CodeExpr)]
e
genCalcBlockProc CalcType
CalcAssign Const
v CodeExpr
e = do
  vv <- Input -> GenState (SVariable r)
forall (r :: * -> *).
VariableSym r =>
Input -> GenState (SVariable r)
mkVarProc (Const -> Input
forall c. (Quantity c, MayHaveUnit c, Concept c) => c -> Input
quantvar Const
v)
  ee <- convExprProc e
  return $ block [assign vv ee]
genCalcBlockProc CalcType
CalcReturn Const
_ CodeExpr
e = [MS (r stmt)] -> MS (r block)
forall {k} (r :: k -> *) (block :: k) (stmt :: k).
BlockSym r block stmt =>
[MS (r stmt)] -> MS (r block)
block ([MS (r stmt)] -> MS (r block))
-> StateT DrasilState Identity [MS (r stmt)]
-> GenState (MS (r block))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> State DrasilState (MS (r stmt))
-> StateT DrasilState Identity [MS (r stmt)]
forall a b. State a b -> State a [b]
liftS (SValue r -> MS (r stmt)
forall (r :: * -> *) stmt bod.
ControlStatement r stmt bod =>
SValue r -> MS (r stmt)
returnStmt (SValue r -> MS (r stmt))
-> GenState (SValue r) -> State DrasilState (MS (r stmt))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CodeExpr -> GenState (SValue r)
forall (r :: * -> *).
(MathConstant r, VariableValue r, BooleanExpression r,
 Comparison r, NumericExpression r, ValueExpression r, Argument r,
 NativeVector r, Reference r, Set r, List r, 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
  ::
    ( BlockSym r block stmt
    , BodySym r bod block
    , NativeVector r
    , MathConstant r
    , VariableValue r
    , BooleanExpression r
    , Comparison r
    , NumericExpression r
    , ValueExpression r
    , DeclStatement r stmt bod
    , AssignStatement r stmt
    , ControlStatement r stmt bod
    , StringStatement r stmt
    , FileHandling r stmt
    , ReadFile r stmt
    , PrintFile r stmt
    , Argument r
    , Array r
    , List r
    , Reference r
    , Set r
    , TypeElim r
    )
  => CalcType
  -> CodeDefinition
  -> Completeness
  -> [(CodeExpr, CodeExpr)]
  -> GenState (MS (r block))
genCaseBlockProc :: forall (r :: * -> *) block stmt bod.
(BlockSym r block stmt, BodySym r bod block, NativeVector r,
 MathConstant r, VariableValue r, BooleanExpression r, Comparison r,
 NumericExpression r, ValueExpression r, DeclStatement r stmt bod,
 AssignStatement r stmt, ControlStatement r stmt bod,
 StringStatement r stmt, FileHandling r stmt, ReadFile r stmt,
 PrintFile r stmt, Argument r, Array r, List r, Reference r, Set r,
 TypeElim r) =>
CalcType
-> Const
-> Completeness
-> [(CodeExpr, CodeExpr)]
-> GenState (MS (r block))
genCaseBlockProc CalcType
_ Const
_ Completeness
_ [] = String -> GenState (MS (r block))
forall a. HasCallStack => String -> a
error (String -> GenState (MS (r block)))
-> String -> GenState (MS (r block))
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 Const
v Completeness
c [(CodeExpr, CodeExpr)]
cs = do
  ifs <- ((CodeExpr, CodeExpr)
 -> StateT DrasilState Identity (SValue r, MS (r bod)))
-> [(CodeExpr, CodeExpr)]
-> StateT DrasilState Identity [(SValue r, MS (r bod))]
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 bod) -> (SValue r, MS (r bod)))
-> StateT DrasilState Identity (SValue r)
-> StateT DrasilState Identity (MS (r bod))
-> StateT DrasilState Identity (SValue r, MS (r bod))
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 :: * -> *).
(MathConstant r, VariableValue r, BooleanExpression r,
 Comparison r, NumericExpression r, ValueExpression r, Argument r,
 NativeVector r, Reference r, Set r, List r, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
r) (CodeExpr -> StateT DrasilState Identity (MS (r bod))
calcBody CodeExpr
e)) (Completeness -> [(CodeExpr, CodeExpr)]
ifEs Completeness
c)
  els <- elseE c
  return $ block [ifCond ifs els]
  where calcBody :: CodeExpr -> StateT DrasilState Identity (MS (r bod))
calcBody CodeExpr
e = ([MS (r block)] -> MS (r bod))
-> StateT DrasilState Identity [MS (r block)]
-> StateT DrasilState Identity (MS (r bod))
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 block)] -> MS (r bod)
forall {k} (r :: k -> *) (bod :: k) (block :: k).
BodySym r bod block =>
[MS (r block)] -> MS (r bod)
body (StateT DrasilState Identity [MS (r block)]
 -> StateT DrasilState Identity (MS (r bod)))
-> StateT DrasilState Identity [MS (r block)]
-> StateT DrasilState Identity (MS (r bod))
forall a b. (a -> b) -> a -> b
$ GenState (MS (r block))
-> StateT DrasilState Identity [MS (r block)]
forall a b. State a b -> State a [b]
liftS (GenState (MS (r block))
 -> StateT DrasilState Identity [MS (r block)])
-> GenState (MS (r block))
-> StateT DrasilState Identity [MS (r block)]
forall a b. (a -> b) -> a -> b
$ CalcType -> Const -> CodeExpr -> GenState (MS (r block))
forall (r :: * -> *) block stmt bod.
(BlockSym r block stmt, BodySym r bod block, NativeVector r,
 MathConstant r, VariableValue r, BooleanExpression r, Comparison r,
 NumericExpression r, ValueExpression r, Argument r, Array r,
 List r, Reference r, Set r, DeclStatement r stmt bod,
 AssignStatement r stmt, ControlStatement r stmt bod,
 StringStatement r stmt, FileHandling r stmt, PrintFile r stmt,
 ReadFile r stmt, TypeElim r) =>
CalcType -> Const -> CodeExpr -> GenState (MS (r block))
genCalcBlockProc CalcType
t Const
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 bod))
elseE Completeness
Complete = CodeExpr -> StateT DrasilState Identity (MS (r bod))
calcBody (CodeExpr -> StateT DrasilState Identity (MS (r bod)))
-> CodeExpr -> StateT DrasilState Identity (MS (r bod))
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 bod) -> StateT DrasilState Identity (MS (r bod))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (MS (r bod) -> StateT DrasilState Identity (MS (r bod)))
-> MS (r bod) -> StateT DrasilState Identity (MS (r bod))
forall a b. (a -> b) -> a -> b
$ MS (r stmt) -> MS (r bod)
forall {k} (r :: k -> *) (block :: k) (stmt :: k) (bod :: k).
(BlockSym r block stmt, BodySym r bod block) =>
MS (r stmt) -> MS (r bod)
oneLiner (MS (r stmt) -> MS (r bod)) -> MS (r stmt) -> MS (r bod)
forall a b. (a -> b) -> a -> b
$ String -> MS (r stmt)
forall (r :: * -> *) stmt bod.
ControlStatement r stmt bod =>
String -> MS (r stmt)
throw (String -> MS (r stmt)) -> String -> MS (r stmt)
forall a b. (a -> b) -> a -> b
$
          String
"Undefined case encountered in function " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Const -> String
forall c. CodeIdea c => c -> String
codeName Const
v

-- | | Generates a function for reading inputs from a file.
genInputFormatProc
  ::
    ( BlockSym r block stmt
    , BodySym r bod block
    , NativeVector r
    , MathConstant r
    , VariableValue r
    , BooleanExpression r
    , Comparison r
    , NumericExpression r
    , ValueExpression r
    , MultiStatement r stmt
    , DeclStatement r stmt bod
    , ControlStatement r stmt bod
    , StringStatement r stmt
    , FileHandling r stmt
    , PrintFile r stmt
    , ReadFile r stmt
    , Argument r
    , List r
    , ListStatement r stmt
    , Reference r
    , Set r
    , MethodSym r vis mthd bod
    , TypeElim r
    , VariableElim r
    )
  => VisibilityTag -> GenState (Maybe (MS (r mthd)))
genInputFormatProc :: forall (r :: * -> *) block stmt bod vis mthd.
(BlockSym r block stmt, BodySym r bod block, NativeVector r,
 MathConstant r, VariableValue r, BooleanExpression r, Comparison r,
 NumericExpression r, ValueExpression r, MultiStatement r stmt,
 DeclStatement r stmt bod, ControlStatement r stmt bod,
 StringStatement r stmt, FileHandling r stmt, PrintFile r stmt,
 ReadFile r stmt, Argument r, List r, ListStatement r stmt,
 Reference r, Set r, MethodSym r vis mthd bod, TypeElim r,
 VariableElim r) =>
VisibilityTag -> GenState (Maybe (MS (r mthd)))
genInputFormatProc VisibilityTag
s = do
  g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  modify (\DrasilState
st -> DrasilState
st {currentScope = Local})
  dd <- genDataDesc
  giName <- genICName GetInput
  let getFunc VisibilityTag
Pub = String
-> String
-> [Input]
-> [Input]
-> [MS (r block)]
-> GenState (MS (r mthd))
forall (r :: * -> *) block stmt bod vis mthd.
(BlockSym r block stmt, BodySym r bod block, Literal r,
 VariableValue r, MultiStatement r stmt, DeclStatement r stmt bod,
 FileHandling r stmt, PrintFile r stmt, MethodSym r vis mthd bod,
 VariableElim r) =>
String
-> String
-> [Input]
-> [Input]
-> [MS (r block)]
-> GenState (MS (r mthd))
publicInOutFuncProc
      getFunc VisibilityTag
Priv = String
-> String
-> [Input]
-> [Input]
-> [MS (r block)]
-> GenState (MS (r mthd))
forall (r :: * -> *) block stmt bod vis mthd.
(BlockSym r block stmt, BodySym r bod block, Literal r,
 VariableValue r, MultiStatement r stmt, DeclStatement r stmt bod,
 FileHandling r stmt, PrintFile r stmt, MethodSym r vis mthd bod,
 VariableElim r) =>
String
-> String
-> [Input]
-> [Input]
-> [MS (r block)]
-> GenState (MS (r mthd))
privateInOutFuncProc
      genInFormat
        ::
          ( BlockSym r block stmt
          , BodySym r bod block
          , NativeVector r
          , MathConstant r
          , VariableValue r
          , BooleanExpression r
          , Comparison r
          , NumericExpression r
          , ValueExpression r
          , MultiStatement r stmt
          , DeclStatement r stmt bod
          , ControlStatement r stmt bod
          , StringStatement r stmt
          , FileHandling r stmt
          , PrintFile r stmt
          , ReadFile r stmt
          , Argument r
          , List r
          , ListStatement r stmt
          , Reference r
          , Set r
          , MethodSym r vis mthd bod
          , TypeElim r
          , VariableElim r
          )
        => Bool -> GenState (Maybe (MS (r mthd)))
      genInFormat Bool
False = Maybe (MS (r mthd))
-> StateT DrasilState Identity (Maybe (MS (r mthd)))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MS (r mthd))
forall a. Maybe a
Nothing
      genInFormat Bool
_ = do
        ins <- GenState [Input]
getInputFormatIns
        outs <- getInputFormatOuts
        bod <- readDataProc dd
        desc <- inFmtFuncDesc
        mthd <- getFunc s giName desc ins outs bod
        return $ Just mthd
  genInFormat $ giName `elem` defSet g

-- | Generates a function for calculating derived inputs.
genInputDerivedProc
  ::
    ( BlockSym r block stmt
    , BodySym r bod block
    , NativeVector r
    , MathConstant r
    , VariableValue r
    , BooleanExpression r
    , Comparison r
    , NumericExpression r
    , ValueExpression r
    , Argument r
    , Array r
    , List r
    , Reference r
    , Set r
    , MultiStatement r stmt
    , DeclStatement r stmt bod
    , AssignStatement r stmt
    , ControlStatement r stmt bod
    , StringStatement r stmt
    , FileHandling r stmt
    , PrintFile r stmt
    , ReadFile r stmt
    , MethodSym r vis mthd bod
    , TypeElim r
    , VariableElim r
    )
  => VisibilityTag -> GenState (Maybe (MS (r mthd)))
genInputDerivedProc :: forall (r :: * -> *) block stmt bod vis mthd.
(BlockSym r block stmt, BodySym r bod block, NativeVector r,
 MathConstant r, VariableValue r, BooleanExpression r, Comparison r,
 NumericExpression r, ValueExpression r, Argument r, Array r,
 List r, Reference r, Set r, MultiStatement r stmt,
 DeclStatement r stmt bod, AssignStatement r stmt,
 ControlStatement r stmt bod, StringStatement r stmt,
 FileHandling r stmt, PrintFile r stmt, ReadFile r stmt,
 MethodSym r vis mthd bod, TypeElim r, VariableElim r) =>
VisibilityTag -> GenState (Maybe (MS (r mthd)))
genInputDerivedProc VisibilityTag
s = do
  g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  modify (\DrasilState
st -> DrasilState
st {currentScope = Local})
  dvName <- genICName DerivedValuesFn
  let dvals = DrasilState
g DrasilState -> Getting [Const] DrasilState [Const] -> [Const]
forall s a. s -> Getting a s a -> a
^. Getting [Const] DrasilState [Const]
forall c. HasCodeSpec c => Lens' c [Const]
Lens' DrasilState [Const]
derivedInputs
      getFunc VisibilityTag
Pub = String
-> String
-> [Input]
-> [Input]
-> [MS (r block)]
-> GenState (MS (r mthd))
forall (r :: * -> *) block stmt bod vis mthd.
(BlockSym r block stmt, BodySym r bod block, Literal r,
 VariableValue r, MultiStatement r stmt, DeclStatement r stmt bod,
 FileHandling r stmt, PrintFile r stmt, MethodSym r vis mthd bod,
 VariableElim r) =>
String
-> String
-> [Input]
-> [Input]
-> [MS (r block)]
-> GenState (MS (r mthd))
publicInOutFuncProc
      getFunc VisibilityTag
Priv = String
-> String
-> [Input]
-> [Input]
-> [MS (r block)]
-> GenState (MS (r mthd))
forall (r :: * -> *) block stmt bod vis mthd.
(BlockSym r block stmt, BodySym r bod block, Literal r,
 VariableValue r, MultiStatement r stmt, DeclStatement r stmt bod,
 FileHandling r stmt, PrintFile r stmt, MethodSym r vis mthd bod,
 VariableElim r) =>
String
-> String
-> [Input]
-> [Input]
-> [MS (r block)]
-> GenState (MS (r mthd))
privateInOutFuncProc
      genDerived
        ::
          ( BlockSym r block stmt
          , BodySym r bod block
          , NativeVector r
          , MathConstant r
          , VariableValue r
          , BooleanExpression r
          , Comparison r
          , NumericExpression r
          , ValueExpression r
          , Argument r
          , Array r
          , List r
          , Reference r
          , Set r
          , MultiStatement r stmt
          , DeclStatement r stmt bod
          , AssignStatement r stmt
          , ControlStatement r stmt bod
          , StringStatement r stmt
          , FileHandling r stmt
          , PrintFile r stmt
          , ReadFile r stmt
          , MethodSym r vis mthd bod
          , TypeElim r
          , VariableElim r
          )
        => Bool -> GenState (Maybe (MS (r mthd)))
      genDerived Bool
False = Maybe (MS (r mthd))
-> StateT DrasilState Identity (Maybe (MS (r mthd)))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MS (r mthd))
forall a. Maybe a
Nothing
      genDerived Bool
_ = do
        ins <- GenState [Input]
getDerivedIns
        outs <- getDerivedOuts
        bod <- mapM (\Const
x -> CalcType
-> Const -> CodeExpr -> StateT DrasilState Identity (MS (r block))
forall (r :: * -> *) block stmt bod.
(BlockSym r block stmt, BodySym r bod block, NativeVector r,
 MathConstant r, VariableValue r, BooleanExpression r, Comparison r,
 NumericExpression r, ValueExpression r, Argument r, Array r,
 List r, Reference r, Set r, DeclStatement r stmt bod,
 AssignStatement r stmt, ControlStatement r stmt bod,
 StringStatement r stmt, FileHandling r stmt, PrintFile r stmt,
 ReadFile r stmt, TypeElim r) =>
CalcType -> Const -> CodeExpr -> GenState (MS (r block))
genCalcBlockProc CalcType
CalcAssign Const
x (Const
x Const -> Getting CodeExpr Const CodeExpr -> CodeExpr
forall s a. s -> Getting a s a -> a
^. Getting CodeExpr Const CodeExpr
forall c. DefiningCodeExpr c => Lens' c CodeExpr
Lens' Const CodeExpr
codeExpr)) dvals
        desc <- dvFuncDesc
        mthd <- getFunc s dvName desc ins outs bod
        return $ Just mthd
  genDerived $ dvName `elem` defSet g

-- | Generates function that checks constraints on the input.
genInputConstraintsProc
  ::
    ( BlockSym r block stmt
    , BodySym r bod block
    , MathConstant r
    , VariableValue r
    , BooleanExpression r
    , Comparison r
    , NumericExpression r
    , ValueExpression r
    , Argument r
    , NativeVector r
    , Reference r
    , Set r
    , List r
    , EmptyStatement r stmt
    , MultiStatement r stmt
    , DeclStatement r stmt bod
    , PrintConsole r stmt
    , FileHandling r stmt
    , PrintFile r stmt
    , ControlStatement r stmt bod
    , MethodSym r vis mthd bod
    , TypeElim r
    , VariableElim r
    )
  => VisibilityTag -> GenState (Maybe (MS (r mthd)))
genInputConstraintsProc :: forall (r :: * -> *) block stmt bod vis mthd.
(BlockSym r block stmt, BodySym r bod block, MathConstant r,
 VariableValue r, BooleanExpression r, Comparison r,
 NumericExpression r, ValueExpression r, Argument r, NativeVector r,
 Reference r, Set r, List r, EmptyStatement r stmt,
 MultiStatement r stmt, DeclStatement r stmt bod,
 PrintConsole r stmt, FileHandling r stmt, PrintFile r stmt,
 ControlStatement r stmt bod, MethodSym r vis mthd bod, TypeElim r,
 VariableElim r) =>
VisibilityTag -> GenState (Maybe (MS (r mthd)))
genInputConstraintsProc VisibilityTag
s = do
  g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  modify (\DrasilState
st -> DrasilState
st {currentScope = Local})
  icName <- genICName InputConstraintsFn
  let 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
Pub = String
-> VS (r TypeData)
-> String
-> [ParameterChunk]
-> Maybe String
-> [MS (r block)]
-> GenState (MS (r mthd))
forall (r :: * -> *) stmt bod block vis mthd.
(Literal r, VariableValue r, MultiStatement r stmt,
 DeclStatement r stmt bod, FileHandling r stmt, PrintFile r stmt,
 BlockSym r block stmt, BodySym r bod block,
 MethodSym r vis mthd bod, VariableElim r) =>
String
-> VS (r TypeData)
-> String
-> [ParameterChunk]
-> Maybe String
-> [MS (r block)]
-> GenState (MS (r mthd))
publicFuncProc
      getFunc VisibilityTag
Priv = String
-> VS (r TypeData)
-> String
-> [ParameterChunk]
-> Maybe String
-> [MS (r block)]
-> GenState (MS (r mthd))
forall (r :: * -> *) stmt bod block vis mthd.
(Literal r, VariableValue r, MultiStatement r stmt,
 DeclStatement r stmt bod, FileHandling r stmt, PrintFile r stmt,
 BlockSym r block stmt, BodySym r bod block,
 MethodSym r vis mthd bod, VariableElim r) =>
String
-> VS (r TypeData)
-> String
-> [ParameterChunk]
-> Maybe String
-> [MS (r block)]
-> GenState (MS (r mthd))
privateFuncProc
      genConstraints
        ::
          ( BlockSym r block stmt
          , BodySym r bod block
          , MathConstant r
          , VariableValue r
          , BooleanExpression r
          , Comparison r
          , NumericExpression r
          , ValueExpression r
          , Argument r
          , NativeVector r
          , Reference r
          , Set r
          , List r
          , EmptyStatement r stmt
          , MultiStatement r stmt
          , DeclStatement r stmt bod
          , PrintConsole r stmt
          , FileHandling r stmt
          , PrintFile r stmt
          , ControlStatement r stmt bod
          , MethodSym r vis mthd bod
          , TypeElim r
          , VariableElim r
          )
        => Bool -> GenState (Maybe (MS (r mthd)))
      genConstraints Bool
False = Maybe (MS (r mthd))
-> StateT DrasilState Identity (Maybe (MS (r mthd)))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MS (r mthd))
forall a. Maybe a
Nothing
      genConstraints Bool
_ = do
        parms <- GenState [Input]
getConstraintParams
        let varsList = (Input -> Bool) -> [Input] -> [Input]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Input
i -> UID -> ConstraintCEMap -> Bool
forall k a. Ord k => k -> Map k a -> Bool
member (Input
i Input -> Getting UID Input UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID Input UID
forall c. HasUID c => Getter c UID
Getter Input UID
uid) ConstraintCEMap
cm) (DrasilState
g DrasilState -> Getting [Input] DrasilState [Input] -> [Input]
forall s a. s -> Getting a s a -> a
^. Getting [Input] DrasilState [Input]
forall c. HasCodeSpec c => Lens' c [Input]
Lens' DrasilState [Input]
inputs)
            sfwrCs   = (Input -> (Input, [ConstraintCE]))
-> [Input] -> [(Input, [ConstraintCE])]
forall a b. (a -> b) -> [a] -> [b]
map (ConstraintCEMap -> Input -> (Input, [ConstraintCE])
forall q. HasUID q => ConstraintCEMap -> q -> (q, [ConstraintCE])
sfwrLookup ConstraintCEMap
cm) [Input]
varsList
            physCs   = (Input -> (Input, [ConstraintCE]))
-> [Input] -> [(Input, [ConstraintCE])]
forall a b. (a -> b) -> [a] -> [b]
map (ConstraintCEMap -> Input -> (Input, [ConstraintCE])
forall q. HasUID q => ConstraintCEMap -> q -> (q, [ConstraintCE])
physLookup ConstraintCEMap
cm) [Input]
varsList
        sf <- sfwrCBodyProc sfwrCs
        ph <- physCBodyProc physCs
        desc <- inConsFuncDesc
        mthd <- getFunc s icName void desc (map pcAuto parms)
          Nothing [block sf, block ph]
        return $ Just mthd
  genConstraints $ icName `elem` defSet g

-- | Generates input constraints code block for checking software constraints.
sfwrCBodyProc
  ::
    ( BlockSym r block stmt
    , BodySym r bod block
    , MathConstant r
    , VariableValue r
    , BooleanExpression r
    , Comparison r
    , NumericExpression r
    , ValueExpression r
    , Argument r
    , NativeVector r
    , Reference r
    , Set r
    , List r
    , EmptyStatement r stmt
    , DeclStatement r stmt bod
    , PrintConsole r stmt
    , ControlStatement r stmt bod
    , TypeElim r
    )
 => [(CodeVarChunk, [ConstraintCE])] -> GenState [MS (r stmt)]
sfwrCBodyProc :: forall (r :: * -> *) block stmt bod.
(BlockSym r block stmt, BodySym r bod block, MathConstant r,
 VariableValue r, BooleanExpression r, Comparison r,
 NumericExpression r, ValueExpression r, Argument r, NativeVector r,
 Reference r, Set r, List r, EmptyStatement r stmt,
 DeclStatement r stmt bod, PrintConsole r stmt,
 ControlStatement r stmt bod, TypeElim r) =>
[(Input, [ConstraintCE])] -> GenState [MS (r stmt)]
sfwrCBodyProc [(Input, [ConstraintCE])]
cs = do
  g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  let 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
  chooseConstrProc cb cs

-- | Generates input constraints code block for checking physical constraints.
physCBodyProc
  ::
    ( BlockSym r block stmt
    , BodySym r bod block
    , MathConstant r
    , VariableValue r
    , BooleanExpression r
    , Comparison r
    , NumericExpression r
    , ValueExpression r
    , Argument r
    , NativeVector r
    , Reference r
    , Set r
    , List r
    , EmptyStatement r stmt
    , DeclStatement r stmt bod
    , PrintConsole r stmt
    , ControlStatement r stmt bod
    , TypeElim r
    )
  => [(CodeVarChunk, [ConstraintCE])] -> GenState [MS (r stmt)]
physCBodyProc :: forall (r :: * -> *) block stmt bod.
(BlockSym r block stmt, BodySym r bod block, MathConstant r,
 VariableValue r, BooleanExpression r, Comparison r,
 NumericExpression r, ValueExpression r, Argument r, NativeVector r,
 Reference r, Set r, List r, EmptyStatement r stmt,
 DeclStatement r stmt bod, PrintConsole r stmt,
 ControlStatement r stmt bod, TypeElim r) =>
[(Input, [ConstraintCE])] -> GenState [MS (r stmt)]
physCBodyProc [(Input, [ConstraintCE])]
cs = do
  g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  let 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
  chooseConstrProc cb cs

-- | Generates conditional statements for checking constraints, where the
-- bodies depend on user's choice of constraint violation behaviour.
chooseConstrProc
  ::
    ( BlockSym r block stmt
    , BodySym r bod block
    , MathConstant r
    , VariableValue r
    , BooleanExpression r
    , Comparison r
    , NumericExpression r
    , ValueExpression r
    , Argument r
    , NativeVector r
    , Reference r
    , Set r
    , List r
    , EmptyStatement r stmt
    , DeclStatement r stmt bod
    , PrintConsole r stmt
    , ControlStatement r stmt bod
    , TypeElim r
    )
  => ConstraintBehaviour -> [(CodeVarChunk, [ConstraintCE])] -> GenState [MS (r stmt)]
chooseConstrProc :: forall (r :: * -> *) block stmt bod.
(BlockSym r block stmt, BodySym r bod block, MathConstant r,
 VariableValue r, BooleanExpression r, Comparison r,
 NumericExpression r, ValueExpression r, Argument r, NativeVector r,
 Reference r, Set r, List r, EmptyStatement r stmt,
 DeclStatement r stmt bod, PrintConsole r stmt,
 ControlStatement r stmt bod, TypeElim r) =>
ConstraintBehaviour
-> [(Input, [ConstraintCE])] -> GenState [MS (r stmt)]
chooseConstrProc ConstraintBehaviour
cb [(Input, [ConstraintCE])]
cs = do
  let ch :: [(Input, ConstraintCE)]
ch = ((Input, [ConstraintCE]) -> [(Input, ConstraintCE)])
-> [(Input, [ConstraintCE])] -> [(Input, ConstraintCE)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(Input
s, [ConstraintCE]
ns) -> [(Input
s, ConstraintCE
n) | ConstraintCE
n <- [ConstraintCE]
ns]) [(Input, [ConstraintCE])]
cs
  -- Generate variable declarations based on constraints
  varDecs <- ((Input, ConstraintCE)
 -> StateT DrasilState Identity (MS (r stmt)))
-> [(Input, ConstraintCE)]
-> StateT DrasilState Identity [MS (r stmt)]
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
    (Input
q, Elem ConstraintReason
_ CodeExpr
e) -> Input -> CodeExpr -> StateT DrasilState Identity (MS (r stmt))
forall (r :: * -> *) stmt bod.
(MathConstant r, VariableValue r, BooleanExpression r,
 Comparison r, NumericExpression r, ValueExpression r, Argument r,
 NativeVector r, Reference r, Set r, List r,
 DeclStatement r stmt bod, TypeElim r) =>
Input -> CodeExpr -> GenState (MS (r stmt))
constrVarDecProc Input
q CodeExpr
e
    (Input, ConstraintCE)
_             -> MS (r stmt) -> StateT DrasilState Identity (MS (r stmt))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return MS (r stmt)
forall {k} (r :: k -> *) (stmt :: k).
EmptyStatement r stmt =>
MS (r stmt)
emptyStmt) [(Input, ConstraintCE)]
ch
  conds <- mapM (\(Input
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 :: * -> *).
(MathConstant r, VariableValue r, BooleanExpression r,
 Comparison r, NumericExpression r, ValueExpression r, Argument r,
 NativeVector r, Reference r, Set r, List r, 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
. Input -> ConstraintCE -> CodeExpr
forall c. (IsChunk c, HasSymbol c) => c -> ConstraintCE -> CodeExpr
renderC Input
q) [ConstraintCE]
cns) cs
  bods <- mapM (chooseCB cb) cs
  let bodies = [[MS (r stmt)]] -> [MS (r stmt)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[MS (r stmt)]] -> [MS (r stmt)])
-> [[MS (r stmt)]] -> [MS (r stmt)]
forall a b. (a -> b) -> a -> b
$ ([SValue r] -> [MS (r bod)] -> [MS (r stmt)])
-> [[SValue r]] -> [[MS (r bod)]] -> [[MS (r stmt)]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ((SValue r -> MS (r bod) -> MS (r stmt))
-> [SValue r] -> [MS (r bod)] -> [MS (r stmt)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\SValue r
cond MS (r bod)
bod -> [(SValue r, MS (r bod))] -> MS (r stmt)
forall (r :: * -> *) bod block stmt.
(BodySym r bod block, ControlStatement r stmt bod) =>
[(SValue r, MS (r bod))] -> MS (r stmt)
ifNoElse [(SValue r -> SValue r
forall (r :: * -> *). BooleanExpression r => SValue r -> SValue r
(?!) SValue r
cond, MS (r bod)
bod)])) [[SValue r]]
conds [[MS (r bod)]]
bods
  return $ interleave varDecs bodies
  where chooseCB :: ConstraintBehaviour
-> (Input, [ConstraintCE]) -> GenState [MS (r bod)]
chooseCB ConstraintBehaviour
Warning = (Input, [ConstraintCE]) -> GenState [MS (r bod)]
forall (r :: * -> *) stmt block bod.
(MathConstant r, VariableValue r, BooleanExpression r,
 Comparison r, NumericExpression r, ValueExpression r, Argument r,
 NativeVector r, Reference r, Set r, List r, PrintConsole r stmt,
 BlockSym r block stmt, BodySym r bod block, TypeElim r) =>
(Input, [ConstraintCE]) -> GenState [MS (r bod)]
constrWarnProc
        chooseCB ConstraintBehaviour
Exception = (Input, [ConstraintCE]) -> GenState [MS (r bod)]
forall (r :: * -> *) block stmt bod.
(BlockSym r block stmt, BodySym r bod block, MathConstant r,
 VariableValue r, BooleanExpression r, Comparison r,
 NumericExpression r, ValueExpression r, Argument r, NativeVector r,
 Reference r, Set r, List r, PrintConsole r stmt,
 ControlStatement r stmt bod, TypeElim r) =>
(Input, [ConstraintCE]) -> GenState [MS (r bod)]
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
  ::
    ( MathConstant r
    , VariableValue r
    , BooleanExpression r
    , Comparison r
    , NumericExpression r
    , ValueExpression r
    , Argument r
    , NativeVector r
    , Reference r
    , Set r
    , List r
    , PrintConsole r stmt
    , BlockSym r block stmt
    , BodySym r bod block
    , TypeElim r
    )
  => (CodeVarChunk, [ConstraintCE]) -> GenState [MS (r bod)]
constrWarnProc :: forall (r :: * -> *) stmt block bod.
(MathConstant r, VariableValue r, BooleanExpression r,
 Comparison r, NumericExpression r, ValueExpression r, Argument r,
 NativeVector r, Reference r, Set r, List r, PrintConsole r stmt,
 BlockSym r block stmt, BodySym r bod block, TypeElim r) =>
(Input, [ConstraintCE]) -> GenState [MS (r bod)]
constrWarnProc (Input, [ConstraintCE])
c = do
  let q :: Input
q = (Input, [ConstraintCE]) -> Input
forall a b. (a, b) -> a
fst (Input, [ConstraintCE])
c
      cs :: [ConstraintCE]
cs = (Input, [ConstraintCE]) -> [ConstraintCE]
forall a b. (a, b) -> b
snd (Input, [ConstraintCE])
c
  msgs <- (ConstraintCE -> StateT DrasilState Identity [MS (r stmt)])
-> [ConstraintCE] -> StateT DrasilState Identity [[MS (r stmt)]]
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 (Input
-> String
-> ConstraintCE
-> StateT DrasilState Identity [MS (r stmt)]
forall (r :: * -> *) stmt.
(MathConstant r, VariableValue r, BooleanExpression r,
 Comparison r, NumericExpression r, ValueExpression r, Argument r,
 NativeVector r, Reference r, Set r, List r, PrintConsole r stmt,
 TypeElim r) =>
Input -> String -> ConstraintCE -> GenState [MS (r stmt)]
constraintViolatedMsgProc Input
q String
"suggested") [ConstraintCE]
cs
  return $ map (bodyStatements . (printStr "Warning: " :)) 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
  ::
    ( BlockSym r block stmt
    , BodySym r bod block
    , MathConstant r
    , VariableValue r
    , BooleanExpression r
    , Comparison r
    , NumericExpression r
    , ValueExpression r
    , Argument r
    , NativeVector r
    , Reference r
    , Set r
    , List r
    , PrintConsole r stmt
    , ControlStatement r stmt bod
    , TypeElim r
    )
  => (CodeVarChunk, [ConstraintCE]) -> GenState [MS (r bod)]
constrExcProc :: forall (r :: * -> *) block stmt bod.
(BlockSym r block stmt, BodySym r bod block, MathConstant r,
 VariableValue r, BooleanExpression r, Comparison r,
 NumericExpression r, ValueExpression r, Argument r, NativeVector r,
 Reference r, Set r, List r, PrintConsole r stmt,
 ControlStatement r stmt bod, TypeElim r) =>
(Input, [ConstraintCE]) -> GenState [MS (r bod)]
constrExcProc (Input, [ConstraintCE])
c = do
  let q :: Input
q = (Input, [ConstraintCE]) -> Input
forall a b. (a, b) -> a
fst (Input, [ConstraintCE])
c
      cs :: [ConstraintCE]
cs = (Input, [ConstraintCE]) -> [ConstraintCE]
forall a b. (a, b) -> b
snd (Input, [ConstraintCE])
c
  msgs <- (ConstraintCE -> StateT DrasilState Identity [MS (r stmt)])
-> [ConstraintCE] -> StateT DrasilState Identity [[MS (r stmt)]]
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 (Input
-> String
-> ConstraintCE
-> StateT DrasilState Identity [MS (r stmt)]
forall (r :: * -> *) stmt.
(MathConstant r, VariableValue r, BooleanExpression r,
 Comparison r, NumericExpression r, ValueExpression r, Argument r,
 NativeVector r, Reference r, Set r, List r, PrintConsole r stmt,
 TypeElim r) =>
Input -> String -> ConstraintCE -> GenState [MS (r stmt)]
constraintViolatedMsgProc Input
q String
"expected") [ConstraintCE]
cs
  return $ map (bodyStatements . (++ [throw "InputError"])) msgs

-- | Generate a set variable dec
constrVarDecProc
  ::
    ( MathConstant r
    , VariableValue r
    , BooleanExpression r
    , Comparison r
    , NumericExpression r
    , ValueExpression r
    , Argument r
    , NativeVector r
    , Reference r
    , Set r
    , List r
    , DeclStatement r stmt bod
    , TypeElim r
    )
  => CodeVarChunk -> CodeExpr ->
  GenState (MS (r stmt))
constrVarDecProc :: forall (r :: * -> *) stmt bod.
(MathConstant r, VariableValue r, BooleanExpression r,
 Comparison r, NumericExpression r, ValueExpression r, Argument r,
 NativeVector r, Reference r, Set r, List r,
 DeclStatement r stmt bod, TypeElim r) =>
Input -> CodeExpr -> GenState (MS (r stmt))
constrVarDecProc Input
v CodeExpr
e = do
  lb <- CodeExpr -> GenState (SValue r)
forall (r :: * -> *).
(MathConstant r, VariableValue r, BooleanExpression r,
 Comparison r, NumericExpression r, ValueExpression r, Argument r,
 NativeVector r, Reference r, Set r, List r, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
e
  t <- codeType v
  let 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]
++ Input -> String
forall x. HasSymbol x => x -> String
showHasSymbImpl Input
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))
  return (setDecDef mkValue local 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
  ::
    ( MathConstant r
    , VariableValue r
    , BooleanExpression r
    , Comparison r
    , NumericExpression r
    , ValueExpression r
    , Argument r
    , NativeVector r
    , Reference r
    , Set r
    , List r
    , PrintConsole r stmt
    , TypeElim r
    )
  => CodeVarChunk -> String -> ConstraintCE -> GenState [MS (r stmt)]
constraintViolatedMsgProc :: forall (r :: * -> *) stmt.
(MathConstant r, VariableValue r, BooleanExpression r,
 Comparison r, NumericExpression r, ValueExpression r, Argument r,
 NativeVector r, Reference r, Set r, List r, PrintConsole r stmt,
 TypeElim r) =>
Input -> String -> ConstraintCE -> GenState [MS (r stmt)]
constraintViolatedMsgProc Input
q String
s ConstraintCE
c = do
  pc <- ConstraintCE -> GenState [MS (r stmt)]
forall (r :: * -> *) stmt.
(MathConstant r, VariableValue r, BooleanExpression r,
 Comparison r, NumericExpression r, ValueExpression r, Argument r,
 NativeVector r, Reference r, Set r, List r, PrintConsole r stmt,
 TypeElim r) =>
ConstraintCE -> GenState [MS (r stmt)]
printConstraintProc ConstraintCE
c
  v <- mkValProc (quantvar q)
  return $ [printStr $ codeName q ++ " has value ",
    print v,
    printStr $ ", but is " ++ s ++ " to be "] ++ 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
  ::
    ( MathConstant r
    , VariableValue r
    , BooleanExpression r
    , Comparison r
    , NumericExpression r
    , ValueExpression r
    , Argument r
    , NativeVector r
    , Reference r
    , Set r
    , List r
    , PrintConsole r stmt
    , TypeElim r
    )
  => ConstraintCE -> GenState [MS (r stmt)]
printConstraintProc :: forall (r :: * -> *) stmt.
(MathConstant r, VariableValue r, BooleanExpression r,
 Comparison r, NumericExpression r, ValueExpression r, Argument r,
 NativeVector r, Reference r, Set r, List r, PrintConsole r stmt,
 TypeElim r) =>
ConstraintCE -> GenState [MS (r stmt)]
printConstraintProc ConstraintCE
c = do
  g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  let db = DrasilState -> PrintingInformation
printfo DrasilState
g
      printConstraint'
        ::
          ( MathConstant r
          , VariableValue r
          , BooleanExpression r
          , Comparison r
          , NumericExpression r
          , ValueExpression r
          , Argument r
          , NativeVector r
          , Reference r
          , Set r
          , List r
          , PrintConsole r stmt
          , TypeElim r
          )
        => ConstraintCE -> GenState [MS (r stmt)]
      printConstraint' (Range ConstraintReason
_ (Bounded (Inclusive
_, CodeExpr
e1) (Inclusive
_, CodeExpr
e2))) = do
        lb <- CodeExpr -> GenState (SValue r)
forall (r :: * -> *).
(MathConstant r, VariableValue r, BooleanExpression r,
 Comparison r, NumericExpression r, ValueExpression r, Argument r,
 NativeVector r, Reference r, Set r, List r, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
e1
        ub <- convExprProc e2
        return $ [printStr "between ", print lb] ++ printExpr e1 db ++
          [printStr " and ", print ub] ++ printExpr e2 db ++ [printStrLn "."]
      printConstraint' (Range ConstraintReason
_ (UpTo (Inclusive
_, CodeExpr
e))) = do
        ub <- CodeExpr -> GenState (SValue r)
forall (r :: * -> *).
(MathConstant r, VariableValue r, BooleanExpression r,
 Comparison r, NumericExpression r, ValueExpression r, Argument r,
 NativeVector r, Reference r, Set r, List r, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
e
        return $ [printStr "below ", print ub] ++ printExpr e db ++
          [printStrLn "."]
      printConstraint' (Range ConstraintReason
_ (UpFrom (Inclusive
_, CodeExpr
e))) = do
        lb <- CodeExpr -> GenState (SValue r)
forall (r :: * -> *).
(MathConstant r, VariableValue r, BooleanExpression r,
 Comparison r, NumericExpression r, ValueExpression r, Argument r,
 NativeVector r, Reference r, Set r, List r, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
e
        return $ [printStr "above ", print lb] ++ printExpr e db ++ [printStrLn "."]
      printConstraint' (Elem ConstraintReason
_ CodeExpr
e) = do
        lb <- CodeExpr -> GenState (SValue r)
forall (r :: * -> *).
(MathConstant r, VariableValue r, BooleanExpression r,
 Comparison r, NumericExpression r, ValueExpression r, Argument r,
 NativeVector r, Reference r, Set r, List r, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
e
        return $ [printStr "an element of the set ", print lb] ++ [printStrLn "."]
  printConstraint' c

-- | Generates a module containing the function for printing outputs.
genOutputModProc
  :: (NativeVector r, ProcProg r vis stmt mthd prg file mod bod block)
  => GenState [FS (r file)]
genOutputModProc :: forall (r :: * -> *) vis stmt mthd prg file mod bod block.
(NativeVector r,
 ProcProg r vis stmt mthd prg file mod bod block) =>
GenState [FS (r file)]
genOutputModProc = do
  ofName <- InternalConcept -> GenState String
genICName InternalConcept
OutputFormat
  ofDesc <- modDesc $ liftS outputFormatDesc
  liftS $ genModuleProc ofName ofDesc [genOutputFormatProc]

-- | Generates a function for printing output values.
genOutputFormatProc
  ::
    ( BlockSym r block stmt
    , BodySym r bod block
    , NativeVector r
    , MathConstant r
    , VariableValue r
    , BooleanExpression r
    , Comparison r
    , NumericExpression r
    , ValueExpression r
    , Argument r
    , List r
    , Reference r
    , Set r
    , MultiStatement r stmt
    , DeclStatement r stmt bod
    , ControlStatement r stmt bod
    , FileHandling r stmt
    , PrintFile r stmt
    , MethodSym r vis mthd bod
    , TypeElim r
    , VariableElim r
    )
  => GenState (Maybe (MS (r mthd)))
genOutputFormatProc :: forall (r :: * -> *) block stmt bod vis mthd.
(BlockSym r block stmt, BodySym r bod block, NativeVector r,
 MathConstant r, VariableValue r, BooleanExpression r, Comparison r,
 NumericExpression r, ValueExpression r, Argument r, List r,
 Reference r, Set r, MultiStatement r stmt,
 DeclStatement r stmt bod, ControlStatement r stmt bod,
 FileHandling r stmt, PrintFile r stmt, MethodSym r vis mthd bod,
 TypeElim r, VariableElim r) =>
GenState (Maybe (MS (r mthd)))
genOutputFormatProc = do
  g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  modify (\DrasilState
st -> DrasilState
st {currentScope = Local})
  woName <- genICName WriteOutput
  let genOutput
        ::
          ( BlockSym r block stmt
          , BodySym r bod block
          , NativeVector r
          , MathConstant r
          , VariableValue r
          , BooleanExpression r
          , Comparison r
          , NumericExpression r
          , ValueExpression r
          , Argument r
          , List r
          , Reference r
          , Set r
          , MultiStatement r stmt
          , DeclStatement r stmt bod
          , ControlStatement r stmt bod
          , FileHandling r stmt
          , PrintFile r stmt
          , MethodSym r vis mthd bod
          , TypeElim r
          , VariableElim r
          )
        => Maybe String -> GenState (Maybe (MS (r mthd)))
      genOutput Maybe String
Nothing = Maybe (MS (r mthd))
-> StateT DrasilState Identity (Maybe (MS (r mthd)))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MS (r mthd))
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
        parms <- GenState [Input]
getOutputParams
        let outs = (Input -> Input) -> [Input] -> [Input]
forall a b. (a -> b) -> [a] -> [b]
map (DrasilState -> Input -> Input
resolveOutputDefType DrasilState
g) (DrasilState
g DrasilState -> Getting [Input] DrasilState [Input] -> [Input]
forall s a. s -> Getting a s a -> a
^. Getting [Input] DrasilState [Input]
forall c. HasCodeSpec c => Lens' c [Input]
Lens' DrasilState [Input]
outputs)
        outp <- mapM (\Input
x -> do
          v <- Input -> GenState (SValue r)
forall (r :: * -> *).
(NativeVector r, MathConstant r, VariableValue r,
 BooleanExpression r, Comparison r, NumericExpression r,
 ValueExpression r, Argument r, List r, Reference r, Set r,
 TypeElim r) =>
Input -> GenState (SValue r)
mkValProc Input
x
          return $
            printFileStr v_outfile (codeName x ++ " = ")
            : writeOutputValue v_outfile v (x ^. typ) ) outs
        desc <- woFuncDesc
        mthd <- publicFuncProc woName void desc (map pcAuto parms) Nothing
          [block $ [
          varDec var_outfile local,
          openFileW var_outfile (litString "output.txt") ] ++
          concat outp ++ [ closeFile v_outfile ]]
        return $ Just mthd
  genOutput $ Map.lookup woName (eMap g)

writeOutputValue
  ::
    ( BlockSym r block stmt
    , BodySym r bod block
    , Literal r
    , VariableValue r
    , Comparison r
    , NumericExpression r
    , ControlStatement r stmt bod
    , PrintFile r stmt
    , List r
    )
  => SValue r -> SValue r -> Space -> [MS (r stmt)]
writeOutputValue :: forall (r :: * -> *) block stmt bod.
(BlockSym r block stmt, BodySym r bod block, Literal r,
 VariableValue r, Comparison r, NumericExpression r,
 ControlStatement r stmt bod, PrintFile r stmt, List r) =>
SValue r -> SValue r -> Space -> [MS (r stmt)]
writeOutputValue SValue r
out = SValue r -> Space -> [MS (r stmt)]
writeTop
  where
    writeTop :: SValue r -> Space -> [MS (r stmt)]
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 :: * -> *). List r => SValue r -> SValue r -> SValue r
listAccess SValue r
curr SValue r
vIdx
      in [ SValue r -> String -> MS (r stmt)
forall (r :: * -> *) stmt.
PrintFile r stmt =>
SValue r -> String -> MS (r stmt)
printFileStr SValue r
out String
"["
         , SVariable r
-> SValue r -> SValue r -> SValue r -> MS (r bod) -> MS (r stmt)
forall (r :: * -> *) stmt bod.
ControlStatement r stmt bod =>
SVariable r
-> SValue r -> SValue r -> SValue r -> MS (r bod) -> MS (r stmt)
forRange SVariable r
idx (Integer -> SValue r
forall (r :: * -> *). Literal r => Integer -> SValue r
litInt Integer
0) (SValue r -> SValue r
forall (r :: * -> *). List r => SValue r -> SValue r
listSize SValue r
curr) (Integer -> SValue r
forall (r :: * -> *). Literal r => Integer -> SValue r
litInt Integer
1) (MS (r bod) -> MS (r stmt)) -> MS (r bod) -> MS (r stmt)
forall a b. (a -> b) -> a -> b
$ [MS (r stmt)] -> MS (r bod)
forall {k} (r :: k -> *) (block :: k) (stmt :: k) (bod :: k).
(BlockSym r block stmt, BodySym r bod block) =>
[MS (r stmt)] -> MS (r bod)
bodyStatements ([MS (r stmt)] -> MS (r bod)) -> [MS (r stmt)] -> MS (r bod)
forall a b. (a -> b) -> a -> b
$
             Integer -> SValue r -> Space -> [MS (r stmt)]
writeInner (Integer
2 :: Integer) SValue r
elemAt Space
inner [MS (r stmt)] -> [MS (r stmt)] -> [MS (r stmt)]
forall a. [a] -> [a] -> [a]
++
             [[(SValue r, MS (r bod))] -> MS (r stmt)
forall (r :: * -> *) bod block stmt.
(BodySym r bod block, ControlStatement r stmt bod) =>
[(SValue r, MS (r bod))] -> MS (r stmt)
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 :: * -> *). List r => 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 stmt)] -> MS (r bod)
forall {k} (r :: k -> *) (block :: k) (stmt :: k) (bod :: k).
(BlockSym r block stmt, BodySym r bod block) =>
[MS (r stmt)] -> MS (r bod)
bodyStatements [SValue r -> String -> MS (r stmt)
forall (r :: * -> *) stmt.
PrintFile r stmt =>
SValue r -> String -> MS (r stmt)
printFileStr SValue r
out String
", "])]]
         , SValue r -> String -> MS (r stmt)
forall (r :: * -> *) stmt.
PrintFile r stmt =>
SValue r -> String -> MS (r stmt)
printFileStrLn SValue r
out String
"]"
         ]
    writeTop SValue r
curr Space
_ = [SValue r -> SValue r -> MS (r stmt)
forall (r :: * -> *) stmt.
PrintFile r stmt =>
SValue r -> SValue r -> MS (r stmt)
printFileLn SValue r
out SValue r
curr]
    writeInner :: Integer -> SValue r -> Space -> [MS (r stmt)]
writeInner Integer
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]
++ Integer -> String
forall a. Show a => a -> String
show Integer
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 :: * -> *). List r => SValue r -> SValue r -> SValue r
listAccess SValue r
curr SValue r
vIdx
      in [ SValue r -> String -> MS (r stmt)
forall (r :: * -> *) stmt.
PrintFile r stmt =>
SValue r -> String -> MS (r stmt)
printFileStr SValue r
out String
"["
         , SVariable r
-> SValue r -> SValue r -> SValue r -> MS (r bod) -> MS (r stmt)
forall (r :: * -> *) stmt bod.
ControlStatement r stmt bod =>
SVariable r
-> SValue r -> SValue r -> SValue r -> MS (r bod) -> MS (r stmt)
forRange SVariable r
idx (Integer -> SValue r
forall (r :: * -> *). Literal r => Integer -> SValue r
litInt Integer
0) (SValue r -> SValue r
forall (r :: * -> *). List r => SValue r -> SValue r
listSize SValue r
curr) (Integer -> SValue r
forall (r :: * -> *). Literal r => Integer -> SValue r
litInt Integer
1) (MS (r bod) -> MS (r stmt)) -> MS (r bod) -> MS (r stmt)
forall a b. (a -> b) -> a -> b
$ [MS (r stmt)] -> MS (r bod)
forall {k} (r :: k -> *) (block :: k) (stmt :: k) (bod :: k).
(BlockSym r block stmt, BodySym r bod block) =>
[MS (r stmt)] -> MS (r bod)
bodyStatements ([MS (r stmt)] -> MS (r bod)) -> [MS (r stmt)] -> MS (r bod)
forall a b. (a -> b) -> a -> b
$
             Integer -> SValue r -> Space -> [MS (r stmt)]
writeInner (Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1) SValue r
elemAt Space
inner [MS (r stmt)] -> [MS (r stmt)] -> [MS (r stmt)]
forall a. [a] -> [a] -> [a]
++
             [[(SValue r, MS (r bod))] -> MS (r stmt)
forall (r :: * -> *) bod block stmt.
(BodySym r bod block, ControlStatement r stmt bod) =>
[(SValue r, MS (r bod))] -> MS (r stmt)
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 :: * -> *). List r => 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 stmt)] -> MS (r bod)
forall {k} (r :: k -> *) (block :: k) (stmt :: k) (bod :: k).
(BlockSym r block stmt, BodySym r bod block) =>
[MS (r stmt)] -> MS (r bod)
bodyStatements [SValue r -> String -> MS (r stmt)
forall (r :: * -> *) stmt.
PrintFile r stmt =>
SValue r -> String -> MS (r stmt)
printFileStr SValue r
out String
", "])]]
         , SValue r -> String -> MS (r stmt)
forall (r :: * -> *) stmt.
PrintFile r stmt =>
SValue r -> String -> MS (r stmt)
printFileStr SValue r
out String
"]"
         ]
    writeInner Integer
_ SValue r
curr Space
_ = [SValue r -> SValue r -> MS (r stmt)
forall (r :: * -> *) stmt.
PrintFile r stmt =>
SValue r -> SValue r -> MS (r stmt)
printFile SValue r
out SValue r
curr]