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 (oneLineCodeSymbolDoc, PrintingInformation,
  oneLineCodeExprDoc)
import Drasil.GOOL (VS, CS, FS, MS, CSStateVar, OOProg, BodySym(..),
  bodyStatements, oneLiner, BlockSym(..), AttachmentSym(..), TypeSym(..),
  ValueSym, VariableSym(..), ScopeSym(..), Literal(..), OOTypeSym, OOVariableSym,
  VariableValue(..), CommandLineArgs(..), NumericExpression(..),
  BooleanExpression(..), Comparison(..), List(..), ListStatement(..),
  EmptyStatement(emptyStmt), MultiStatement(multi), ValueStatement,
  AssignStatement(..), DeclStatement(..), OODeclStatement(..), objDecNewNoParams,
  extObjDecNewNoParams, PrintConsole(..), FileHandling(..), PrintFile(..),
  ControlStatement(..), ifNoElse, VisibilitySym(..), ParameterSym, 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 (renderTermAndUnit)
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 prg file mod cls stvr mthd attch vis param bod block stmt var scope val binder typ)
  => GenState (FS (r file))
genMain :: forall (r :: * -> *) prg file mod cls stvr mthd attch vis param bod
       block stmt var scope val binder typ.
OOProg
  r
  prg
  file
  mod
  cls
  stvr
  mthd
  attch
  vis
  param
  bod
  block
  stmt
  var
  scope
  val
  binder
  typ =>
GenState (FS (r file))
genMain = String
-> String
-> [GenState (Maybe (MS (r mthd)))]
-> [GenState (Maybe (CS (r cls)))]
-> GenState (FS (r file))
forall (r :: * -> *) prg file mod cls stvr mthd attch vis param bod
       block stmt var scope val binder typ.
OOProg
  r
  prg
  file
  mod
  cls
  stvr
  mthd
  attch
  vis
  param
  bod
  block
  stmt
  var
  scope
  val
  binder
  typ =>
String
-> String
-> [GenState (Maybe (MS (r mthd)))]
-> [GenState (Maybe (CS (r cls)))]
-> GenState (FS (r file))
genModule String
"Control" String
"Controls the flow of the program"
  [GenState (Maybe (MS (r mthd)))
forall (r :: * -> *) prg file mod cls stvr mthd attch vis param bod
       block stmt var scope val binder typ.
OOProg
  r
  prg
  file
  mod
  cls
  stvr
  mthd
  attch
  vis
  param
  bod
  block
  stmt
  var
  scope
  val
  binder
  typ =>
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 prg file mod cls stvr mthd attch vis param bod block stmt var scope val binder typ)
  => GenState (Maybe (MS (r mthd)))
genMainFunc :: forall (r :: * -> *) prg file mod cls stvr mthd attch vis param bod
       block stmt var scope val binder typ.
OOProg
  r
  prg
  file
  mod
  cls
  stvr
  mthd
  attch
  vis
  param
  bod
  block
  stmt
  var
  scope
  val
  binder
  typ =>
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 (f :: * -> *) a. Applicative f => a -> f a
pure 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 (VS (r var))
forall {k} (r :: k -> *) (typ :: k) (var :: k) (val :: k).
(TypeSym r typ, OOTypeSym r typ, VariableSym r var typ,
 OOVariableSym r var val typ, SelfSym r var, VariableElim r var typ,
 VariableValue r var val) =>
Input -> GenState (VS (r var))
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
          pure $ 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
  ::
    ( ValueSym r val typ
    , Argument r val
    , Literal r val typ
    , MathConstant r val
    , TypeSym r typ
    , OOTypeSym r typ
    , VariableSym r var typ
    , OOVariableSym r var val typ
    , VariableValue r var val
    , ScopeSym r scope
    , BooleanExpression r val
    , Comparison r val
    , NumericExpression r val
    , SelfSym r var
    , InternalValueExp r var val typ
    , ValueExpression r var val binder typ
    , OOValueExpression r var val typ
    , List r val
    , Reference r val
    , Set r val
    , MultiStatement r stmt
    , DeclStatement r bod stmt var scope val
    , OODeclStatement r stmt var scope val
    , TypeElim r typ
    , VariableElim r var typ
    )
  => GenState (Maybe (MS (r stmt)))
getInputDecl :: forall {k} (r :: k -> *) (val :: k) (typ :: k) (var :: k)
       (scope :: k) (binder :: k) (stmt :: k) (bod :: k).
(ValueSym r val typ, Argument r val, Literal r val typ,
 MathConstant r val, TypeSym r typ, OOTypeSym r typ,
 VariableSym r var typ, OOVariableSym r var val typ,
 VariableValue r var val, ScopeSym r scope, BooleanExpression r val,
 Comparison r val, NumericExpression r val, SelfSym r var,
 InternalValueExp r var val typ,
 ValueExpression r var val binder typ,
 OOValueExpression r var val typ, List r val, Reference r val,
 Set r val, MultiStatement r stmt,
 DeclStatement r bod stmt var scope val,
 OODeclStatement r stmt var scope val, TypeElim r typ,
 VariableElim r var typ) =>
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 scope
forall {k} (r :: k -> *) (scope :: k).
ScopeSym r scope =>
ScopeType -> r scope
convScope (ScopeType -> r scope) -> ScopeType -> r scope
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
forall c. (Quantity c, MayHaveUnit c, Concept c) => c -> Input
quantvar (Const -> Input) -> [Const] -> [Input]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f 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 (VS (r var)))
-> [Input] -> StateT DrasilState Identity [VS (r var)]
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 (VS (r var))
forall {k} (r :: k -> *) (typ :: k) (var :: k) (val :: k).
(TypeSym r typ, OOTypeSym r typ, VariableSym r var typ,
 OOVariableSym r var val typ, SelfSym r var, VariableElim r var typ,
 VariableValue r var val) =>
Input -> GenState (VS (r var))
mkVar [Input]
ins
        pure $ Just $ multi $ (`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 (f :: * -> *) a. Applicative f => a -> f a
pure (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 VS (r var) -> r scope -> [VS (r val)] -> MS (r stmt)
forall {k} (r :: k -> *) (stmt :: k) (var :: k) (scope :: k)
       (val :: k).
OODeclStatement r stmt var scope val =>
VS (r var) -> r scope -> [VS (r val)] -> MS (r stmt)
objDecNew
        else String -> VS (r var) -> r scope -> [VS (r val)] -> MS (r stmt)
forall {k} (r :: k -> *) (stmt :: k) (var :: k) (scope :: k)
       (val :: k).
OODeclStatement r stmt var scope val =>
String -> VS (r var) -> r scope -> [VS (r val)] -> MS (r stmt)
extObjDecNew String
cname) VS (r var)
v_params r scope
scp [VS (r val)]
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. Semigroup 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 (f :: * -> *) a. Applicative f => a -> f a
pure 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 (f :: * -> *) a. Applicative f => a -> f a
pure 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
  ::
    ( ValueSym r val typ
    , Argument r val
    , MathConstant r val
    , TypeSym r typ
    , OOTypeSym r typ
    , ScopeSym r scope
    , VariableSym r var typ
    , OOVariableSym r var val typ
    , VariableValue r var val
    , Literal r val typ
    , BooleanExpression r val
    , Comparison r val
    , NumericExpression r val
    , SelfSym r var
    , InternalValueExp r var val typ
    , ValueExpression r var val binder typ
    , OOValueExpression r var val typ
    , List r val
    , Reference r val
    , Set r val
    , MultiStatement r stmt
    , DeclStatement r bod stmt var scope val
    , OODeclStatement r stmt var scope val
    , TypeElim r typ
    , VariableElim r var typ
    )
  => GenState (Maybe (MS (r stmt)))
initConsts :: forall {k} (r :: k -> *) (val :: k) (typ :: k) (scope :: k)
       (var :: k) (binder :: k) (stmt :: k) (bod :: k).
(ValueSym r val typ, Argument r val, MathConstant r val,
 TypeSym r typ, OOTypeSym r typ, ScopeSym r scope,
 VariableSym r var typ, OOVariableSym r var val typ,
 VariableValue r var val, Literal r val typ,
 BooleanExpression r val, Comparison r val, NumericExpression r val,
 SelfSym r var, InternalValueExp r var val typ,
 ValueExpression r var val binder typ,
 OOValueExpression r var val typ, List r val, Reference r val,
 Set r val, MultiStatement r stmt,
 DeclStatement r bod stmt var scope val,
 OODeclStatement r stmt var scope val, TypeElim r typ,
 VariableElim r var typ) =>
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 scope
forall {k} (r :: k -> *) (scope :: k).
ScopeSym r scope =>
ScopeType -> r scope
convScope (ScopeType -> r scope) -> ScopeType -> r scope
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 (f :: * -> *) a. Applicative f => a -> f a
pure 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 (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (MS (r stmt))
forall a. Maybe a
Nothing
      declVars = do
        vars <- (Const -> GenState (VS (r var)))
-> [Const] -> StateT DrasilState Identity [VS (r var)]
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 (VS (r var))
forall {k} (r :: k -> *) (typ :: k) (var :: k) (val :: k).
(TypeSym r typ, OOTypeSym r typ, VariableSym r var typ,
 OOVariableSym r var val typ, SelfSym r var, VariableElim r var typ,
 VariableValue r var val) =>
Input -> GenState (VS (r var))
mkVar (Input -> GenState (VS (r var)))
-> (Const -> Input) -> Const -> GenState (VS (r var))
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
        pure $ Just $ multi $
          zipWith (\VS (r var)
vr -> ConstantRepr -> VS (r var) -> r scope -> VS (r val) -> MS (r stmt)
forall {k} {r :: k -> *} {bod :: k} {stmt :: k} {var :: k}
       {scope :: k} {val :: k}.
DeclStatement r bod stmt var scope val =>
ConstantRepr -> VS (r var) -> r scope -> VS (r val) -> 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) VS (r var)
vr r scope
scp) vars vals
      defFunc ConstantRepr
Var = VS (r var) -> r scope -> VS (r val) -> MS (r stmt)
forall {k} (r :: k -> *) (bod :: k) (stmt :: k) (var :: k)
       (scope :: k) (val :: k).
DeclStatement r bod stmt var scope val =>
VS (r var) -> r scope -> VS (r val) -> MS (r stmt)
varDecDef
      defFunc ConstantRepr
Const = VS (r var) -> r scope -> VS (r val) -> MS (r stmt)
forall {k} (r :: k -> *) (bod :: k) (stmt :: k) (var :: k)
       (scope :: k) (val :: k).
DeclStatement r bod stmt var scope val =>
VS (r var) -> r scope -> VS (r val) -> 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 VS (r var) -> r scope -> MS (r stmt)
forall {k} (r :: k -> *) (stmt :: k) (var :: k) (scope :: k)
       (val :: k).
OODeclStatement r stmt var scope val =>
VS (r var) -> r scope -> MS (r stmt)
objDecNewNoParams else String -> VS (r var) -> r scope -> MS (r stmt)
forall {k} (r :: k -> *) (stmt :: k) (var :: k) (scope :: k)
       (val :: k).
OODeclStatement r stmt var scope val =>
String -> VS (r var) -> r scope -> MS (r stmt)
extObjDecNewNoParams String
cname) VS (r var)
v_consts r scope
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
  ::
    ( TypeSym r typ
    , VariableSym r var typ
    , DeclStatement r bod stmt var scope val
    )
  => [Logging] -> r scope -> [MS (r stmt)]
initLogFileVar :: forall {k} (r :: k -> *) (typ :: k) (var :: k) (bod :: k)
       (stmt :: k) (scope :: k) (val :: k).
(TypeSym r typ, VariableSym r var typ,
 DeclStatement r bod stmt var scope val) =>
[Logging] -> r scope -> [MS (r stmt)]
initLogFileVar [Logging]
l r scope
scp = [VS (r var) -> r scope -> MS (r stmt)
forall {k} (r :: k -> *) (bod :: k) (stmt :: k) (var :: k)
       (scope :: k) (val :: k).
DeclStatement r bod stmt var scope val =>
VS (r var) -> r scope -> MS (r stmt)
varDec VS (r var)
forall {k} (r :: k -> *) (typ :: k) (var :: k).
(TypeSym r typ, VariableSym r var typ) =>
VS (r var)
varLogFile r scope
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 prg file mod cls stvr mthd attch vis param bod block stmt var scope val binder typ)
  => GenState [FS (r file)]
genInputMod :: forall (r :: * -> *) prg file mod cls stvr mthd attch vis param bod
       block stmt var scope val binder typ.
OOProg
  r
  prg
  file
  mod
  cls
  stvr
  mthd
  attch
  vis
  param
  bod
  block
  stmt
  var
  scope
  val
  binder
  typ =>
GenState [FS (r file)]
genInputMod = do
  ipDesc <- GenState [String] -> GenState String
modDesc GenState [String]
inputParametersDesc
  cname <- genICName InputParameters
  let genMod
        :: (OOProg r prg file mod cls stvr mthd attch vis param bod block stmt var scope val binder typ)
        => Maybe (CS (r cls)) -> GenState (FS (r file))
      genMod Maybe (CS (r cls))
Nothing = String
-> String
-> [GenState (Maybe (MS (r mthd)))]
-> [GenState (Maybe (CS (r cls)))]
-> GenState (FS (r file))
forall (r :: * -> *) prg file mod cls stvr mthd attch vis param bod
       block stmt var scope val binder typ.
OOProg
  r
  prg
  file
  mod
  cls
  stvr
  mthd
  attch
  vis
  param
  bod
  block
  stmt
  var
  scope
  val
  binder
  typ =>
String
-> String
-> [GenState (Maybe (MS (r mthd)))]
-> [GenState (Maybe (CS (r cls)))]
-> GenState (FS (r file))
genModule String
cname String
ipDesc [VisibilityTag -> GenState (Maybe (MS (r mthd)))
forall (r :: * -> *) prg file mod cls stvr mthd attch vis param bod
       block stmt var scope val binder typ.
OOProg
  r
  prg
  file
  mod
  cls
  stvr
  mthd
  attch
  vis
  param
  bod
  block
  stmt
  var
  scope
  val
  binder
  typ =>
VisibilityTag -> GenState (Maybe (MS (r mthd)))
genInputFormat VisibilityTag
Pub,
        VisibilityTag -> GenState (Maybe (MS (r mthd)))
forall (r :: * -> *) prg file mod cls stvr mthd attch vis param bod
       block stmt var scope val binder typ.
OOProg
  r
  prg
  file
  mod
  cls
  stvr
  mthd
  attch
  vis
  param
  bod
  block
  stmt
  var
  scope
  val
  binder
  typ =>
VisibilityTag -> GenState (Maybe (MS (r mthd)))
genInputDerived VisibilityTag
Pub, VisibilityTag -> GenState (Maybe (MS (r mthd)))
forall (r :: * -> *) prg file mod cls stvr mthd attch vis param bod
       block stmt var scope val binder typ.
OOProg
  r
  prg
  file
  mod
  cls
  stvr
  mthd
  attch
  vis
  param
  bod
  block
  stmt
  var
  scope
  val
  binder
  typ =>
VisibilityTag -> GenState (Maybe (MS (r mthd)))
genInputConstraints VisibilityTag
Pub] []
      genMod Maybe (CS (r cls))
_ = String
-> String
-> [GenState (Maybe (MS (r mthd)))]
-> [GenState (Maybe (CS (r cls)))]
-> GenState (FS (r file))
forall (r :: * -> *) prg file mod cls stvr mthd attch vis param bod
       block stmt var scope val binder typ.
OOProg
  r
  prg
  file
  mod
  cls
  stvr
  mthd
  attch
  vis
  param
  bod
  block
  stmt
  var
  scope
  val
  binder
  typ =>
String
-> String
-> [GenState (Maybe (MS (r mthd)))]
-> [GenState (Maybe (CS (r cls)))]
-> GenState (FS (r file))
genModule String
cname String
ipDesc [] [ClassType -> GenState (Maybe (CS (r cls)))
forall (r :: * -> *) prg file mod cls stvr mthd attch vis param bod
       block stmt var scope val binder typ.
OOProg
  r
  prg
  file
  mod
  cls
  stvr
  mthd
  attch
  vis
  param
  bod
  block
  stmt
  var
  scope
  val
  binder
  typ =>
ClassType -> GenState (Maybe (CS (r cls)))
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
  ::
    ( AttachmentSym r attch
    , VisibilitySym r vis
    , StateVarSym r stvr attch vis var val
    )
  => ConstantRepr
  -> (VS (r var) -> VS (r val) -> CSStateVar r stvr)
constVarFunc :: forall {k} (r :: k -> *) (attch :: k) (vis :: k) (stvr :: k)
       (var :: k) (val :: k).
(AttachmentSym r attch, VisibilitySym r vis,
 StateVarSym r stvr attch vis var val) =>
ConstantRepr -> VS (r var) -> VS (r val) -> CSStateVar r stvr
constVarFunc ConstantRepr
Var = r vis -> r attch -> VS (r var) -> VS (r val) -> CSStateVar r stvr
forall {k} (r :: k -> *) (stvr :: k) (attch :: k) (vis :: k)
       (var :: k) (val :: k).
StateVarSym r stvr attch vis var val =>
r vis -> r attch -> VS (r var) -> VS (r val) -> 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 -> VS (r var) -> VS (r val) -> CSStateVar r stvr
forall {k} (r :: k -> *) (stvr :: k) (attch :: k) (vis :: k)
       (var :: k) (val :: k).
StateVarSym r stvr attch vis var val =>
r vis -> VS (r var) -> VS (r val) -> 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 prg file mod cls stvr mthd attch vis param bod block stmt var scope val binder typ)
  => ClassType -> GenState (Maybe (CS (r cls)))
genInputClass :: forall (r :: * -> *) prg file mod cls stvr mthd attch vis param bod
       block stmt var scope val binder typ.
OOProg
  r
  prg
  file
  mod
  cls
  stvr
  mthd
  attch
  vis
  param
  bod
  block
  stmt
  var
  scope
  val
  binder
  typ =>
ClassType -> GenState (Maybe (CS (r cls)))
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 prg file mod cls stvr mthd attch vis param bod block stmt var scope val binder typ)
        => 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 :: * -> *) prg file mod cls stvr mthd attch vis param bod
       block stmt var scope val binder typ.
OOProg
  r
  prg
  file
  mod
  cls
  stvr
  mthd
  attch
  vis
  param
  bod
  block
  stmt
  var
  scope
  val
  binder
  typ =>
GenState (Maybe (MS (r mthd)))
genInputConstructor]
        else [MS (r mthd)] -> StateT DrasilState Identity [MS (r mthd)]
forall a. a -> StateT DrasilState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
      methods
        :: (OOProg r prg file mod cls stvr mthd attch vis param bod block stmt var scope val binder typ)
        => 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 :: * -> *) prg file mod cls stvr mthd attch vis param bod
       block stmt var scope val binder typ.
OOProg
  r
  prg
  file
  mod
  cls
  stvr
  mthd
  attch
  vis
  param
  bod
  block
  stmt
  var
  scope
  val
  binder
  typ =>
VisibilityTag -> GenState (Maybe (MS (r mthd)))
genInputFormat VisibilityTag
Priv,
        VisibilityTag -> StateT DrasilState Identity (Maybe (MS (r mthd)))
forall (r :: * -> *) prg file mod cls stvr mthd attch vis param bod
       block stmt var scope val binder typ.
OOProg
  r
  prg
  file
  mod
  cls
  stvr
  mthd
  attch
  vis
  param
  bod
  block
  stmt
  var
  scope
  val
  binder
  typ =>
VisibilityTag -> GenState (Maybe (MS (r mthd)))
genInputDerived VisibilityTag
Priv, VisibilityTag -> StateT DrasilState Identity (Maybe (MS (r mthd)))
forall (r :: * -> *) prg file mod cls stvr mthd attch vis param bod
       block stmt var scope val binder typ.
OOProg
  r
  prg
  file
  mod
  cls
  stvr
  mthd
  attch
  vis
  param
  bod
  block
  stmt
  var
  scope
  val
  binder
  typ =>
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 (f :: * -> *) a. Applicative f => a -> f a
pure []
      genClass
        :: (OOProg r prg file mod cls stvr mthd attch vis param bod block stmt var scope val binder typ)
        => [CodeVarChunk] -> [CodeDefinition] -> GenState (Maybe (CS (r cls)))
      genClass [] [] = Maybe (CS (r cls))
-> StateT DrasilState Identity (Maybe (CS (r cls)))
forall a. a -> StateT DrasilState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (CS (r cls))
forall a. Maybe a
Nothing
      genClass [Input]
inps [Const]
csts = do
        vals <- (Const -> StateT DrasilState Identity (VS (r val)))
-> [Const] -> StateT DrasilState Identity [VS (r val)]
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 (VS (r val))
forall {k} (r :: k -> *) (val :: k) (typ :: k) (var :: k)
       (binder :: k).
(ValueSym r val typ, Argument r val, MathConstant r val,
 TypeSym r typ, OOTypeSym r typ, VariableSym r var typ,
 OOVariableSym r var val typ, VariableValue r var val,
 Literal r val typ, BooleanExpression r val, Comparison r val,
 NumericExpression r val, ValueExpression r var val binder typ,
 SelfSym r var, InternalValueExp r var val typ,
 OOValueExpression r var val typ, List r val, Reference r val,
 Set r val, TypeElim r typ, VariableElim r var typ) =>
CodeExpr -> GenState (VS (r val))
convExpr (CodeExpr -> StateT DrasilState Identity (VS (r val)))
-> (Const -> CodeExpr)
-> Const
-> StateT DrasilState Identity (VS (r val))
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 -> VS (r var) -> CSStateVar r stvr
forall {k} (r :: k -> *) (attch :: k) (vis :: k) (stvr :: k)
       (var :: k) (val :: k).
(AttachmentSym r attch, VisibilitySym r vis,
 StateVarSym r stvr attch vis var val) =>
VS (r var) -> CSStateVar r stvr
pubDVar (VS (r var) -> CSStateVar r stvr)
-> (CodeType -> VS (r var)) -> CodeType -> CSStateVar r stvr
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
          String -> VS (r typ) -> VS (r var)
forall {k} (r :: k -> *) (var :: k) (typ :: k).
VariableSym r var typ =>
String -> VS (r typ) -> VS (r var)
var (Input -> String
forall c. CodeIdea c => c -> String
codeName Input
x) (VS (r typ) -> VS (r var))
-> (CodeType -> VS (r typ)) -> CodeType -> VS (r var)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CodeType -> VS (r typ)
forall {k} (r :: k -> *) (typ :: k).
(TypeSym r typ, OOTypeSym r typ) =>
CodeType -> VS (r typ)
convTypeOO (CodeType -> CSStateVar r stvr)
-> StateT DrasilState Identity CodeType
-> StateT DrasilState Identity (CSStateVar r stvr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Input -> StateT DrasilState Identity CodeType
forall c. HasSpace c => c -> StateT DrasilState Identity CodeType
codeType Input
x) inps
        constVars <- zipWithM (\Const
c VS (r val)
vl -> (\CodeType
t -> ConstantRepr -> VS (r var) -> VS (r val) -> CSStateVar r stvr
forall {k} (r :: k -> *) (attch :: k) (vis :: k) (stvr :: k)
       (var :: k) (val :: k).
(AttachmentSym r attch, VisibilitySym r vis,
 StateVarSym r stvr attch vis var val) =>
ConstantRepr -> VS (r var) -> VS (r val) -> 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 typ) -> VS (r var)
forall {k} (r :: k -> *) (var :: k) (typ :: k).
VariableSym r var typ =>
String -> VS (r typ) -> VS (r var)
var (Const -> String
forall c. CodeIdea c => c -> String
codeName Const
c) (CodeType -> VS (r typ)
forall {k} (r :: k -> *) (typ :: k).
(TypeSym r typ, OOTypeSym r typ) =>
CodeType -> VS (r typ)
convTypeOO CodeType
t)) VS (r val)
vl) (CodeType -> CSStateVar r stvr)
-> StateT DrasilState Identity CodeType
-> StateT DrasilState Identity (CSStateVar r stvr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 cls))
forall {k} (r :: k -> *) (cls :: k) (stvr :: k) (mthd :: k).
ClassSym r cls stvr mthd =>
String
-> Maybe String
-> String
-> [CSStateVar r stvr]
-> GenState [MS (r mthd)]
-> GenState [MS (r mthd)]
-> GenState (CS (r cls))
primaryClass
            getFunc ClassType
Auxiliary = String
-> Maybe String
-> String
-> [CSStateVar r stvr]
-> GenState [MS (r mthd)]
-> GenState [MS (r mthd)]
-> GenState (CS (r cls))
forall {k} (r :: k -> *) (cls :: k) (stvr :: k) (mthd :: k).
ClassSym r cls stvr mthd =>
String
-> Maybe String
-> String
-> [CSStateVar r stvr]
-> GenState [MS (r mthd)]
-> GenState [MS (r mthd)]
-> GenState (CS (r cls))
auxClass
            f = ClassType
-> String
-> Maybe String
-> String
-> [CSStateVar r stvr]
-> GenState [MS (r mthd)]
-> GenState [MS (r mthd)]
-> GenState (CS (r cls))
forall {k} {r :: k -> *} {cls :: k} {stvr :: k} {mthd :: k}.
ClassSym r cls stvr mthd =>
ClassType
-> String
-> Maybe String
-> String
-> [CSStateVar r stvr]
-> GenState [MS (r mthd)]
-> GenState [MS (r mthd)]
-> GenState (CS (r cls))
getFunc ClassType
scp
        icDesc <- inputClassDesc
        c <- f cname Nothing icDesc (inputVars <> constVars) constructors methods
        pure $ 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 prg file mod cls stvr mthd attch vis param bod block stmt var scope val binder typ)
  => GenState (Maybe (MS (r mthd)))
genInputConstructor :: forall (r :: * -> *) prg file mod cls stvr mthd attch vis param bod
       block stmt var scope val binder typ.
OOProg
  r
  prg
  file
  mod
  cls
  stvr
  mthd
  attch
  vis
  param
  bod
  block
  stmt
  var
  scope
  val
  binder
  typ =>
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 (f :: * -> *) a. Applicative f => a -> f a
pure 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 (pcAuto <$> cparams)
          [block ics]
        pure $ Just ctor
  genCtor $ any (`elem` ds) [giName,
    dvName, icName]

-- | Generates a function for calculating derived inputs.
genInputDerived
  :: (OOProg r prg file mod cls stvr mthd attch vis param bod block stmt var scope val binder typ)
  => VisibilityTag -> GenState (Maybe (MS (r mthd)))
genInputDerived :: forall (r :: * -> *) prg file mod cls stvr mthd attch vis param bod
       block stmt var scope val binder typ.
OOProg
  r
  prg
  file
  mod
  cls
  stvr
  mthd
  attch
  vis
  param
  bod
  block
  stmt
  var
  scope
  val
  binder
  typ =>
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 :: * -> *) prg file mod cls stvr mthd attch vis param bod
       block stmt var scope val binder typ.
OOProg
  r
  prg
  file
  mod
  cls
  stvr
  mthd
  attch
  vis
  param
  bod
  block
  stmt
  var
  scope
  val
  binder
  typ =>
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 :: * -> *) prg file mod cls stvr mthd attch vis param bod
       block stmt var scope val binder typ.
OOProg
  r
  prg
  file
  mod
  cls
  stvr
  mthd
  attch
  vis
  param
  bod
  block
  stmt
  var
  scope
  val
  binder
  typ =>
String
-> String
-> [Input]
-> [Input]
-> [MS (r block)]
-> GenState (MS (r mthd))
privateInOutMethod
      genDerived
        :: (OOProg r prg file mod cls stvr mthd attch vis param bod block stmt var scope val binder typ)
        => 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 (f :: * -> *) a. Applicative f => a -> f a
pure 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 {k} (r :: k -> *) (block :: k) (stmt :: k) (bod :: k)
       (val :: k) (typ :: k) (var :: k) (binder :: k).
(BlockSym r block stmt, BodySym r bod block, ValueSym r val typ,
 Argument r val, MathConstant r val, TypeSym r typ, OOTypeSym r typ,
 VariableSym r var typ, OOVariableSym r var val typ,
 VariableValue r var val, Literal r val typ,
 BooleanExpression r val, Comparison r val, NumericExpression r val,
 SelfSym r var, InternalValueExp r var val typ,
 ValueExpression r var val binder typ,
 OOValueExpression r var val typ, List r val, Reference r val,
 Set r val, AssignStatement r stmt var val,
 ControlStatement r bod stmt var val, TypeElim r typ,
 VariableElim r var typ) =>
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
        pure $ Just mthd
  genDerived $ dvName `elem` defSet g

-- | Generates function that checks constraints on the input.
genInputConstraints
  :: (OOProg r prg file mod cls stvr mthd attch vis param bod block stmt var scope val binder typ)
  => VisibilityTag -> GenState (Maybe (MS (r mthd)))
genInputConstraints :: forall (r :: * -> *) prg file mod cls stvr mthd attch vis param bod
       block stmt var scope val binder typ.
OOProg
  r
  prg
  file
  mod
  cls
  stvr
  mthd
  attch
  vis
  param
  bod
  block
  stmt
  var
  scope
  val
  binder
  typ =>
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 typ)
-> String
-> [ParameterChunk]
-> Maybe String
-> [MS (r block)]
-> GenState (MS (r mthd))
forall (r :: * -> *) prg file mod cls stvr mthd attch vis param bod
       block stmt var scope val binder typ.
OOProg
  r
  prg
  file
  mod
  cls
  stvr
  mthd
  attch
  vis
  param
  bod
  block
  stmt
  var
  scope
  val
  binder
  typ =>
String
-> VS (r typ)
-> String
-> [ParameterChunk]
-> Maybe String
-> [MS (r block)]
-> GenState (MS (r mthd))
publicFunc
      getFunc VisibilityTag
Priv = String
-> VS (r typ)
-> String
-> [ParameterChunk]
-> Maybe String
-> [MS (r block)]
-> GenState (MS (r mthd))
forall (r :: * -> *) prg file mod cls stvr mthd attch vis param bod
       block stmt var scope val binder typ.
OOProg
  r
  prg
  file
  mod
  cls
  stvr
  mthd
  attch
  vis
  param
  bod
  block
  stmt
  var
  scope
  val
  binder
  typ =>
String
-> VS (r typ)
-> String
-> [ParameterChunk]
-> Maybe String
-> [MS (r block)]
-> GenState (MS (r mthd))
privateMethod
      genConstraints
        :: (OOProg r prg file mod cls stvr mthd attch vis param bod block stmt var scope val binder typ)
        => 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 (f :: * -> *) a. Applicative f => a -> f a
pure 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   = ConstraintCEMap -> Input -> (Input, [ConstraintCE])
forall q. HasUID q => ConstraintCEMap -> q -> (q, [ConstraintCE])
sfwrLookup ConstraintCEMap
cm (Input -> (Input, [ConstraintCE]))
-> [Input] -> [(Input, [ConstraintCE])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Input]
varsList
            physCs   = ConstraintCEMap -> Input -> (Input, [ConstraintCE])
forall q. HasUID q => ConstraintCEMap -> q -> (q, [ConstraintCE])
physLookup ConstraintCEMap
cm (Input -> (Input, [ConstraintCE]))
-> [Input] -> [(Input, [ConstraintCE])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Input]
varsList
        sf <- sfwrCBody sfwrCs
        ph <- physCBody physCs
        desc <- inConsFuncDesc
        mthd <- getFunc s icName void desc (pcAuto <$> parms)
          Nothing [block sf, block ph]
        pure $ 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
    , ValueSym r val typ
    , Argument r val
    , MathConstant r val
    , TypeSym r typ
    , OOTypeSym r typ
    , ScopeSym r scope
    , VariableSym r var typ
    , OOVariableSym r var val typ
    , VariableValue r var val
    , Literal r val typ
    , BooleanExpression r val
    , Comparison r val
    , NumericExpression r val
    , SelfSym r var
    , InternalValueExp r var val typ
    , ValueExpression r var val binder typ
    , OOValueExpression r var val typ
    , List r val
    , Reference r val
    , Set r val
    , EmptyStatement r stmt
    , DeclStatement r bod stmt var scope val
    , ControlStatement r bod stmt var val
    , PrintConsole r stmt val
    , TypeElim r typ
    , VariableElim r var typ
    )
  => [(CodeVarChunk, [ConstraintCE])] -> GenState [MS (r stmt)]
sfwrCBody :: forall {k} (r :: k -> *) (block :: k) (stmt :: k) (bod :: k)
       (val :: k) (typ :: k) (scope :: k) (var :: k) (binder :: k).
(BlockSym r block stmt, BodySym r bod block, ValueSym r val typ,
 Argument r val, MathConstant r val, TypeSym r typ, OOTypeSym r typ,
 ScopeSym r scope, VariableSym r var typ,
 OOVariableSym r var val typ, VariableValue r var val,
 Literal r val typ, BooleanExpression r val, Comparison r val,
 NumericExpression r val, SelfSym r var,
 InternalValueExp r var val typ,
 ValueExpression r var val binder typ,
 OOValueExpression r var val typ, List r val, Reference r val,
 Set r val, EmptyStatement r stmt,
 DeclStatement r bod stmt var scope val,
 ControlStatement r bod stmt var val, PrintConsole r stmt val,
 TypeElim r typ, VariableElim r var typ) =>
[(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
    , ValueSym r val typ
    , Argument r val
    , MathConstant r val
    , TypeSym r typ
    , OOTypeSym r typ
    , ScopeSym r scope
    , VariableSym r var typ
    , OOVariableSym r var val typ
    , VariableValue r var val
    , Literal r val typ
    , BooleanExpression r val
    , Comparison r val
    , NumericExpression r val
    , SelfSym r var
    , InternalValueExp r var val typ
    , ValueExpression r var val binder typ
    , OOValueExpression r var val typ
    , List r val
    , Reference r val
    , Set r val
    , EmptyStatement r stmt
    , DeclStatement r bod stmt var scope val
    , ControlStatement r bod stmt var val
    , PrintConsole r stmt val
    , TypeElim r typ
    , VariableElim r var typ
    )
  => [(CodeVarChunk, [ConstraintCE])] -> GenState [MS (r stmt)]
physCBody :: forall {k} (r :: k -> *) (block :: k) (stmt :: k) (bod :: k)
       (val :: k) (typ :: k) (scope :: k) (var :: k) (binder :: k).
(BlockSym r block stmt, BodySym r bod block, ValueSym r val typ,
 Argument r val, MathConstant r val, TypeSym r typ, OOTypeSym r typ,
 ScopeSym r scope, VariableSym r var typ,
 OOVariableSym r var val typ, VariableValue r var val,
 Literal r val typ, BooleanExpression r val, Comparison r val,
 NumericExpression r val, SelfSym r var,
 InternalValueExp r var val typ,
 ValueExpression r var val binder typ,
 OOValueExpression r var val typ, List r val, Reference r val,
 Set r val, EmptyStatement r stmt,
 DeclStatement r bod stmt var scope val,
 ControlStatement r bod stmt var val, PrintConsole r stmt val,
 TypeElim r typ, VariableElim r var typ) =>
[(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
    , ValueSym r val typ
    , Argument r val
    , MathConstant r val
    , TypeSym r typ
    , OOTypeSym r typ
    , ScopeSym r scope
    , VariableSym r var typ
    , OOVariableSym r var val typ
    , VariableValue r var val
    , Literal r val typ
    , BooleanExpression r val
    , Comparison r val
    , NumericExpression r val
    , ValueExpression r var val binder typ
    , SelfSym r var
    , InternalValueExp r var val typ
    , OOValueExpression r var val typ
    , List r val
    , Reference r val
    , Set r val
    , EmptyStatement r stmt
    , DeclStatement r bod stmt var scope val
    , ControlStatement r bod stmt var val
    , PrintConsole r stmt val
    , TypeElim r typ
    , VariableElim r var typ
    )
  => ConstraintBehaviour
  -> [(CodeVarChunk, [ConstraintCE])]
  -> GenState [MS (r stmt)]
chooseConstr :: forall {k} (r :: k -> *) (block :: k) (stmt :: k) (bod :: k)
       (val :: k) (typ :: k) (scope :: k) (var :: k) (binder :: k).
(BlockSym r block stmt, BodySym r bod block, ValueSym r val typ,
 Argument r val, MathConstant r val, TypeSym r typ, OOTypeSym r typ,
 ScopeSym r scope, VariableSym r var typ,
 OOVariableSym r var val typ, VariableValue r var val,
 Literal r val typ, BooleanExpression r val, Comparison r val,
 NumericExpression r val, ValueExpression r var val binder typ,
 SelfSym r var, InternalValueExp r var val typ,
 OOValueExpression r var val typ, List r val, Reference r val,
 Set r val, EmptyStatement r stmt,
 DeclStatement r bod stmt var scope val,
 ControlStatement r bod stmt var val, PrintConsole r stmt val,
 TypeElim r typ, VariableElim r var typ) =>
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 {k} (r :: k -> *) (val :: k) (typ :: k) (scope :: k)
       (var :: k) (binder :: k) (bod :: k) (stmt :: k).
(ValueSym r val typ, Argument r val, MathConstant r val,
 TypeSym r typ, OOTypeSym r typ, ScopeSym r scope,
 VariableSym r var typ, OOVariableSym r var val typ,
 VariableValue r var val, Literal r val typ,
 BooleanExpression r val, Comparison r val, NumericExpression r val,
 SelfSym r var, InternalValueExp r var val typ,
 ValueExpression r var val binder typ,
 OOValueExpression r var val typ, List r val, Reference r val,
 Set r val, DeclStatement r bod stmt var scope val, TypeElim r typ,
 VariableElim r var typ) =>
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 (f :: * -> *) a. Applicative f => a -> f a
pure 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 (VS (r val)))
-> [ConstraintCE] -> StateT DrasilState Identity [VS (r val)]
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 (VS (r val))
forall {k} (r :: k -> *) (val :: k) (typ :: k) (var :: k)
       (binder :: k).
(ValueSym r val typ, Argument r val, MathConstant r val,
 TypeSym r typ, OOTypeSym r typ, VariableSym r var typ,
 OOVariableSym r var val typ, VariableValue r var val,
 Literal r val typ, BooleanExpression r val, Comparison r val,
 NumericExpression r val, ValueExpression r var val binder typ,
 SelfSym r var, InternalValueExp r var val typ,
 OOValueExpression r var val typ, List r val, Reference r val,
 Set r val, TypeElim r typ, VariableElim r var typ) =>
CodeExpr -> GenState (VS (r val))
convExpr (CodeExpr -> StateT DrasilState Identity (VS (r val)))
-> (ConstraintCE -> CodeExpr)
-> ConstraintCE
-> StateT DrasilState Identity (VS (r val))
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
$ ([VS (r val)] -> [MS (r bod)] -> [MS (r stmt)])
-> [[VS (r val)]] -> [[MS (r bod)]] -> [[MS (r stmt)]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ((VS (r val) -> MS (r bod) -> MS (r stmt))
-> [VS (r val)] -> [MS (r bod)] -> [MS (r stmt)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\VS (r val)
cond MS (r bod)
bod -> [(VS (r val), MS (r bod))] -> MS (r stmt)
forall {k} (r :: k -> *) (bod :: k) (block :: k) (stmt :: k)
       (var :: k) (val :: k).
(BodySym r bod block, ControlStatement r bod stmt var val) =>
[(VS (r val), MS (r bod))] -> MS (r stmt)
ifNoElse [(VS (r val) -> VS (r val)
forall {k} (r :: k -> *) (val :: k).
BooleanExpression r val =>
VS (r val) -> VS (r val)
(?!) VS (r val)
cond, MS (r bod)
bod)])) [[VS (r val)]]
conds [[MS (r bod)]]
bods
  pure $ interleave varDecs bodies
  where chooseCB :: ConstraintBehaviour
-> (Input, [ConstraintCE]) -> GenState [MS (r bod)]
chooseCB ConstraintBehaviour
Warning = (Input, [ConstraintCE]) -> GenState [MS (r bod)]
forall {k} (r :: k -> *) (val :: k) (typ :: k) (var :: k)
       (binder :: k) (stmt :: k) (block :: k) (bod :: k).
(ValueSym r val typ, Argument r val, MathConstant r val,
 TypeSym r typ, OOTypeSym r typ, OOVariableSym r var val typ,
 VariableSym r var typ, VariableValue r var val, Literal r val typ,
 BooleanExpression r val, Comparison r val, NumericExpression r val,
 SelfSym r var, InternalValueExp r var val typ,
 ValueExpression r var val binder typ,
 OOValueExpression r var val typ, List r val, Reference r val,
 Set r val, PrintConsole r stmt val, BlockSym r block stmt,
 BodySym r bod block, TypeElim r typ, VariableElim r var typ) =>
(Input, [ConstraintCE]) -> GenState [MS (r bod)]
constrWarn
        chooseCB ConstraintBehaviour
Exception = (Input, [ConstraintCE]) -> GenState [MS (r bod)]
forall {k} (r :: k -> *) (block :: k) (stmt :: k) (bod :: k)
       (val :: k) (typ :: k) (var :: k) (binder :: k).
(BlockSym r block stmt, BodySym r bod block, ValueSym r val typ,
 Argument r val, MathConstant r val, TypeSym r typ, OOTypeSym r typ,
 VariableSym r var typ, OOVariableSym r var val typ,
 VariableValue r var val, Literal r val typ,
 BooleanExpression r val, Comparison r val, NumericExpression r val,
 SelfSym r var, InternalValueExp r var val typ,
 ValueExpression r var val binder typ,
 OOValueExpression r var val typ, List r val, Reference r val,
 Set r val, ControlStatement r bod stmt var val,
 PrintConsole r stmt val, TypeElim r typ, VariableElim r var typ) =>
(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
  ::
    ( ValueSym r val typ
    , Argument r val
    , MathConstant r val
    , TypeSym r typ
    , OOTypeSym r typ
    , OOVariableSym r var val typ
    , VariableSym r var typ
    , VariableValue r var val
    , Literal r val typ
    , BooleanExpression r val
    , Comparison r val
    , NumericExpression r val
    , SelfSym r var
    , InternalValueExp r var val typ
    , ValueExpression r var val binder typ
    , OOValueExpression r var val typ
    , List r val
    , Reference r val
    , Set r val
    , PrintConsole r stmt val
    , BlockSym r block stmt
    , BodySym r bod block
    , TypeElim r typ
    , VariableElim r var typ
    )
  => (CodeVarChunk, [ConstraintCE]) -> GenState [MS (r bod)]
constrWarn :: forall {k} (r :: k -> *) (val :: k) (typ :: k) (var :: k)
       (binder :: k) (stmt :: k) (block :: k) (bod :: k).
(ValueSym r val typ, Argument r val, MathConstant r val,
 TypeSym r typ, OOTypeSym r typ, OOVariableSym r var val typ,
 VariableSym r var typ, VariableValue r var val, Literal r val typ,
 BooleanExpression r val, Comparison r val, NumericExpression r val,
 SelfSym r var, InternalValueExp r var val typ,
 ValueExpression r var val binder typ,
 OOValueExpression r var val typ, List r val, Reference r val,
 Set r val, PrintConsole r stmt val, BlockSym r block stmt,
 BodySym r bod block, TypeElim r typ, VariableElim r var typ) =>
(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 {k} (r :: k -> *) (val :: k) (typ :: k) (var :: k)
       (binder :: k) (stmt :: k).
(ValueSym r val typ, Argument r val, MathConstant r val,
 TypeSym r typ, OOTypeSym r typ, VariableSym r var typ,
 OOVariableSym r var val typ, VariableValue r var val,
 Literal r val typ, BooleanExpression r val, Comparison r val,
 NumericExpression r val, SelfSym r var,
 InternalValueExp r var val typ,
 ValueExpression r var val binder typ,
 OOValueExpression r var val typ, List r val, Reference r val,
 Set r val, PrintConsole r stmt val, TypeElim r typ,
 VariableElim r var typ) =>
Input -> String -> ConstraintCE -> GenState [MS (r stmt)]
constraintViolatedMsg Input
q String
"suggested") [ConstraintCE]
cs
  pure $ 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
    , ValueSym r val typ
    , Argument r val
    , MathConstant r val
    , TypeSym r typ
    , OOTypeSym r typ
    , VariableSym r var typ
    , OOVariableSym r var val typ
    , VariableValue r var val
    , Literal r val typ
    , BooleanExpression r val
    , Comparison r val
    , NumericExpression r val
    , SelfSym r var
    , InternalValueExp r var val typ
    , ValueExpression r var val binder typ
    , OOValueExpression r var val typ
    , List r val
    , Reference r val
    , Set r val
    , ControlStatement r bod stmt var val
    , PrintConsole r stmt val
    , TypeElim r typ
    , VariableElim r var typ
    )
  => (CodeVarChunk, [ConstraintCE]) -> GenState [MS (r bod)]
constrExc :: forall {k} (r :: k -> *) (block :: k) (stmt :: k) (bod :: k)
       (val :: k) (typ :: k) (var :: k) (binder :: k).
(BlockSym r block stmt, BodySym r bod block, ValueSym r val typ,
 Argument r val, MathConstant r val, TypeSym r typ, OOTypeSym r typ,
 VariableSym r var typ, OOVariableSym r var val typ,
 VariableValue r var val, Literal r val typ,
 BooleanExpression r val, Comparison r val, NumericExpression r val,
 SelfSym r var, InternalValueExp r var val typ,
 ValueExpression r var val binder typ,
 OOValueExpression r var val typ, List r val, Reference r val,
 Set r val, ControlStatement r bod stmt var val,
 PrintConsole r stmt val, TypeElim r typ, VariableElim r var typ) =>
(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 {k} (r :: k -> *) (val :: k) (typ :: k) (var :: k)
       (binder :: k) (stmt :: k).
(ValueSym r val typ, Argument r val, MathConstant r val,
 TypeSym r typ, OOTypeSym r typ, VariableSym r var typ,
 OOVariableSym r var val typ, VariableValue r var val,
 Literal r val typ, BooleanExpression r val, Comparison r val,
 NumericExpression r val, SelfSym r var,
 InternalValueExp r var val typ,
 ValueExpression r var val binder typ,
 OOValueExpression r var val typ, List r val, Reference r val,
 Set r val, PrintConsole r stmt val, TypeElim r typ,
 VariableElim r var typ) =>
Input -> String -> ConstraintCE -> GenState [MS (r stmt)]
constraintViolatedMsg Input
q String
"expected") [ConstraintCE]
cs
  pure $ bodyStatements . (++ [throw "InputError"]) <$> msgs

-- | Generates set variable dec
constrVarDec
  ::
    ( ValueSym r val typ
    , Argument r val
    , MathConstant r val
    , TypeSym r typ
    , OOTypeSym r typ
    , ScopeSym r scope
    , VariableSym r var typ
    , OOVariableSym r var val typ
    , VariableValue r var val
    , Literal r val typ
    , BooleanExpression r val
    , Comparison r val
    , NumericExpression r val
    , SelfSym r var
    , InternalValueExp r var val typ
    , ValueExpression r var val binder typ
    , OOValueExpression r var val typ
    , List r val
    , Reference r val
    , Set r val
    , DeclStatement r bod stmt var scope val
    , TypeElim r typ
    , VariableElim r var typ
    )
  => CodeVarChunk -> CodeExpr -> GenState (MS (r stmt))
constrVarDec :: forall {k} (r :: k -> *) (val :: k) (typ :: k) (scope :: k)
       (var :: k) (binder :: k) (bod :: k) (stmt :: k).
(ValueSym r val typ, Argument r val, MathConstant r val,
 TypeSym r typ, OOTypeSym r typ, ScopeSym r scope,
 VariableSym r var typ, OOVariableSym r var val typ,
 VariableValue r var val, Literal r val typ,
 BooleanExpression r val, Comparison r val, NumericExpression r val,
 SelfSym r var, InternalValueExp r var val typ,
 ValueExpression r var val binder typ,
 OOValueExpression r var val typ, List r val, Reference r val,
 Set r val, DeclStatement r bod stmt var scope val, TypeElim r typ,
 VariableElim r var typ) =>
Input -> CodeExpr -> GenState (MS (r stmt))
constrVarDec Input
v CodeExpr
e = do
  lb <- CodeExpr -> GenState (VS (r val))
forall {k} (r :: k -> *) (val :: k) (typ :: k) (var :: k)
       (binder :: k).
(ValueSym r val typ, Argument r val, MathConstant r val,
 TypeSym r typ, OOTypeSym r typ, VariableSym r var typ,
 OOVariableSym r var val typ, VariableValue r var val,
 Literal r val typ, BooleanExpression r val, Comparison r val,
 NumericExpression r val, ValueExpression r var val binder typ,
 SelfSym r var, InternalValueExp r var val typ,
 OOValueExpression r var val typ, List r val, Reference r val,
 Set r val, TypeElim r typ, VariableElim r var typ) =>
CodeExpr -> GenState (VS (r val))
convExpr CodeExpr
e
  t <- codeType v
  let mkValue = String -> VS (r typ) -> VS (r var)
forall {k} (r :: k -> *) (var :: k) (typ :: k).
VariableSym r var typ =>
String -> VS (r typ) -> VS (r var)
var (String
"set_" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Input -> String
forall x. HasSymbol x => x -> String
oneLineCodeSymbolDoc Input
v) (VS (r typ) -> VS (r typ)
forall {k} (r :: k -> *) (typ :: k).
TypeSym r typ =>
VS (r typ) -> VS (r typ)
setType (CodeType -> VS (r typ)
forall {k} (r :: k -> *) (typ :: k).
TypeSym r typ =>
CodeType -> VS (r typ)
convType CodeType
t))
  pure (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
  ::
    ( ValueSym r val typ
    , Argument r val
    , MathConstant r val
    , TypeSym r typ
    , OOTypeSym r typ
    , VariableSym r var typ
    , OOVariableSym r var val typ
    , VariableValue r var val
    , Literal r val typ
    , BooleanExpression r val
    , Comparison r val
    , NumericExpression r val
    , SelfSym r var
    , InternalValueExp r var val typ
    , ValueExpression r var val binder typ
    , OOValueExpression r var val typ
    , List r val
    , Reference r val
    , Set r val
    , PrintConsole r stmt val
    , TypeElim r typ
    , VariableElim r var typ
    )
  => CodeVarChunk -> String -> ConstraintCE -> GenState [MS (r stmt)]
constraintViolatedMsg :: forall {k} (r :: k -> *) (val :: k) (typ :: k) (var :: k)
       (binder :: k) (stmt :: k).
(ValueSym r val typ, Argument r val, MathConstant r val,
 TypeSym r typ, OOTypeSym r typ, VariableSym r var typ,
 OOVariableSym r var val typ, VariableValue r var val,
 Literal r val typ, BooleanExpression r val, Comparison r val,
 NumericExpression r val, SelfSym r var,
 InternalValueExp r var val typ,
 ValueExpression r var val binder typ,
 OOValueExpression r var val typ, List r val, Reference r val,
 Set r val, PrintConsole r stmt val, TypeElim r typ,
 VariableElim r var typ) =>
Input -> String -> ConstraintCE -> GenState [MS (r stmt)]
constraintViolatedMsg Input
q String
s ConstraintCE
c = do
  pc <- String -> ConstraintCE -> GenState [MS (r stmt)]
forall {k} (r :: k -> *) (val :: k) (typ :: k) (var :: k)
       (binder :: k) (stmt :: k).
(ValueSym r val typ, Argument r val, MathConstant r val,
 TypeSym r typ, OOTypeSym r typ, VariableSym r var typ,
 OOVariableSym r var val typ, VariableValue r var val,
 Literal r val typ, BooleanExpression r val, Comparison r val,
 NumericExpression r val, SelfSym r var,
 InternalValueExp r var val typ,
 ValueExpression r var val binder typ,
 OOValueExpression r var val typ, List r val, Reference r val,
 Set r val, PrintConsole r stmt val, TypeElim r typ,
 VariableElim r var typ) =>
String -> ConstraintCE -> GenState [MS (r stmt)]
printConstraint (Input -> String
forall x. HasSymbol x => x -> String
oneLineCodeSymbolDoc Input
q) ConstraintCE
c
  v <- mkVal (quantvar q)
  pure $ [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
  ::
    ( ValueSym r val typ
    , Argument r val
    , MathConstant r val
    , TypeSym r typ
    , OOTypeSym r typ
    , VariableSym r var typ
    , OOVariableSym r var val typ
    , VariableValue r var val
    , Literal r val typ
    , BooleanExpression r val
    , Comparison r val
    , NumericExpression r val
    , SelfSym r var
    , InternalValueExp r var val typ
    , ValueExpression r var val binder typ
    , OOValueExpression r var val typ
    , List r val
    , Reference r val
    , Set r val
    , PrintConsole r stmt val
    , TypeElim r typ
    , VariableElim r var typ
    )
  => String -> ConstraintCE -> GenState [MS (r stmt)]
printConstraint :: forall {k} (r :: k -> *) (val :: k) (typ :: k) (var :: k)
       (binder :: k) (stmt :: k).
(ValueSym r val typ, Argument r val, MathConstant r val,
 TypeSym r typ, OOTypeSym r typ, VariableSym r var typ,
 OOVariableSym r var val typ, VariableValue r var val,
 Literal r val typ, BooleanExpression r val, Comparison r val,
 NumericExpression r val, SelfSym r var,
 InternalValueExp r var val typ,
 ValueExpression r var val binder typ,
 OOValueExpression r var val typ, List r val, Reference r val,
 Set r val, PrintConsole r stmt val, TypeElim r typ,
 VariableElim r var typ) =>
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'
        ::
          ( ValueSym r val typ
          , Argument r val
          , MathConstant r val
          , TypeSym r typ
          , OOTypeSym r typ
          , VariableSym r var typ
          , OOVariableSym r var val typ
          , VariableValue r var val
          , Literal r val typ
          , BooleanExpression r val
          , Comparison r val
          , NumericExpression r val
          , SelfSym r var
          , InternalValueExp r var val typ
          , ValueExpression r var val binder typ
          , OOValueExpression r var val typ
          , List r val
          , Reference r val
          , Set r val
          , PrintConsole r stmt val
          , TypeElim r typ
          , VariableElim r var typ
          )
        => String -> ConstraintCE -> GenState [MS (r stmt)]
      printConstraint' String
_ (Range ConstraintReason
_ (Bounded (Inclusive
_, CodeExpr
e1) (Inclusive
_, CodeExpr
e2))) = do
        lb <- CodeExpr -> GenState (VS (r val))
forall {k} (r :: k -> *) (val :: k) (typ :: k) (var :: k)
       (binder :: k).
(ValueSym r val typ, Argument r val, MathConstant r val,
 TypeSym r typ, OOTypeSym r typ, VariableSym r var typ,
 OOVariableSym r var val typ, VariableValue r var val,
 Literal r val typ, BooleanExpression r val, Comparison r val,
 NumericExpression r val, ValueExpression r var val binder typ,
 SelfSym r var, InternalValueExp r var val typ,
 OOValueExpression r var val typ, List r val, Reference r val,
 Set r val, TypeElim r typ, VariableElim r var typ) =>
CodeExpr -> GenState (VS (r val))
convExpr CodeExpr
e1
        ub <- convExpr e2
        pure $ [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 (VS (r val))
forall {k} (r :: k -> *) (val :: k) (typ :: k) (var :: k)
       (binder :: k).
(ValueSym r val typ, Argument r val, MathConstant r val,
 TypeSym r typ, OOTypeSym r typ, VariableSym r var typ,
 OOVariableSym r var val typ, VariableValue r var val,
 Literal r val typ, BooleanExpression r val, Comparison r val,
 NumericExpression r val, ValueExpression r var val binder typ,
 SelfSym r var, InternalValueExp r var val typ,
 OOValueExpression r var val typ, List r val, Reference r val,
 Set r val, TypeElim r typ, VariableElim r var typ) =>
CodeExpr -> GenState (VS (r val))
convExpr CodeExpr
e
        pure $ [printStr "below ", print ub] <> printExpr e db <>
          [printStrLn "."]
      printConstraint' String
_ (Range ConstraintReason
_ (UpFrom (Inclusive
_, CodeExpr
e))) = do
        lb <- CodeExpr -> GenState (VS (r val))
forall {k} (r :: k -> *) (val :: k) (typ :: k) (var :: k)
       (binder :: k).
(ValueSym r val typ, Argument r val, MathConstant r val,
 TypeSym r typ, OOTypeSym r typ, VariableSym r var typ,
 OOVariableSym r var val typ, VariableValue r var val,
 Literal r val typ, BooleanExpression r val, Comparison r val,
 NumericExpression r val, ValueExpression r var val binder typ,
 SelfSym r var, InternalValueExp r var val typ,
 OOValueExpression r var val typ, List r val, Reference r val,
 Set r val, TypeElim r typ, VariableElim r var typ) =>
CodeExpr -> GenState (VS (r val))
convExpr CodeExpr
e
        pure $ [printStr "above ", print lb] <> printExpr e db <> [printStrLn "."]
      printConstraint' String
name (Elem ConstraintReason
_ CodeExpr
e) = do
        lb <- CodeExpr -> GenState (VS (r val))
forall {k} (r :: k -> *) (val :: k) (typ :: k) (var :: k)
       (binder :: k).
(ValueSym r val typ, Argument r val, MathConstant r val,
 TypeSym r typ, OOTypeSym r typ, VariableSym r var typ,
 OOVariableSym r var val typ, VariableValue r var val,
 Literal r val typ, BooleanExpression r val, Comparison r val,
 NumericExpression r val, ValueExpression r var val binder typ,
 SelfSym r var, InternalValueExp r var val typ,
 OOValueExpression r var val typ, List r val, Reference r val,
 Set r val, TypeElim r typ, VariableElim r var typ) =>
CodeExpr -> GenState (VS (r val))
convExpr (String -> CodeExpr -> CodeExpr
Variable (String
"set_" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
name) CodeExpr
e)
        pure $ [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 val)
  => CodeExpr -> PrintingInformation -> [MS (r stmt)]
printExpr :: forall {k} (r :: k -> *) (stmt :: k) (val :: k).
PrintConsole r stmt val =>
CodeExpr -> PrintingInformation -> [MS (r stmt)]
printExpr Lit{} PrintingInformation
_     = []
printExpr CodeExpr
e     PrintingInformation
pinfo = [String -> MS (r stmt)
forall {k} (r :: k -> *) (stmt :: k) (val :: k).
PrintConsole r stmt val =>
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. Semigroup a => a -> a -> a
<> Doc -> String
render (Doc -> Doc
parens (PrintingInformation -> CodeExpr -> Doc
oneLineCodeExprDoc PrintingInformation
pinfo CodeExpr
e))]

-- | | Generates a function for reading inputs from a file.
genInputFormat
  :: (OOProg r prg file mod cls stvr mthd attch vis param bod block stmt var scope val binder typ)
  => VisibilityTag -> GenState (Maybe (MS (r mthd)))
genInputFormat :: forall (r :: * -> *) prg file mod cls stvr mthd attch vis param bod
       block stmt var scope val binder typ.
OOProg
  r
  prg
  file
  mod
  cls
  stvr
  mthd
  attch
  vis
  param
  bod
  block
  stmt
  var
  scope
  val
  binder
  typ =>
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 :: * -> *) prg file mod cls stvr mthd attch vis param bod
       block stmt var scope val binder typ.
OOProg
  r
  prg
  file
  mod
  cls
  stvr
  mthd
  attch
  vis
  param
  bod
  block
  stmt
  var
  scope
  val
  binder
  typ =>
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 :: * -> *) prg file mod cls stvr mthd attch vis param bod
       block stmt var scope val binder typ.
OOProg
  r
  prg
  file
  mod
  cls
  stvr
  mthd
  attch
  vis
  param
  bod
  block
  stmt
  var
  scope
  val
  binder
  typ =>
String
-> String
-> [Input]
-> [Input]
-> [MS (r block)]
-> GenState (MS (r mthd))
privateInOutMethod
      genInFormat
        :: (OOProg r prg file mod cls stvr mthd attch vis param bod block stmt var scope val binder typ)
        => 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 (f :: * -> *) a. Applicative f => a -> f a
pure 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
        pure $ 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
  pure $ junkLine :
    intersperse junkLine (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 pure . Just $ sampleInput
    (printfo g) dd (getSampleData g) else pure Nothing

----- CONSTANTS -----

-- | Generates a module containing the class where constants are stored.
genConstMod
  :: (OOProg r prg file mod cls stvr mthd attch vis param bod block stmt var scope val binder typ)
  => GenState [FS (r file)]
genConstMod :: forall (r :: * -> *) prg file mod cls stvr mthd attch vis param bod
       block stmt var scope val binder typ.
OOProg
  r
  prg
  file
  mod
  cls
  stvr
  mthd
  attch
  vis
  param
  bod
  block
  stmt
  var
  scope
  val
  binder
  typ =>
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 prg file mod cls stvr mthd attch vis param bod block stmt var scope val binder typ)
  => ClassType -> GenState (Maybe (CS (r cls)))
genConstClass :: forall (r :: * -> *) prg file mod cls stvr mthd attch vis param bod
       block stmt var scope val binder typ.
OOProg
  r
  prg
  file
  mod
  cls
  stvr
  mthd
  attch
  vis
  param
  bod
  block
  stmt
  var
  scope
  val
  binder
  typ =>
ClassType -> GenState (Maybe (CS (r cls)))
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 prg file mod cls stvr mthd attch vis param bod block stmt var scope val binder typ)
        => [CodeDefinition] -> GenState (Maybe (CS (r cls)))
      genClass [] = Maybe (CS (r cls))
-> StateT DrasilState Identity (Maybe (CS (r cls)))
forall a. a -> StateT DrasilState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (CS (r cls))
forall a. Maybe a
Nothing
      genClass [Const]
vs = do
        vals <- (Const -> StateT DrasilState Identity (VS (r val)))
-> [Const] -> StateT DrasilState Identity [VS (r val)]
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 (VS (r val))
forall {k} (r :: k -> *) (val :: k) (typ :: k) (var :: k)
       (binder :: k).
(ValueSym r val typ, Argument r val, MathConstant r val,
 TypeSym r typ, OOTypeSym r typ, VariableSym r var typ,
 OOVariableSym r var val typ, VariableValue r var val,
 Literal r val typ, BooleanExpression r val, Comparison r val,
 NumericExpression r val, ValueExpression r var val binder typ,
 SelfSym r var, InternalValueExp r var val typ,
 OOValueExpression r var val typ, List r val, Reference r val,
 Set r val, TypeElim r typ, VariableElim r var typ) =>
CodeExpr -> GenState (VS (r val))
convExpr (CodeExpr -> StateT DrasilState Identity (VS (r val)))
-> (Const -> CodeExpr)
-> Const
-> StateT DrasilState Identity (VS (r val))
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 -> String -> VS (r typ) -> VS (r var)
forall {k} (r :: k -> *) (var :: k) (typ :: k).
VariableSym r var typ =>
String -> VS (r typ) -> VS (r var)
var (Const -> String
forall c. CodeIdea c => c -> String
codeName Const
x) (VS (r typ) -> VS (r var))
-> (CodeType -> VS (r typ)) -> CodeType -> VS (r var)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CodeType -> VS (r typ)
forall {k} (r :: k -> *) (typ :: k).
(TypeSym r typ, OOTypeSym r typ) =>
CodeType -> VS (r typ)
convTypeOO
          (CodeType -> VS (r var))
-> StateT DrasilState Identity CodeType
-> StateT DrasilState Identity (VS (r var))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Const -> StateT DrasilState Identity CodeType
forall c. HasSpace c => c -> StateT DrasilState Identity CodeType
codeType Const
x) vs
        let constVars = (VS (r var) -> VS (r val) -> CSStateVar r stvr)
-> [VS (r var)] -> [VS (r val)] -> [CSStateVar r stvr]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (ConstantRepr -> VS (r var) -> VS (r val) -> CSStateVar r stvr
forall {k} (r :: k -> *) (attch :: k) (vis :: k) (stvr :: k)
       (var :: k) (val :: k).
(AttachmentSym r attch, VisibilitySym r vis,
 StateVarSym r stvr attch vis var val) =>
ConstantRepr -> VS (r var) -> VS (r val) -> 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)) [VS (r var)]
vars [VS (r val)]
vals
            getFunc ClassType
Primary = String
-> Maybe String
-> String
-> [CSStateVar r stvr]
-> GenState [MS (r mthd)]
-> GenState [MS (r mthd)]
-> GenState (CS (r cls))
forall {k} (r :: k -> *) (cls :: k) (stvr :: k) (mthd :: k).
ClassSym r cls stvr mthd =>
String
-> Maybe String
-> String
-> [CSStateVar r stvr]
-> GenState [MS (r mthd)]
-> GenState [MS (r mthd)]
-> GenState (CS (r cls))
primaryClass
            getFunc ClassType
Auxiliary = String
-> Maybe String
-> String
-> [CSStateVar r stvr]
-> GenState [MS (r mthd)]
-> GenState [MS (r mthd)]
-> GenState (CS (r cls))
forall {k} (r :: k -> *) (cls :: k) (stvr :: k) (mthd :: k).
ClassSym r cls stvr mthd =>
String
-> Maybe String
-> String
-> [CSStateVar r stvr]
-> GenState [MS (r mthd)]
-> GenState [MS (r mthd)]
-> GenState (CS (r cls))
auxClass
            f = ClassType
-> String
-> Maybe String
-> String
-> [CSStateVar r stvr]
-> GenState [MS (r mthd)]
-> GenState [MS (r mthd)]
-> GenState (CS (r cls))
forall {k} {r :: k -> *} {cls :: k} {stvr :: k} {mthd :: k}.
ClassSym r cls stvr mthd =>
ClassType
-> String
-> Maybe String
-> String
-> [CSStateVar r stvr]
-> GenState [MS (r mthd)]
-> GenState [MS (r mthd)]
-> GenState (CS (r cls))
getFunc ClassType
scp
        cDesc <- constClassDesc
        cls <- f cname Nothing cDesc constVars (pure []) (pure [])
        pure $ Just cls
  genClass $ filter (flip member (Map.filter (cname ==) (clsMap g))
    . codeName) cs

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

-- | Generates a module containing calculation functions.
genCalcMod
  :: (OOProg r prg file mod cls stvr mthd attch vis param bod block stmt var scope val binder typ)
  => GenState (FS (r file))
genCalcMod :: forall (r :: * -> *) prg file mod cls stvr mthd attch vis param bod
       block stmt var scope val binder typ.
OOProg
  r
  prg
  file
  mod
  cls
  stvr
  mthd
  attch
  vis
  param
  bod
  block
  stmt
  var
  scope
  val
  binder
  typ =>
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) (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 prg file mod cls stvr mthd attch vis param bod block stmt var scope val binder typ)
  => CodeDefinition -> GenState (MS (r mthd))
genCalcFunc :: forall (r :: * -> *) prg file mod cls stvr mthd attch vis param bod
       block stmt var scope val binder typ.
OOProg
  r
  prg
  file
  mod
  cls
  stvr
  mthd
  attch
  vis
  param
  bod
  block
  stmt
  var
  scope
  val
  binder
  typ =>
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 {k} (r :: k -> *) (block :: k) (stmt :: k) (bod :: k)
       (val :: k) (typ :: k) (var :: k) (binder :: k).
(BlockSym r block stmt, BodySym r bod block, ValueSym r val typ,
 Argument r val, MathConstant r val, TypeSym r typ, OOTypeSym r typ,
 VariableSym r var typ, OOVariableSym r var val typ,
 VariableValue r var val, Literal r val typ,
 BooleanExpression r val, Comparison r val, NumericExpression r val,
 SelfSym r var, InternalValueExp r var val typ,
 ValueExpression r var val binder typ,
 OOValueExpression r var val typ, List r val, Reference r val,
 Set r val, AssignStatement r stmt var val,
 ControlStatement r bod stmt var val, TypeElim r typ,
 VariableElim r var typ) =>
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. Semigroup 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 {k} (r :: k -> *) (block :: k) (stmt :: k) (bod :: k)
       (val :: k) (typ :: k) (var :: k) (binder :: k) (scope :: k).
(BlockSym r block stmt, BodySym r bod block, ValueSym r val typ,
 Argument r val, MathConstant r val, TypeSym r typ, OOTypeSym r typ,
 VariableSym r var typ, OOVariableSym r var val typ,
 VariableValue r var val, Literal r val typ,
 BooleanExpression r val, Comparison r val, NumericExpression r val,
 ValueExpression r var val binder typ, SelfSym r var,
 InternalValueExp r var val typ, OOValueExpression r var val typ,
 Array r var val, List r val, ListStatement r stmt val,
 Reference r val, Set r val, ScopeSym r scope,
 MultiStatement r stmt, ValueStatement r stmt val,
 AssignStatement r stmt var val,
 ControlStatement r bod stmt var val,
 DeclStatement r bod stmt var scope val, TypeElim r typ,
 VariableElim r var typ) =>
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)
                   pure [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 <- renderTermAndUnit cdef
  desc <- renderTermAndUnit cdef
  publicFunc
    nm
    (convTypeOO tp)
    ("Calculates " <> calcDesc)
    (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
    , ValueSym r val typ
    , Argument r val
    , MathConstant r val
    , TypeSym r typ
    , OOTypeSym r typ
    , VariableSym r var typ
    , OOVariableSym r var val typ
    , VariableValue r var val
    , Literal r val typ
    , BooleanExpression r val
    , Comparison r val
    , NumericExpression r val
    , SelfSym r var
    , InternalValueExp r var val typ
    , ValueExpression r var val binder typ
    , OOValueExpression r var val typ
    , List r val
    , Reference r val
    , Set r val
    , AssignStatement r stmt var val
    , ControlStatement r bod stmt var val
    , TypeElim r typ
    , VariableElim r var typ
    )
   => CalcType -> CodeDefinition -> CodeExpr -> GenState (MS (r block))
genCalcBlock :: forall {k} (r :: k -> *) (block :: k) (stmt :: k) (bod :: k)
       (val :: k) (typ :: k) (var :: k) (binder :: k).
(BlockSym r block stmt, BodySym r bod block, ValueSym r val typ,
 Argument r val, MathConstant r val, TypeSym r typ, OOTypeSym r typ,
 VariableSym r var typ, OOVariableSym r var val typ,
 VariableValue r var val, Literal r val typ,
 BooleanExpression r val, Comparison r val, NumericExpression r val,
 SelfSym r var, InternalValueExp r var val typ,
 ValueExpression r var val binder typ,
 OOValueExpression r var val typ, List r val, Reference r val,
 Set r val, AssignStatement r stmt var val,
 ControlStatement r bod stmt var val, TypeElim r typ,
 VariableElim r var typ) =>
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 {k} (r :: k -> *) (block :: k) (stmt :: k) (bod :: k)
       (val :: k) (typ :: k) (var :: k) (binder :: k).
(BlockSym r block stmt, BodySym r bod block, ValueSym r val typ,
 Argument r val, MathConstant r val, TypeSym r typ, OOTypeSym r typ,
 VariableSym r var typ, OOVariableSym r var val typ,
 VariableValue r var val, Literal r val typ,
 BooleanExpression r val, Comparison r val, NumericExpression r val,
 SelfSym r var, InternalValueExp r var val typ,
 ValueExpression r var val binder typ,
 OOValueExpression r var val typ, List r val, Reference r val,
 Set r val, AssignStatement r stmt var val,
 ControlStatement r bod stmt var val, TypeElim r typ,
 VariableElim r var typ) =>
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 (VS (r var))
forall {k} (r :: k -> *) (typ :: k) (var :: k) (val :: k).
(TypeSym r typ, OOTypeSym r typ, VariableSym r var typ,
 OOVariableSym r var val typ, SelfSym r var, VariableElim r var typ,
 VariableValue r var val) =>
Input -> GenState (VS (r var))
mkVar (Const -> Input
forall c. (Quantity c, MayHaveUnit c, Concept c) => c -> Input
quantvar Const
v)
  ee <- convExpr e
  pure $ 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 (VS (r val) -> MS (r stmt)
forall {k} (r :: k -> *) (bod :: k) (stmt :: k) (var :: k)
       (val :: k).
ControlStatement r bod stmt var val =>
VS (r val) -> MS (r stmt)
returnStmt (VS (r val) -> MS (r stmt))
-> GenState (VS (r val)) -> State DrasilState (MS (r stmt))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CodeExpr -> GenState (VS (r val))
forall {k} (r :: k -> *) (val :: k) (typ :: k) (var :: k)
       (binder :: k).
(ValueSym r val typ, Argument r val, MathConstant r val,
 TypeSym r typ, OOTypeSym r typ, VariableSym r var typ,
 OOVariableSym r var val typ, VariableValue r var val,
 Literal r val typ, BooleanExpression r val, Comparison r val,
 NumericExpression r val, ValueExpression r var val binder typ,
 SelfSym r var, InternalValueExp r var val typ,
 OOValueExpression r var val typ, List r val, Reference r val,
 Set r val, TypeElim r typ, VariableElim r var typ) =>
CodeExpr -> GenState (VS (r val))
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
    , ValueSym r val typ
    , Argument r val
    , MathConstant r val
    , TypeSym r typ
    , OOTypeSym r typ
    , VariableSym r var typ
    , OOVariableSym r var val typ
    , VariableValue r var val
    , Literal r val typ
    , BooleanExpression r val
    , Comparison r val
    , NumericExpression r val
    , SelfSym r var
    , InternalValueExp r var val typ
    , ValueExpression r var val binder typ
    , OOValueExpression r var val typ
    , List r val
    , Reference r val
    , Set r val
    , AssignStatement r stmt var val
    , ControlStatement r bod stmt var val
    , TypeElim r typ
    , VariableElim r var typ
    )
  => CalcType
  -> CodeDefinition
  -> Completeness
  -> [(CodeExpr, CodeExpr)]
  -> GenState (MS (r block))
genCaseBlock :: forall {k} (r :: k -> *) (block :: k) (stmt :: k) (bod :: k)
       (val :: k) (typ :: k) (var :: k) (binder :: k).
(BlockSym r block stmt, BodySym r bod block, ValueSym r val typ,
 Argument r val, MathConstant r val, TypeSym r typ, OOTypeSym r typ,
 VariableSym r var typ, OOVariableSym r var val typ,
 VariableValue r var val, Literal r val typ,
 BooleanExpression r val, Comparison r val, NumericExpression r val,
 SelfSym r var, InternalValueExp r var val typ,
 ValueExpression r var val binder typ,
 OOValueExpression r var val typ, List r val, Reference r val,
 Set r val, AssignStatement r stmt var val,
 ControlStatement r bod stmt var val, TypeElim r typ,
 VariableElim r var typ) =>
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. Semigroup 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 (VS (r val), MS (r bod)))
-> [(CodeExpr, CodeExpr)]
-> StateT DrasilState Identity [(VS (r val), 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) -> (VS (r val) -> MS (r bod) -> (VS (r val), MS (r bod)))
-> StateT DrasilState Identity (VS (r val))
-> StateT DrasilState Identity (MS (r bod))
-> StateT DrasilState Identity (VS (r val), MS (r bod))
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) (CodeExpr -> StateT DrasilState Identity (VS (r val))
forall {k} (r :: k -> *) (val :: k) (typ :: k) (var :: k)
       (binder :: k).
(ValueSym r val typ, Argument r val, MathConstant r val,
 TypeSym r typ, OOTypeSym r typ, VariableSym r var typ,
 OOVariableSym r var val typ, VariableValue r var val,
 Literal r val typ, BooleanExpression r val, Comparison r val,
 NumericExpression r val, ValueExpression r var val binder typ,
 SelfSym r var, InternalValueExp r var val typ,
 OOValueExpression r var val typ, List r val, Reference r val,
 Set r val, TypeElim r typ, VariableElim r var typ) =>
CodeExpr -> GenState (VS (r val))
convExpr CodeExpr
r) (CodeExpr -> StateT DrasilState Identity (MS (r bod))
calcBody CodeExpr
e)) (Completeness -> [(CodeExpr, CodeExpr)]
ifEs Completeness
c)
  els <- elseE c
  pure $ 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 {k} (r :: k -> *) (block :: k) (stmt :: k) (bod :: k)
       (val :: k) (typ :: k) (var :: k) (binder :: k).
(BlockSym r block stmt, BodySym r bod block, ValueSym r val typ,
 Argument r val, MathConstant r val, TypeSym r typ, OOTypeSym r typ,
 VariableSym r var typ, OOVariableSym r var val typ,
 VariableValue r var val, Literal r val typ,
 BooleanExpression r val, Comparison r val, NumericExpression r val,
 SelfSym r var, InternalValueExp r var val typ,
 ValueExpression r var val binder typ,
 OOValueExpression r var val typ, List r val, Reference r val,
 Set r val, AssignStatement r stmt var val,
 ControlStatement r bod stmt var val, TypeElim r typ,
 VariableElim r var typ) =>
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 (f :: * -> *) a. Applicative f => a -> f a
pure (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 {k} (r :: k -> *) (bod :: k) (stmt :: k) (var :: k)
       (val :: k).
ControlStatement r bod stmt var val =>
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. Semigroup 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 prg file mod cls stvr mthd attch vis param bod block stmt var scope val binder typ)
  => GenState [FS (r file)]
genOutputMod :: forall (r :: * -> *) prg file mod cls stvr mthd attch vis param bod
       block stmt var scope val binder typ.
OOProg
  r
  prg
  file
  mod
  cls
  stvr
  mthd
  attch
  vis
  param
  bod
  block
  stmt
  var
  scope
  val
  binder
  typ =>
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 prg file mod cls stvr mthd attch vis param bod block stmt var scope val binder typ)
  => GenState (Maybe (MS (r mthd)))
genOutputFormat :: forall (r :: * -> *) prg file mod cls stvr mthd attch vis param bod
       block stmt var scope val binder typ.
OOProg
  r
  prg
  file
  mod
  cls
  stvr
  mthd
  attch
  vis
  param
  bod
  block
  stmt
  var
  scope
  val
  binder
  typ =>
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 prg file mod cls stvr mthd attch vis param bod block stmt var scope val binder typ)
        => 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 (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (MS (r mthd))
forall a. Maybe a
Nothing
      genOutput (Just String
_) = do
        let l_outfile :: String
l_outfile = String
"outputfile"
            var_outfile :: VS (r var)
var_outfile = String -> VS (r typ) -> VS (r var)
forall {k} (r :: k -> *) (var :: k) (typ :: k).
VariableSym r var typ =>
String -> VS (r typ) -> VS (r var)
var String
l_outfile VS (r typ)
forall {k} (r :: k -> *) (typ :: k). TypeSym r typ => VS (r typ)
outfile
            v_outfile :: VS (r val)
v_outfile = VS (r var) -> VS (r val)
forall {k} (r :: k -> *) (var :: k) (val :: k).
VariableValue r var val =>
VS (r var) -> VS (r val)
valueOf VS (r var)
var_outfile
        parms <- GenState [Input]
getOutputParams
        let outs = DrasilState -> Input -> Input
resolveOutputDefType DrasilState
g (Input -> Input) -> [Input] -> [Input]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (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 (VS (r val))
forall {k} (r :: k -> *) (val :: k) (typ :: k) (var :: k)
       (binder :: k).
(ValueSym r val typ, Argument r val, Literal r val typ,
 MathConstant r val, TypeSym r typ, OOTypeSym r typ,
 VariableSym r var typ, OOVariableSym r var val typ,
 VariableValue r var val, BooleanExpression r val, Comparison r val,
 NumericExpression r val, ValueExpression r var val binder typ,
 SelfSym r var, InternalValueExp r var val typ,
 OOValueExpression r var val typ, List r val, Reference r val,
 Set r val, TypeElim r typ, VariableElim r var typ) =>
Input -> GenState (VS (r val))
mkVal Input
x
          pure $
            printFileStr v_outfile (codeName x <> " = ")
            : writeOutputValue v_outfile v (x ^. typ) ) outs
        desc <- woFuncDesc
        mthd <- publicFunc woName void desc (pcAuto <$> parms) Nothing
          [block $ [
          varDec var_outfile local,
          openFileW var_outfile (litString "output.txt") ] <>
          concat outp <> [ closeFile v_outfile ]]
        pure $ Just mthd
  genOutput $ Map.lookup woName (eMap g)

-- Procedural Versions --

-- | Generates a controller module.
genMainProc
  ::
    ( NativeVector r val typ
    , ProcProg r prg file mod mthd vis param bod block stmt var scope val binder typ
    )
  => GenState (FS (r file))
genMainProc :: forall (r :: * -> *) val typ prg file mod mthd vis param bod block
       stmt var scope binder.
(NativeVector r val typ,
 ProcProg
   r
   prg
   file
   mod
   mthd
   vis
   param
   bod
   block
   stmt
   var
   scope
   val
   binder
   typ) =>
GenState (FS (r file))
genMainProc = String
-> String
-> [GenState (Maybe (MS (r mthd)))]
-> GenState (FS (r file))
forall (r :: * -> *) prg file mod mthd vis param bod block stmt var
       scope val binder typ.
ProcProg
  r
  prg
  file
  mod
  mthd
  vis
  param
  bod
  block
  stmt
  var
  scope
  val
  binder
  typ =>
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 {k} (r :: k -> *) (block :: k) (stmt :: k) (bod :: k)
       (typ :: k) (val :: k) (scope :: k) (var :: k) (binder :: k)
       (mthd :: k) (vis :: k) (param :: k).
(BlockSym r block stmt, BodySym r bod block, TypeSym r typ,
 ValueSym r val typ, CommandLineArgs r val, Literal r val typ,
 MathConstant r val, ScopeSym r scope, VariableSym r var typ,
 VariableValue r var val, BooleanExpression r val, Comparison r val,
 NumericExpression r val, ValueExpression r var val binder typ,
 MultiStatement r stmt, ValueStatement r stmt val,
 DeclStatement r bod stmt var scope val,
 FuncAppStatement r stmt var val, Argument r val, List r val,
 NativeVector r val typ, Reference r val, Set r val,
 MethodSym r mthd vis param bod var typ, TypeElim r typ) =>
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
    , TypeSym r typ
    , ValueSym r val typ
    , CommandLineArgs r val
    , Literal r val typ
    , MathConstant r val
    , ScopeSym r scope
    , VariableSym r var typ
    , VariableValue r var val
    , BooleanExpression r val
    , Comparison r val
    , NumericExpression r val
    , ValueExpression r var val binder typ
    , MultiStatement r stmt
    , ValueStatement r stmt val
    , DeclStatement r bod stmt var scope val
    , FuncAppStatement r stmt var val
    , Argument r val
    , List r val
    , NativeVector r val typ
    , Reference r val
    , Set r val
    , MethodSym r mthd vis param bod var typ
    , TypeElim r typ
    )
  => GenState (Maybe (MS (r mthd)))
genMainFuncProc :: forall {k} (r :: k -> *) (block :: k) (stmt :: k) (bod :: k)
       (typ :: k) (val :: k) (scope :: k) (var :: k) (binder :: k)
       (mthd :: k) (vis :: k) (param :: k).
(BlockSym r block stmt, BodySym r bod block, TypeSym r typ,
 ValueSym r val typ, CommandLineArgs r val, Literal r val typ,
 MathConstant r val, ScopeSym r scope, VariableSym r var typ,
 VariableValue r var val, BooleanExpression r val, Comparison r val,
 NumericExpression r val, ValueExpression r var val binder typ,
 MultiStatement r stmt, ValueStatement r stmt val,
 DeclStatement r bod stmt var scope val,
 FuncAppStatement r stmt var val, Argument r val, List r val,
 NativeVector r val typ, Reference r val, Set r val,
 MethodSym r mthd vis param bod var typ, TypeElim r typ) =>
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 (f :: * -> *) a. Applicative f => a -> f a
pure 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 (VS (r var))
forall {k} (r :: k -> *) (typ :: k) (var :: k).
(TypeSym r typ, VariableSym r var typ) =>
Input -> GenState (VS (r var))
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
          pure $ 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
  ::
    ( TypeSym r typ
    , ValueSym r val typ
    , Literal r val typ
    , MathConstant r val
    , ScopeSym r scope
    , VariableSym r var typ
    , VariableValue r var val
    , BooleanExpression r val
    , Comparison r val
    , NumericExpression r val
    , ValueExpression r var val binder typ
    , DeclStatement r bod stmt var scope val
    , Argument r val
    , List r val
    , NativeVector r val typ
    , Reference r val
    , Set r val
    , MultiStatement r stmt
    , TypeElim r typ
    )
  => GenState (Maybe (MS (r stmt)))
initConstsProc :: forall {k} (r :: k -> *) (typ :: k) (val :: k) (scope :: k)
       (var :: k) (binder :: k) (bod :: k) (stmt :: k).
(TypeSym r typ, ValueSym r val typ, Literal r val typ,
 MathConstant r val, ScopeSym r scope, VariableSym r var typ,
 VariableValue r var val, BooleanExpression r val, Comparison r val,
 NumericExpression r val, ValueExpression r var val binder typ,
 DeclStatement r bod stmt var scope val, Argument r val, List r val,
 NativeVector r val typ, Reference r val, Set r val,
 MultiStatement r stmt, TypeElim r typ) =>
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 scope
forall {k} (r :: k -> *) (scope :: k).
ScopeSym r scope =>
ScopeType -> r scope
convScope (ScopeType -> r scope) -> ScopeType -> r scope
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 (f :: * -> *) a. Applicative f => a -> f a
pure 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 (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (MS (r stmt))
forall a. Maybe a
Nothing
      declVars = do
        vars <- (Const -> StateT DrasilState Identity (VS (r var)))
-> [Const] -> StateT DrasilState Identity [VS (r var)]
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 (VS (r var))
forall {k} (r :: k -> *) (typ :: k) (var :: k).
(TypeSym r typ, VariableSym r var typ) =>
Input -> GenState (VS (r var))
mkVarProc (Input -> StateT DrasilState Identity (VS (r var)))
-> (Const -> Input)
-> Const
-> StateT DrasilState Identity (VS (r var))
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
        pure $ Just $ multi $
          zipWith (\VS (r var)
vr -> ConstantRepr -> VS (r var) -> r scope -> VS (r val) -> MS (r stmt)
forall {k} {r :: k -> *} {bod :: k} {stmt :: k} {var :: k}
       {scope :: k} {val :: k}.
DeclStatement r bod stmt var scope val =>
ConstantRepr -> VS (r var) -> r scope -> VS (r val) -> 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) VS (r var)
vr r scope
scp) vars vals
      defFunc ConstantRepr
Var = VS (r var) -> r scope -> VS (r val) -> MS (r stmt)
forall {k} (r :: k -> *) (bod :: k) (stmt :: k) (var :: k)
       (scope :: k) (val :: k).
DeclStatement r bod stmt var scope val =>
VS (r var) -> r scope -> VS (r val) -> MS (r stmt)
varDecDef
      defFunc ConstantRepr
Const = VS (r var) -> r scope -> VS (r val) -> MS (r stmt)
forall {k} (r :: k -> *) (bod :: k) (stmt :: k) (var :: k)
       (scope :: k) (val :: k).
DeclStatement r bod stmt var scope val =>
VS (r var) -> r scope -> VS (r val) -> 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 (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
      checkClass [Const]
_ = Bool -> GenState Bool
forall a. a -> StateT DrasilState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 val typ
    , ProcProg r prg file mod mthd vis param bod block stmt var scope val binder typ
    )
  => GenState [FS (r file)]
genInputModProc :: forall (r :: * -> *) val typ prg file mod mthd vis param bod block
       stmt var scope binder.
(NativeVector r val typ,
 ProcProg
   r
   prg
   file
   mod
   mthd
   vis
   param
   bod
   block
   stmt
   var
   scope
   val
   binder
   typ) =>
GenState [FS (r file)]
genInputModProc = do
  ipDesc <- GenState [String] -> GenState String
modDesc GenState [String]
inputParametersDesc
  cname <- genICName InputParameters
  let genMod
        ::
          ( NativeVector r val typ
          , ProcProg r prg file mod mthd vis param bod block stmt var scope val binder typ
          )
        => Bool -> GenState (FS (r file))
      genMod Bool
False = String
-> String
-> [GenState (Maybe (MS (r mthd)))]
-> GenState (FS (r file))
forall (r :: * -> *) prg file mod mthd vis param bod block stmt var
       scope val binder typ.
ProcProg
  r
  prg
  file
  mod
  mthd
  vis
  param
  bod
  block
  stmt
  var
  scope
  val
  binder
  typ =>
String
-> String
-> [GenState (Maybe (MS (r mthd)))]
-> GenState (FS (r file))
genModuleProc String
cname String
ipDesc [VisibilityTag -> GenState (Maybe (MS (r mthd)))
forall {k} (r :: k -> *) (block :: k) (stmt :: k) (bod :: k)
       (typ :: k) (val :: k) (scope :: k) (var :: k) (binder :: k)
       (vis :: k) (mthd :: k) (param :: k).
(BlockSym r block stmt, BodySym r bod block, TypeSym r typ,
 ValueSym r val typ, NativeVector r val typ, Literal r val typ,
 MathConstant r val, ScopeSym r scope, VariableSym r var typ,
 VariableValue r var val, BooleanExpression r val, Comparison r val,
 NumericExpression r val, ValueExpression r var val binder typ,
 VisibilitySym r vis, MultiStatement r stmt,
 DeclStatement r bod stmt var scope val,
 ControlStatement r bod stmt var val,
 StringStatement r stmt var val, FileHandling r stmt var val,
 PrintFile r stmt val, ReadFile r stmt var val, Argument r val,
 List r val, ListStatement r stmt val, Reference r val, Set r val,
 MethodSym r mthd vis param bod var typ, TypeElim r typ,
 VariableElim r var typ) =>
VisibilityTag -> GenState (Maybe (MS (r mthd)))
genInputFormatProc VisibilityTag
Pub,
        VisibilityTag -> GenState (Maybe (MS (r mthd)))
forall {k} (r :: k -> *) (block :: k) (stmt :: k) (bod :: k)
       (typ :: k) (val :: k) (scope :: k) (var :: k) (binder :: k)
       (vis :: k) (mthd :: k) (param :: k).
(BlockSym r block stmt, BodySym r bod block, TypeSym r typ,
 ValueSym r val typ, NativeVector r val typ, Literal r val typ,
 MathConstant r val, ScopeSym r scope, VariableSym r var typ,
 VariableValue r var val, BooleanExpression r val, Comparison r val,
 NumericExpression r val, ValueExpression r var val binder typ,
 Argument r val, Array r var val, List r val, Reference r val,
 Set r val, VisibilitySym r vis, MultiStatement r stmt,
 DeclStatement r bod stmt var scope val,
 AssignStatement r stmt var val,
 ControlStatement r bod stmt var val,
 StringStatement r stmt var val, FileHandling r stmt var val,
 PrintFile r stmt val, ReadFile r stmt var val,
 MethodSym r mthd vis param bod var typ, TypeElim r typ,
 VariableElim r var typ) =>
VisibilityTag -> GenState (Maybe (MS (r mthd)))
genInputDerivedProc VisibilityTag
Pub, VisibilityTag -> GenState (Maybe (MS (r mthd)))
forall {k} (r :: k -> *) (block :: k) (stmt :: k) (bod :: k)
       (typ :: k) (val :: k) (scope :: k) (var :: k) (binder :: k)
       (param :: k) (vis :: k) (mthd :: k).
(BlockSym r block stmt, BodySym r bod block, TypeSym r typ,
 ValueSym r val typ, Literal r val typ, MathConstant r val,
 ScopeSym r scope, VariableSym r var typ, VariableValue r var val,
 BooleanExpression r val, Comparison r val, NumericExpression r val,
 ValueExpression r var val binder typ, Argument r val,
 NativeVector r val typ, Reference r val, Set r val, List r val,
 ParameterSym r param var, VisibilitySym r vis,
 EmptyStatement r stmt, MultiStatement r stmt,
 DeclStatement r bod stmt var scope val, PrintConsole r stmt val,
 FileHandling r stmt var val, PrintFile r stmt val,
 ControlStatement r bod stmt var val,
 MethodSym r mthd vis param bod var typ, TypeElim r typ,
 VariableElim r var typ) =>
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 (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
      checkClass [Input]
_ [Const]
_ = Bool -> GenState Bool
forall a. a -> StateT DrasilState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure 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
  ::
    ( ScopeSym r scope
    , TypeSym r typ
    , VariableSym r var typ
    , MultiStatement r stmt
    , DeclStatement r bo stmt var scope val
    )
  => GenState (Maybe (MS (r stmt)))
getInputDeclProc :: forall {k} (r :: k -> *) (scope :: k) (typ :: k) (var :: k)
       (stmt :: k) (bo :: k) (val :: k).
(ScopeSym r scope, TypeSym r typ, VariableSym r var typ,
 MultiStatement r stmt, DeclStatement r bo stmt var scope val) =>
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 scope
forall {k} (r :: k -> *) (scope :: k).
ScopeSym r scope =>
ScopeType -> r scope
convScope (ScopeType -> r scope) -> ScopeType -> r scope
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 (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (MS (r stmt))
forall a. Maybe a
Nothing
      getDecl ([],[Input]
ins) = do
        vars <- (Input -> StateT DrasilState Identity (VS (r var)))
-> [Input] -> StateT DrasilState Identity [VS (r var)]
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 (VS (r var))
forall {k} (r :: k -> *) (typ :: k) (var :: k).
(TypeSym r typ, VariableSym r var typ) =>
Input -> GenState (VS (r var))
mkVarProc [Input]
ins
        pure $ Just $ multi $ (`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 val typ
    , ProcProg r prg file mod mthd vis param bod block stmt var scope val binder typ
    )
  => GenState (FS (r file))
genCalcModProc :: forall (r :: * -> *) val typ prg file mod mthd vis param bod block
       stmt var scope binder.
(NativeVector r val typ,
 ProcProg
   r
   prg
   file
   mod
   mthd
   vis
   param
   bod
   block
   stmt
   var
   scope
   val
   binder
   typ) =>
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) (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
    , TypeSym r typ
    , ValueSym r val typ
    , NativeVector r val typ
    , Literal r val typ
    , MathConstant r val
    , ScopeSym r scope
    , VariableSym r var typ
    , VariableValue r var val
    , BooleanExpression r val
    , Comparison r val
    , NumericExpression r val
    , ValueExpression r var val binder typ
    , Argument r val
    , Array r var val
    , List r val
    , ListStatement r stmt val
    , Reference r val
    , Set r val
    , ParameterSym r param var
    , VisibilitySym r vis
    , MultiStatement r stmt
    , ValueStatement r stmt val
    , DeclStatement r bod stmt var scope val
    , AssignStatement r stmt var val
    , ControlStatement r bod stmt var val
    , StringStatement r stmt var val
    , FileHandling r stmt var val
    , PrintFile r stmt val
    , ReadFile r stmt var val
    , MethodSym r mthd vis param bod var typ
    , TypeElim r typ
    , VariableElim r var typ
    )
  => CodeDefinition -> GenState (MS (r mthd))
genCalcFuncProc :: forall {k} (r :: k -> *) (block :: k) (stmt :: k) (bod :: k)
       (typ :: k) (val :: k) (scope :: k) (var :: k) (binder :: k)
       (param :: k) (vis :: k) (mthd :: k).
(BlockSym r block stmt, BodySym r bod block, TypeSym r typ,
 ValueSym r val typ, NativeVector r val typ, Literal r val typ,
 MathConstant r val, ScopeSym r scope, VariableSym r var typ,
 VariableValue r var val, BooleanExpression r val, Comparison r val,
 NumericExpression r val, ValueExpression r var val binder typ,
 Argument r val, Array r var val, List r val,
 ListStatement r stmt val, Reference r val, Set r val,
 ParameterSym r param var, VisibilitySym r vis,
 MultiStatement r stmt, ValueStatement r stmt val,
 DeclStatement r bod stmt var scope val,
 AssignStatement r stmt var val,
 ControlStatement r bod stmt var val,
 StringStatement r stmt var val, FileHandling r stmt var val,
 PrintFile r stmt val, ReadFile r stmt var val,
 MethodSym r mthd vis param bod var typ, TypeElim r typ,
 VariableElim r var typ) =>
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 {k} (r :: k -> *) (block :: k) (stmt :: k) (bod :: k)
       (typ :: k) (val :: k) (var :: k) (binder :: k) (scope :: k).
(BlockSym r block stmt, BodySym r bod block, TypeSym r typ,
 ValueSym r val typ, NativeVector r val typ, Literal r val typ,
 MathConstant r val, VariableSym r var typ, VariableValue r var val,
 BooleanExpression r val, Comparison r val, NumericExpression r val,
 ValueExpression r var val binder typ, Argument r val,
 Array r var val, List r val, Reference r val, Set r val,
 DeclStatement r bod stmt var scope val,
 AssignStatement r stmt var val,
 ControlStatement r bod stmt var val,
 StringStatement r stmt var val, FileHandling r stmt var val,
 PrintFile r stmt val, ReadFile r stmt var val, TypeElim r typ) =>
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. Semigroup 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 {k} (r :: k -> *) (block :: k) (stmt :: k) (bod :: k)
       (typ :: k) (val :: k) (scope :: k) (var :: k) (binder :: k).
(BlockSym r block stmt, BodySym r bod block, TypeSym r typ,
 ValueSym r val typ, Literal r val typ, MathConstant r val,
 ScopeSym r scope, VariableSym r var typ, VariableValue r var val,
 BooleanExpression r val, NumericExpression r val,
 ValueExpression r var val binder typ, Comparison r val,
 Argument r val, Array r var val, List r val,
 ListStatement r stmt val, NativeVector r val typ, Reference r val,
 Set r val, MultiStatement r stmt, ValueStatement r stmt val,
 DeclStatement r bod stmt var scope val,
 AssignStatement r stmt var val,
 ControlStatement r bod stmt var val, TypeElim r typ,
 VariableElim r var typ) =>
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)
                   pure [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 <- renderTermAndUnit cdef
  desc <- renderTermAndUnit cdef
  publicFuncProc
    nm
    (convType tp)
    ("Calculates " <> calcDesc)
    (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
    , TypeSym r typ
    , ValueSym r val typ
    , NativeVector r val typ
    , Literal r val typ
    , MathConstant r val
    , VariableSym r var typ
    , VariableValue r var val
    , BooleanExpression r val
    , Comparison r val
    , NumericExpression r val
    , ValueExpression r var val binder typ
    , Argument r val
    , Array r var val
    , List r val
    , Reference r val
    , Set r val
    , DeclStatement r bod stmt var scope val
    , AssignStatement r stmt var val
    , ControlStatement r bod stmt var val
    , StringStatement r stmt var val
    , FileHandling r stmt var val
    , PrintFile r stmt val
    , ReadFile r stmt var val
    , TypeElim r typ
    )
  => CalcType -> CodeDefinition -> CodeExpr -> GenState (MS (r block))
genCalcBlockProc :: forall {k} (r :: k -> *) (block :: k) (stmt :: k) (bod :: k)
       (typ :: k) (val :: k) (var :: k) (binder :: k) (scope :: k).
(BlockSym r block stmt, BodySym r bod block, TypeSym r typ,
 ValueSym r val typ, NativeVector r val typ, Literal r val typ,
 MathConstant r val, VariableSym r var typ, VariableValue r var val,
 BooleanExpression r val, Comparison r val, NumericExpression r val,
 ValueExpression r var val binder typ, Argument r val,
 Array r var val, List r val, Reference r val, Set r val,
 DeclStatement r bod stmt var scope val,
 AssignStatement r stmt var val,
 ControlStatement r bod stmt var val,
 StringStatement r stmt var val, FileHandling r stmt var val,
 PrintFile r stmt val, ReadFile r stmt var val, TypeElim r typ) =>
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 {k} (r :: k -> *) (block :: k) (stmt :: k) (bod :: k)
       (typ :: k) (val :: k) (var :: k) (binder :: k) (scope :: k).
(BlockSym r block stmt, BodySym r bod block, TypeSym r typ,
 ValueSym r val typ, NativeVector r val typ, Literal r val typ,
 MathConstant r val, VariableSym r var typ, VariableValue r var val,
 BooleanExpression r val, Comparison r val, NumericExpression r val,
 ValueExpression r var val binder typ,
 DeclStatement r bod stmt var scope val,
 AssignStatement r stmt var val,
 ControlStatement r bod stmt var val,
 StringStatement r stmt var val, FileHandling r stmt var val,
 ReadFile r stmt var val, PrintFile r stmt val, Argument r val,
 Array r var val, List r val, Reference r val, Set r val,
 TypeElim r typ) =>
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 (VS (r var))
forall {k} (r :: k -> *) (typ :: k) (var :: k).
(TypeSym r typ, VariableSym r var typ) =>
Input -> GenState (VS (r var))
mkVarProc (Const -> Input
forall c. (Quantity c, MayHaveUnit c, Concept c) => c -> Input
quantvar Const
v)
  ee <- convExprProc e
  pure $ 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 (VS (r val) -> MS (r stmt)
forall {k} (r :: k -> *) (bod :: k) (stmt :: k) (var :: k)
       (val :: k).
ControlStatement r bod stmt var val =>
VS (r val) -> MS (r stmt)
returnStmt (VS (r val) -> MS (r stmt))
-> GenState (VS (r val)) -> State DrasilState (MS (r stmt))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CodeExpr -> GenState (VS (r val))
forall {k} (r :: k -> *) (typ :: k) (val :: k) (var :: k)
       (binder :: k).
(TypeSym r typ, ValueSym r val typ, Literal r val typ,
 MathConstant r val, VariableSym r var typ, VariableValue r var val,
 BooleanExpression r val, Comparison r val, NumericExpression r val,
 ValueExpression r var val binder typ, Argument r val,
 NativeVector r val typ, Reference r val, Set r val, List r val,
 TypeElim r typ) =>
CodeExpr -> GenState (VS (r val))
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
    , TypeSym r typ
    , ValueSym r val typ
    , NativeVector r val typ
    , Literal r val typ
    , MathConstant r val
    , VariableSym r var typ
    , VariableValue r var val
    , BooleanExpression r val
    , Comparison r val
    , NumericExpression r val
    , ValueExpression r var val binder typ
    , DeclStatement r bod stmt var scope val
    , AssignStatement r stmt var val
    , ControlStatement r bod stmt var val
    , StringStatement r stmt var val
    , FileHandling r stmt var val
    , ReadFile r stmt var val
    , PrintFile r stmt val
    , Argument r val
    , Array r var val
    , List r val
    , Reference r val
    , Set r val
    , TypeElim r typ
    )
  => CalcType
  -> CodeDefinition
  -> Completeness
  -> [(CodeExpr, CodeExpr)]
  -> GenState (MS (r block))
genCaseBlockProc :: forall {k} (r :: k -> *) (block :: k) (stmt :: k) (bod :: k)
       (typ :: k) (val :: k) (var :: k) (binder :: k) (scope :: k).
(BlockSym r block stmt, BodySym r bod block, TypeSym r typ,
 ValueSym r val typ, NativeVector r val typ, Literal r val typ,
 MathConstant r val, VariableSym r var typ, VariableValue r var val,
 BooleanExpression r val, Comparison r val, NumericExpression r val,
 ValueExpression r var val binder typ,
 DeclStatement r bod stmt var scope val,
 AssignStatement r stmt var val,
 ControlStatement r bod stmt var val,
 StringStatement r stmt var val, FileHandling r stmt var val,
 ReadFile r stmt var val, PrintFile r stmt val, Argument r val,
 Array r var val, List r val, Reference r val, Set r val,
 TypeElim r typ) =>
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. Semigroup 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 (VS (r val), MS (r bod)))
-> [(CodeExpr, CodeExpr)]
-> StateT DrasilState Identity [(VS (r val), 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) -> (VS (r val) -> MS (r bod) -> (VS (r val), MS (r bod)))
-> StateT DrasilState Identity (VS (r val))
-> StateT DrasilState Identity (MS (r bod))
-> StateT DrasilState Identity (VS (r val), MS (r bod))
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) (CodeExpr -> StateT DrasilState Identity (VS (r val))
forall {k} (r :: k -> *) (typ :: k) (val :: k) (var :: k)
       (binder :: k).
(TypeSym r typ, ValueSym r val typ, Literal r val typ,
 MathConstant r val, VariableSym r var typ, VariableValue r var val,
 BooleanExpression r val, Comparison r val, NumericExpression r val,
 ValueExpression r var val binder typ, Argument r val,
 NativeVector r val typ, Reference r val, Set r val, List r val,
 TypeElim r typ) =>
CodeExpr -> GenState (VS (r val))
convExprProc CodeExpr
r) (CodeExpr -> StateT DrasilState Identity (MS (r bod))
calcBody CodeExpr
e)) (Completeness -> [(CodeExpr, CodeExpr)]
ifEs Completeness
c)
  els <- elseE c
  pure $ 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 {k} (r :: k -> *) (block :: k) (stmt :: k) (bod :: k)
       (typ :: k) (val :: k) (var :: k) (binder :: k) (scope :: k).
(BlockSym r block stmt, BodySym r bod block, TypeSym r typ,
 ValueSym r val typ, NativeVector r val typ, Literal r val typ,
 MathConstant r val, VariableSym r var typ, VariableValue r var val,
 BooleanExpression r val, Comparison r val, NumericExpression r val,
 ValueExpression r var val binder typ, Argument r val,
 Array r var val, List r val, Reference r val, Set r val,
 DeclStatement r bod stmt var scope val,
 AssignStatement r stmt var val,
 ControlStatement r bod stmt var val,
 StringStatement r stmt var val, FileHandling r stmt var val,
 PrintFile r stmt val, ReadFile r stmt var val, TypeElim r typ) =>
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 (f :: * -> *) a. Applicative f => a -> f a
pure (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 {k} (r :: k -> *) (bod :: k) (stmt :: k) (var :: k)
       (val :: k).
ControlStatement r bod stmt var val =>
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. Semigroup 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
    , TypeSym r typ
    , ValueSym r val typ
    , NativeVector r val typ
    , Literal r val typ
    , MathConstant r val
    , ScopeSym r scope
    , VariableSym r var typ
    , VariableValue r var val
    , BooleanExpression r val
    , Comparison r val
    , NumericExpression r val
    , ValueExpression r var val binder typ
    , VisibilitySym r vis
    , MultiStatement r stmt
    , DeclStatement r bod stmt var scope val
    , ControlStatement r bod stmt var val
    , StringStatement r stmt var val
    , FileHandling r stmt var val
    , PrintFile r stmt val
    , ReadFile r stmt var val
    , Argument r val
    , List r val
    , ListStatement r stmt val
    , Reference r val
    , Set r val
    , MethodSym r mthd vis param bod var typ
    , TypeElim r typ
    , VariableElim r var typ
    )
  => VisibilityTag -> GenState (Maybe (MS (r mthd)))
genInputFormatProc :: forall {k} (r :: k -> *) (block :: k) (stmt :: k) (bod :: k)
       (typ :: k) (val :: k) (scope :: k) (var :: k) (binder :: k)
       (vis :: k) (mthd :: k) (param :: k).
(BlockSym r block stmt, BodySym r bod block, TypeSym r typ,
 ValueSym r val typ, NativeVector r val typ, Literal r val typ,
 MathConstant r val, ScopeSym r scope, VariableSym r var typ,
 VariableValue r var val, BooleanExpression r val, Comparison r val,
 NumericExpression r val, ValueExpression r var val binder typ,
 VisibilitySym r vis, MultiStatement r stmt,
 DeclStatement r bod stmt var scope val,
 ControlStatement r bod stmt var val,
 StringStatement r stmt var val, FileHandling r stmt var val,
 PrintFile r stmt val, ReadFile r stmt var val, Argument r val,
 List r val, ListStatement r stmt val, Reference r val, Set r val,
 MethodSym r mthd vis param bod var typ, TypeElim r typ,
 VariableElim r var typ) =>
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 {k} (r :: k -> *) (block :: k) (stmt :: k) (bod :: k)
       (typ :: k) (val :: k) (var :: k) (vis :: k) (scope :: k)
       (mthd :: k) (param :: k).
(BlockSym r block stmt, BodySym r bod block, TypeSym r typ,
 Literal r val typ, VariableSym r var typ, VariableValue r var val,
 VisibilitySym r vis, ScopeSym r scope, MultiStatement r stmt,
 DeclStatement r bod stmt var scope val,
 FileHandling r stmt var val, PrintFile r stmt val,
 MethodSym r mthd vis param bod var typ, VariableElim r var typ) =>
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 {k} (r :: k -> *) (block :: k) (stmt :: k) (bod :: k)
       (typ :: k) (val :: k) (var :: k) (vis :: k) (scope :: k)
       (mthd :: k) (param :: k).
(BlockSym r block stmt, BodySym r bod block, TypeSym r typ,
 Literal r val typ, VariableSym r var typ, VariableValue r var val,
 VisibilitySym r vis, ScopeSym r scope, MultiStatement r stmt,
 DeclStatement r bod stmt var scope val,
 FileHandling r stmt var val, PrintFile r stmt val,
 MethodSym r mthd vis param bod var typ, VariableElim r var typ) =>
String
-> String
-> [Input]
-> [Input]
-> [MS (r block)]
-> GenState (MS (r mthd))
privateInOutFuncProc
      genInFormat
        ::
          ( BlockSym r block stmt
          , BodySym r bod block
          , TypeSym r typ
          , ValueSym r val typ
          , NativeVector r val typ
          , Literal r val typ
          , MathConstant r val
          , ScopeSym r scope
          , VariableSym r var typ
          , VariableValue r var val
          , BooleanExpression r val
          , Comparison r val
          , NumericExpression r val
          , ValueExpression r var val binder typ
          , VisibilitySym r vis
          , MultiStatement r stmt
          , DeclStatement r bod stmt var scope val
          , ControlStatement r bod stmt var val
          , StringStatement r stmt var val
          , FileHandling r stmt var val
          , PrintFile r stmt val
          , ReadFile r stmt var val
          , Argument r val
          , List r val
          , ListStatement r stmt val
          , Reference r val
          , Set r val
          , MethodSym r mthd vis param bod var typ
          , TypeElim r typ
          , VariableElim r var typ
          )
        => 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 (f :: * -> *) a. Applicative f => a -> f a
pure 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
        pure $ Just mthd
  genInFormat $ giName `elem` defSet g

-- | Generates a function for calculating derived inputs.
genInputDerivedProc
  ::
    ( BlockSym r block stmt
    , BodySym r bod block
    , TypeSym r typ
    , ValueSym r val typ
    , NativeVector r val typ
    , Literal r val typ
    , MathConstant r val
    , ScopeSym r scope
    , VariableSym r var typ
    , VariableValue r var val
    , BooleanExpression r val
    , Comparison r val
    , NumericExpression r val
    , ValueExpression r var val binder typ
    , Argument r val
    , Array r var val
    , List r val
    , Reference r val
    , Set r val
    , VisibilitySym r vis
    , MultiStatement r stmt
    , DeclStatement r bod stmt var scope val
    , AssignStatement r stmt var val
    , ControlStatement r bod stmt var val
    , StringStatement r stmt var val
    , FileHandling r stmt var val
    , PrintFile r stmt val
    , ReadFile r stmt var val
    , MethodSym r mthd vis param bod var typ
    , TypeElim r typ
    , VariableElim r var typ
    )
  => VisibilityTag -> GenState (Maybe (MS (r mthd)))
genInputDerivedProc :: forall {k} (r :: k -> *) (block :: k) (stmt :: k) (bod :: k)
       (typ :: k) (val :: k) (scope :: k) (var :: k) (binder :: k)
       (vis :: k) (mthd :: k) (param :: k).
(BlockSym r block stmt, BodySym r bod block, TypeSym r typ,
 ValueSym r val typ, NativeVector r val typ, Literal r val typ,
 MathConstant r val, ScopeSym r scope, VariableSym r var typ,
 VariableValue r var val, BooleanExpression r val, Comparison r val,
 NumericExpression r val, ValueExpression r var val binder typ,
 Argument r val, Array r var val, List r val, Reference r val,
 Set r val, VisibilitySym r vis, MultiStatement r stmt,
 DeclStatement r bod stmt var scope val,
 AssignStatement r stmt var val,
 ControlStatement r bod stmt var val,
 StringStatement r stmt var val, FileHandling r stmt var val,
 PrintFile r stmt val, ReadFile r stmt var val,
 MethodSym r mthd vis param bod var typ, TypeElim r typ,
 VariableElim r var typ) =>
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 {k} (r :: k -> *) (block :: k) (stmt :: k) (bod :: k)
       (typ :: k) (val :: k) (var :: k) (vis :: k) (scope :: k)
       (mthd :: k) (param :: k).
(BlockSym r block stmt, BodySym r bod block, TypeSym r typ,
 Literal r val typ, VariableSym r var typ, VariableValue r var val,
 VisibilitySym r vis, ScopeSym r scope, MultiStatement r stmt,
 DeclStatement r bod stmt var scope val,
 FileHandling r stmt var val, PrintFile r stmt val,
 MethodSym r mthd vis param bod var typ, VariableElim r var typ) =>
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 {k} (r :: k -> *) (block :: k) (stmt :: k) (bod :: k)
       (typ :: k) (val :: k) (var :: k) (vis :: k) (scope :: k)
       (mthd :: k) (param :: k).
(BlockSym r block stmt, BodySym r bod block, TypeSym r typ,
 Literal r val typ, VariableSym r var typ, VariableValue r var val,
 VisibilitySym r vis, ScopeSym r scope, MultiStatement r stmt,
 DeclStatement r bod stmt var scope val,
 FileHandling r stmt var val, PrintFile r stmt val,
 MethodSym r mthd vis param bod var typ, VariableElim r var typ) =>
String
-> String
-> [Input]
-> [Input]
-> [MS (r block)]
-> GenState (MS (r mthd))
privateInOutFuncProc
      genDerived
        ::
          ( BlockSym r block stmt
          , BodySym r bod block
          , TypeSym r typ
          , ValueSym r val typ
          , NativeVector r val typ
          , Literal r val typ
          , MathConstant r val
          , ScopeSym r scope
          , VariableSym r var typ
          , VariableValue r var val
          , BooleanExpression r val
          , Comparison r val
          , NumericExpression r val
          , ValueExpression r var val binder typ
          , Argument r val
          , Array r var val
          , List r val
          , Reference r val
          , Set r val
          , VisibilitySym r vis
          , MultiStatement r stmt
          , DeclStatement r bod stmt var scope val
          , AssignStatement r stmt var val
          , ControlStatement r bod stmt var val
          , StringStatement r stmt var val
          , FileHandling r stmt var val
          , PrintFile r stmt val
          , ReadFile r stmt var val
          , MethodSym r mthd vis param bod var typ
          , TypeElim r typ
          , VariableElim r var typ
          )
        => 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 (f :: * -> *) a. Applicative f => a -> f a
pure 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 {k} (r :: k -> *) (block :: k) (stmt :: k) (bod :: k)
       (typ :: k) (val :: k) (var :: k) (binder :: k) (scope :: k).
(BlockSym r block stmt, BodySym r bod block, TypeSym r typ,
 ValueSym r val typ, NativeVector r val typ, Literal r val typ,
 MathConstant r val, VariableSym r var typ, VariableValue r var val,
 BooleanExpression r val, Comparison r val, NumericExpression r val,
 ValueExpression r var val binder typ, Argument r val,
 Array r var val, List r val, Reference r val, Set r val,
 DeclStatement r bod stmt var scope val,
 AssignStatement r stmt var val,
 ControlStatement r bod stmt var val,
 StringStatement r stmt var val, FileHandling r stmt var val,
 PrintFile r stmt val, ReadFile r stmt var val, TypeElim r typ) =>
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
        pure $ Just mthd
  genDerived $ dvName `elem` defSet g

-- | Generates function that checks constraints on the input.
genInputConstraintsProc
  ::
    ( BlockSym r block stmt
    , BodySym r bod block
    , TypeSym r typ
    , ValueSym r val typ
    , Literal r val typ
    , MathConstant r val
    , ScopeSym r scope
    , VariableSym r var typ
    , VariableValue r var val
    , BooleanExpression r val
    , Comparison r val
    , NumericExpression r val
    , ValueExpression r var val binder typ
    , Argument r val
    , NativeVector r val typ
    , Reference r val
    , Set r val
    , List r val
    , ParameterSym r param var
    , VisibilitySym r vis
    , EmptyStatement r stmt
    , MultiStatement r stmt
    , DeclStatement r bod stmt var scope val
    , PrintConsole r stmt val
    , FileHandling r stmt var val
    , PrintFile r stmt val
    , ControlStatement r bod stmt var val
    , MethodSym r mthd vis param bod var typ
    , TypeElim r typ
    , VariableElim r var typ
    )
  => VisibilityTag -> GenState (Maybe (MS (r mthd)))
genInputConstraintsProc :: forall {k} (r :: k -> *) (block :: k) (stmt :: k) (bod :: k)
       (typ :: k) (val :: k) (scope :: k) (var :: k) (binder :: k)
       (param :: k) (vis :: k) (mthd :: k).
(BlockSym r block stmt, BodySym r bod block, TypeSym r typ,
 ValueSym r val typ, Literal r val typ, MathConstant r val,
 ScopeSym r scope, VariableSym r var typ, VariableValue r var val,
 BooleanExpression r val, Comparison r val, NumericExpression r val,
 ValueExpression r var val binder typ, Argument r val,
 NativeVector r val typ, Reference r val, Set r val, List r val,
 ParameterSym r param var, VisibilitySym r vis,
 EmptyStatement r stmt, MultiStatement r stmt,
 DeclStatement r bod stmt var scope val, PrintConsole r stmt val,
 FileHandling r stmt var val, PrintFile r stmt val,
 ControlStatement r bod stmt var val,
 MethodSym r mthd vis param bod var typ, TypeElim r typ,
 VariableElim r var typ) =>
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 typ)
-> String
-> [ParameterChunk]
-> Maybe String
-> [MS (r block)]
-> GenState (MS (r mthd))
forall {k} (r :: k -> *) (typ :: k) (val :: k) (var :: k)
       (param :: k) (vis :: k) (scope :: k) (stmt :: k) (bod :: k)
       (block :: k) (mthd :: k).
(TypeSym r typ, Literal r val typ, VariableSym r var typ,
 VariableValue r var val, ParameterSym r param var,
 VisibilitySym r vis, ScopeSym r scope, MultiStatement r stmt,
 DeclStatement r bod stmt var scope val,
 FileHandling r stmt var val, PrintFile r stmt val,
 BlockSym r block stmt, BodySym r bod block,
 MethodSym r mthd vis param bod var typ, VariableElim r var typ) =>
String
-> VS (r typ)
-> String
-> [ParameterChunk]
-> Maybe String
-> [MS (r block)]
-> GenState (MS (r mthd))
publicFuncProc
      getFunc VisibilityTag
Priv = String
-> VS (r typ)
-> String
-> [ParameterChunk]
-> Maybe String
-> [MS (r block)]
-> GenState (MS (r mthd))
forall {k} (r :: k -> *) (typ :: k) (val :: k) (var :: k)
       (param :: k) (vis :: k) (scope :: k) (stmt :: k) (bod :: k)
       (block :: k) (mthd :: k).
(TypeSym r typ, Literal r val typ, VariableSym r var typ,
 VariableValue r var val, ParameterSym r param var,
 VisibilitySym r vis, ScopeSym r scope, MultiStatement r stmt,
 DeclStatement r bod stmt var scope val,
 FileHandling r stmt var val, PrintFile r stmt val,
 BlockSym r block stmt, BodySym r bod block,
 MethodSym r mthd vis param bod var typ, VariableElim r var typ) =>
String
-> VS (r typ)
-> String
-> [ParameterChunk]
-> Maybe String
-> [MS (r block)]
-> GenState (MS (r mthd))
privateFuncProc
      genConstraints
        ::
          ( BlockSym r block stmt
          , BodySym r bod block
          , TypeSym r typ
          , ValueSym r val typ
          , Literal r val typ
          , MathConstant r val
          , ScopeSym r scope
          , VariableSym r var typ
          , VariableValue r var val
          , BooleanExpression r val
          , Comparison r val
          , NumericExpression r val
          , ValueExpression r var val binder typ
          , Argument r val
          , NativeVector r val typ
          , Reference r val
          , Set r val
          , List r val
          , ParameterSym r param var
          , VisibilitySym r vis
          , EmptyStatement r stmt
          , MultiStatement r stmt
          , DeclStatement r bod stmt var scope val
          , PrintConsole r stmt val
          , FileHandling r stmt var val
          , PrintFile r stmt val
          , ControlStatement r bod stmt var val
          , MethodSym r mthd vis param bod var typ
          , TypeElim r typ
          , VariableElim r var typ
          )
        => 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 (f :: * -> *) a. Applicative f => a -> f a
pure 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   = ConstraintCEMap -> Input -> (Input, [ConstraintCE])
forall q. HasUID q => ConstraintCEMap -> q -> (q, [ConstraintCE])
sfwrLookup ConstraintCEMap
cm (Input -> (Input, [ConstraintCE]))
-> [Input] -> [(Input, [ConstraintCE])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Input]
varsList
            physCs   = ConstraintCEMap -> Input -> (Input, [ConstraintCE])
forall q. HasUID q => ConstraintCEMap -> q -> (q, [ConstraintCE])
physLookup ConstraintCEMap
cm (Input -> (Input, [ConstraintCE]))
-> [Input] -> [(Input, [ConstraintCE])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Input]
varsList
        sf <- sfwrCBodyProc sfwrCs
        ph <- physCBodyProc physCs
        desc <- inConsFuncDesc
        mthd <- getFunc s icName void desc (pcAuto <$> parms)
          Nothing [block sf, block ph]
        pure $ 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
    , TypeSym r typ
    , ValueSym r val typ
    , Literal r val typ
    , MathConstant r val
    , ScopeSym r scope
    , VariableSym r var typ
    , VariableValue r var val
    , BooleanExpression r val
    , Comparison r val
    , NumericExpression r val
    , ValueExpression r var val binder typ
    , Argument r val
    , NativeVector r val typ
    , Reference r val
    , Set r val
    , List r val
    , EmptyStatement r stmt
    , DeclStatement r bod stmt var scope val
    , PrintConsole r stmt val
    , ControlStatement r bod stmt var val
    , TypeElim r typ
    )
 => [(CodeVarChunk, [ConstraintCE])] -> GenState [MS (r stmt)]
sfwrCBodyProc :: forall {k} (r :: k -> *) (block :: k) (stmt :: k) (bod :: k)
       (typ :: k) (val :: k) (scope :: k) (var :: k) (binder :: k).
(BlockSym r block stmt, BodySym r bod block, TypeSym r typ,
 ValueSym r val typ, Literal r val typ, MathConstant r val,
 ScopeSym r scope, VariableSym r var typ, VariableValue r var val,
 BooleanExpression r val, Comparison r val, NumericExpression r val,
 ValueExpression r var val binder typ, Argument r val,
 NativeVector r val typ, Reference r val, Set r val, List r val,
 EmptyStatement r stmt, DeclStatement r bod stmt var scope val,
 PrintConsole r stmt val, ControlStatement r bod stmt var val,
 TypeElim r typ) =>
[(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
    , TypeSym r typ
    , ValueSym r val typ
    , Literal r val typ
    , MathConstant r val
    , ScopeSym r scope
    , VariableSym r var typ
    , VariableValue r var val
    , BooleanExpression r val
    , Comparison r val
    , NumericExpression r val
    , ValueExpression r var val binder typ
    , Argument r val
    , NativeVector r val typ
    , Reference r val
    , Set r val
    , List r val
    , EmptyStatement r stmt
    , DeclStatement r bod stmt var scope val
    , PrintConsole r stmt val
    , ControlStatement r bod stmt var val
    , TypeElim r typ
    )
  => [(CodeVarChunk, [ConstraintCE])] -> GenState [MS (r stmt)]
physCBodyProc :: forall {k} (r :: k -> *) (block :: k) (stmt :: k) (bod :: k)
       (typ :: k) (val :: k) (scope :: k) (var :: k) (binder :: k).
(BlockSym r block stmt, BodySym r bod block, TypeSym r typ,
 ValueSym r val typ, Literal r val typ, MathConstant r val,
 ScopeSym r scope, VariableSym r var typ, VariableValue r var val,
 BooleanExpression r val, Comparison r val, NumericExpression r val,
 ValueExpression r var val binder typ, Argument r val,
 NativeVector r val typ, Reference r val, Set r val, List r val,
 EmptyStatement r stmt, DeclStatement r bod stmt var scope val,
 PrintConsole r stmt val, ControlStatement r bod stmt var val,
 TypeElim r typ) =>
[(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
    , TypeSym r typ
    , ValueSym r val typ
    , Literal r val typ
    , MathConstant r val
    , ScopeSym r scope
    , VariableSym r var typ
    , VariableValue r var val
    , BooleanExpression r val
    , Comparison r val
    , NumericExpression r val
    , ValueExpression r var val binder typ
    , Argument r val
    , NativeVector r val typ
    , Reference r val
    , Set r val
    , List r val
    , EmptyStatement r stmt
    , DeclStatement r bod stmt var scope val
    , PrintConsole r stmt val
    , ControlStatement r bod stmt var val
    , TypeElim r typ
    )
  => ConstraintBehaviour -> [(CodeVarChunk, [ConstraintCE])] -> GenState [MS (r stmt)]
chooseConstrProc :: forall {k} (r :: k -> *) (block :: k) (stmt :: k) (bod :: k)
       (typ :: k) (val :: k) (scope :: k) (var :: k) (binder :: k).
(BlockSym r block stmt, BodySym r bod block, TypeSym r typ,
 ValueSym r val typ, Literal r val typ, MathConstant r val,
 ScopeSym r scope, VariableSym r var typ, VariableValue r var val,
 BooleanExpression r val, Comparison r val, NumericExpression r val,
 ValueExpression r var val binder typ, Argument r val,
 NativeVector r val typ, Reference r val, Set r val, List r val,
 EmptyStatement r stmt, DeclStatement r bod stmt var scope val,
 PrintConsole r stmt val, ControlStatement r bod stmt var val,
 TypeElim r typ) =>
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 {k} (r :: k -> *) (typ :: k) (val :: k) (scope :: k)
       (var :: k) (binder :: k) (bod :: k) (stmt :: k).
(TypeSym r typ, ValueSym r val typ, Literal r val typ,
 MathConstant r val, ScopeSym r scope, VariableSym r var typ,
 VariableValue r var val, BooleanExpression r val, Comparison r val,
 NumericExpression r val, ValueExpression r var val binder typ,
 Argument r val, NativeVector r val typ, Reference r val, Set r val,
 List r val, DeclStatement r bod stmt var scope val,
 TypeElim r typ) =>
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 (f :: * -> *) a. Applicative f => a -> f a
pure 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 (VS (r val)))
-> [ConstraintCE] -> StateT DrasilState Identity [VS (r val)]
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 (VS (r val))
forall {k} (r :: k -> *) (typ :: k) (val :: k) (var :: k)
       (binder :: k).
(TypeSym r typ, ValueSym r val typ, Literal r val typ,
 MathConstant r val, VariableSym r var typ, VariableValue r var val,
 BooleanExpression r val, Comparison r val, NumericExpression r val,
 ValueExpression r var val binder typ, Argument r val,
 NativeVector r val typ, Reference r val, Set r val, List r val,
 TypeElim r typ) =>
CodeExpr -> GenState (VS (r val))
convExprProc (CodeExpr -> StateT DrasilState Identity (VS (r val)))
-> (ConstraintCE -> CodeExpr)
-> ConstraintCE
-> StateT DrasilState Identity (VS (r val))
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
$ ([VS (r val)] -> [MS (r bod)] -> [MS (r stmt)])
-> [[VS (r val)]] -> [[MS (r bod)]] -> [[MS (r stmt)]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ((VS (r val) -> MS (r bod) -> MS (r stmt))
-> [VS (r val)] -> [MS (r bod)] -> [MS (r stmt)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\VS (r val)
cond MS (r bod)
bod -> [(VS (r val), MS (r bod))] -> MS (r stmt)
forall {k} (r :: k -> *) (bod :: k) (block :: k) (stmt :: k)
       (var :: k) (val :: k).
(BodySym r bod block, ControlStatement r bod stmt var val) =>
[(VS (r val), MS (r bod))] -> MS (r stmt)
ifNoElse [(VS (r val) -> VS (r val)
forall {k} (r :: k -> *) (val :: k).
BooleanExpression r val =>
VS (r val) -> VS (r val)
(?!) VS (r val)
cond, MS (r bod)
bod)])) [[VS (r val)]]
conds [[MS (r bod)]]
bods
  pure $ interleave varDecs bodies
  where chooseCB :: ConstraintBehaviour
-> (Input, [ConstraintCE]) -> GenState [MS (r bod)]
chooseCB ConstraintBehaviour
Warning = (Input, [ConstraintCE]) -> GenState [MS (r bod)]
forall {k} (r :: k -> *) (typ :: k) (val :: k) (var :: k)
       (binder :: k) (stmt :: k) (block :: k) (bod :: k).
(TypeSym r typ, ValueSym r val typ, Literal r val typ,
 MathConstant r val, VariableSym r var typ, VariableValue r var val,
 BooleanExpression r val, Comparison r val, NumericExpression r val,
 ValueExpression r var val binder typ, Argument r val,
 NativeVector r val typ, Reference r val, Set r val, List r val,
 PrintConsole r stmt val, BlockSym r block stmt,
 BodySym r bod block, TypeElim r typ) =>
(Input, [ConstraintCE]) -> GenState [MS (r bod)]
constrWarnProc
        chooseCB ConstraintBehaviour
Exception = (Input, [ConstraintCE]) -> GenState [MS (r bod)]
forall {k} (r :: k -> *) (block :: k) (stmt :: k) (bod :: k)
       (typ :: k) (val :: k) (var :: k) (binder :: k).
(BlockSym r block stmt, BodySym r bod block, TypeSym r typ,
 ValueSym r val typ, Literal r val typ, MathConstant r val,
 VariableSym r var typ, VariableValue r var val,
 BooleanExpression r val, Comparison r val, NumericExpression r val,
 ValueExpression r var val binder typ, Argument r val,
 NativeVector r val typ, Reference r val, Set r val, List r val,
 PrintConsole r stmt val, ControlStatement r bod stmt var val,
 TypeElim r typ) =>
(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
  ::
    ( TypeSym r typ
    , ValueSym r val typ
    , Literal r val typ
    , MathConstant r val
    , VariableSym r var typ
    , VariableValue r var val
    , BooleanExpression r val
    , Comparison r val
    , NumericExpression r val
    , ValueExpression r var val binder typ
    , Argument r val
    , NativeVector r val typ
    , Reference r val
    , Set r val
    , List r val
    , PrintConsole r stmt val
    , BlockSym r block stmt
    , BodySym r bod block
    , TypeElim r typ
    )
  => (CodeVarChunk, [ConstraintCE]) -> GenState [MS (r bod)]
constrWarnProc :: forall {k} (r :: k -> *) (typ :: k) (val :: k) (var :: k)
       (binder :: k) (stmt :: k) (block :: k) (bod :: k).
(TypeSym r typ, ValueSym r val typ, Literal r val typ,
 MathConstant r val, VariableSym r var typ, VariableValue r var val,
 BooleanExpression r val, Comparison r val, NumericExpression r val,
 ValueExpression r var val binder typ, Argument r val,
 NativeVector r val typ, Reference r val, Set r val, List r val,
 PrintConsole r stmt val, BlockSym r block stmt,
 BodySym r bod block, TypeElim r typ) =>
(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 {k} (r :: k -> *) (typ :: k) (val :: k) (var :: k)
       (binder :: k) (stmt :: k).
(TypeSym r typ, ValueSym r val typ, Literal r val typ,
 MathConstant r val, VariableSym r var typ, VariableValue r var val,
 BooleanExpression r val, Comparison r val, NumericExpression r val,
 ValueExpression r var val binder typ, Argument r val,
 NativeVector r val typ, Reference r val, Set r val, List r val,
 PrintConsole r stmt val, TypeElim r typ) =>
Input -> String -> ConstraintCE -> GenState [MS (r stmt)]
constraintViolatedMsgProc Input
q String
"suggested") [ConstraintCE]
cs
  pure $ 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
    , TypeSym r typ
    , ValueSym r val typ
    , Literal r val typ
    , MathConstant r val
    , VariableSym r var typ
    , VariableValue r var val
    , BooleanExpression r val
    , Comparison r val
    , NumericExpression r val
    , ValueExpression r var val binder typ
    , Argument r val
    , NativeVector r val typ
    , Reference r val
    , Set r val
    , List r val
    , PrintConsole r stmt val
    , ControlStatement r bod stmt var val
    , TypeElim r typ
    )
  => (CodeVarChunk, [ConstraintCE]) -> GenState [MS (r bod)]
constrExcProc :: forall {k} (r :: k -> *) (block :: k) (stmt :: k) (bod :: k)
       (typ :: k) (val :: k) (var :: k) (binder :: k).
(BlockSym r block stmt, BodySym r bod block, TypeSym r typ,
 ValueSym r val typ, Literal r val typ, MathConstant r val,
 VariableSym r var typ, VariableValue r var val,
 BooleanExpression r val, Comparison r val, NumericExpression r val,
 ValueExpression r var val binder typ, Argument r val,
 NativeVector r val typ, Reference r val, Set r val, List r val,
 PrintConsole r stmt val, ControlStatement r bod stmt var val,
 TypeElim r typ) =>
(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 {k} (r :: k -> *) (typ :: k) (val :: k) (var :: k)
       (binder :: k) (stmt :: k).
(TypeSym r typ, ValueSym r val typ, Literal r val typ,
 MathConstant r val, VariableSym r var typ, VariableValue r var val,
 BooleanExpression r val, Comparison r val, NumericExpression r val,
 ValueExpression r var val binder typ, Argument r val,
 NativeVector r val typ, Reference r val, Set r val, List r val,
 PrintConsole r stmt val, TypeElim r typ) =>
Input -> String -> ConstraintCE -> GenState [MS (r stmt)]
constraintViolatedMsgProc Input
q String
"expected") [ConstraintCE]
cs
  pure $ bodyStatements . (++ [throw "InputError"]) <$> msgs

-- | Generate a set variable dec
constrVarDecProc
  ::
    ( TypeSym r typ
    , ValueSym r val typ
    , Literal r val typ
    , MathConstant r val
    , ScopeSym r scope
    , VariableSym r var typ
    , VariableValue r var val
    , BooleanExpression r val
    , Comparison r val
    , NumericExpression r val
    , ValueExpression r var val binder typ
    , Argument r val
    , NativeVector r val typ
    , Reference r val
    , Set r val
    , List r val
    , DeclStatement r bod stmt var scope val
    , TypeElim r typ
    )
  => CodeVarChunk -> CodeExpr ->
  GenState (MS (r stmt))
constrVarDecProc :: forall {k} (r :: k -> *) (typ :: k) (val :: k) (scope :: k)
       (var :: k) (binder :: k) (bod :: k) (stmt :: k).
(TypeSym r typ, ValueSym r val typ, Literal r val typ,
 MathConstant r val, ScopeSym r scope, VariableSym r var typ,
 VariableValue r var val, BooleanExpression r val, Comparison r val,
 NumericExpression r val, ValueExpression r var val binder typ,
 Argument r val, NativeVector r val typ, Reference r val, Set r val,
 List r val, DeclStatement r bod stmt var scope val,
 TypeElim r typ) =>
Input -> CodeExpr -> GenState (MS (r stmt))
constrVarDecProc Input
v CodeExpr
e = do
  lb <- CodeExpr -> GenState (VS (r val))
forall {k} (r :: k -> *) (typ :: k) (val :: k) (var :: k)
       (binder :: k).
(TypeSym r typ, ValueSym r val typ, Literal r val typ,
 MathConstant r val, VariableSym r var typ, VariableValue r var val,
 BooleanExpression r val, Comparison r val, NumericExpression r val,
 ValueExpression r var val binder typ, Argument r val,
 NativeVector r val typ, Reference r val, Set r val, List r val,
 TypeElim r typ) =>
CodeExpr -> GenState (VS (r val))
convExprProc CodeExpr
e
  t <- codeType v
  let mkValue = String -> VS (r typ) -> VS (r var)
forall {k} (r :: k -> *) (var :: k) (typ :: k).
VariableSym r var typ =>
String -> VS (r typ) -> VS (r var)
var (String
"set_" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Input -> String
forall x. HasSymbol x => x -> String
oneLineCodeSymbolDoc Input
v) (VS (r typ) -> VS (r typ)
forall {k} (r :: k -> *) (typ :: k).
TypeSym r typ =>
VS (r typ) -> VS (r typ)
setType (CodeType -> VS (r typ)
forall {k} (r :: k -> *) (typ :: k).
TypeSym r typ =>
CodeType -> VS (r typ)
convType CodeType
t))
  pure (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
  ::
    ( TypeSym r typ
    , ValueSym r val typ
    , Literal r val typ
    , MathConstant r val
    , VariableSym r var typ
    , VariableValue r var val
    , BooleanExpression r val
    , Comparison r val
    , NumericExpression r val
    , ValueExpression r var val binder typ
    , Argument r val
    , NativeVector r val typ
    , Reference r val
    , Set r val
    , List r val
    , PrintConsole r stmt val
    , TypeElim r typ
    )
  => CodeVarChunk -> String -> ConstraintCE -> GenState [MS (r stmt)]
constraintViolatedMsgProc :: forall {k} (r :: k -> *) (typ :: k) (val :: k) (var :: k)
       (binder :: k) (stmt :: k).
(TypeSym r typ, ValueSym r val typ, Literal r val typ,
 MathConstant r val, VariableSym r var typ, VariableValue r var val,
 BooleanExpression r val, Comparison r val, NumericExpression r val,
 ValueExpression r var val binder typ, Argument r val,
 NativeVector r val typ, Reference r val, Set r val, List r val,
 PrintConsole r stmt val, TypeElim r typ) =>
Input -> String -> ConstraintCE -> GenState [MS (r stmt)]
constraintViolatedMsgProc Input
q String
s ConstraintCE
c = do
  pc <- ConstraintCE -> GenState [MS (r stmt)]
forall {k} (r :: k -> *) (typ :: k) (val :: k) (var :: k)
       (binder :: k) (stmt :: k).
(TypeSym r typ, ValueSym r val typ, Literal r val typ,
 MathConstant r val, VariableSym r var typ, VariableValue r var val,
 BooleanExpression r val, Comparison r val, NumericExpression r val,
 ValueExpression r var val binder typ, Argument r val,
 NativeVector r val typ, Reference r val, Set r val, List r val,
 PrintConsole r stmt val, TypeElim r typ) =>
ConstraintCE -> GenState [MS (r stmt)]
printConstraintProc ConstraintCE
c
  v <- mkValProc (quantvar q)
  pure $ [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
  ::
    ( TypeSym r typ
    , ValueSym r val typ
    , Literal r val typ
    , MathConstant r val
    , VariableSym r var typ
    , VariableValue r var val
    , BooleanExpression r val
    , Comparison r val
    , NumericExpression r val
    , ValueExpression r var val binder typ
    , Argument r val
    , NativeVector r val typ
    , Reference r val
    , Set r val
    , List r val
    , PrintConsole r stmt val
    , TypeElim r typ
    )
  => ConstraintCE -> GenState [MS (r stmt)]
printConstraintProc :: forall {k} (r :: k -> *) (typ :: k) (val :: k) (var :: k)
       (binder :: k) (stmt :: k).
(TypeSym r typ, ValueSym r val typ, Literal r val typ,
 MathConstant r val, VariableSym r var typ, VariableValue r var val,
 BooleanExpression r val, Comparison r val, NumericExpression r val,
 ValueExpression r var val binder typ, Argument r val,
 NativeVector r val typ, Reference r val, Set r val, List r val,
 PrintConsole r stmt val, TypeElim r typ) =>
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'
        ::
          ( TypeSym r typ
          , ValueSym r val typ
          , Literal r val typ
          , MathConstant r val
          , VariableSym r var typ
          , VariableValue r var val
          , BooleanExpression r val
          , Comparison r val
          , NumericExpression r val
          , ValueExpression r var val binder typ
          , Argument r val
          , NativeVector r val typ
          , Reference r val
          , Set r val
          , List r val
          , PrintConsole r stmt val
          , TypeElim r typ
          )
        => ConstraintCE -> GenState [MS (r stmt)]
      printConstraint' (Range ConstraintReason
_ (Bounded (Inclusive
_, CodeExpr
e1) (Inclusive
_, CodeExpr
e2))) = do
        lb <- CodeExpr -> GenState (VS (r val))
forall {k} (r :: k -> *) (typ :: k) (val :: k) (var :: k)
       (binder :: k).
(TypeSym r typ, ValueSym r val typ, Literal r val typ,
 MathConstant r val, VariableSym r var typ, VariableValue r var val,
 BooleanExpression r val, Comparison r val, NumericExpression r val,
 ValueExpression r var val binder typ, Argument r val,
 NativeVector r val typ, Reference r val, Set r val, List r val,
 TypeElim r typ) =>
CodeExpr -> GenState (VS (r val))
convExprProc CodeExpr
e1
        ub <- convExprProc e2
        pure $ [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 (VS (r val))
forall {k} (r :: k -> *) (typ :: k) (val :: k) (var :: k)
       (binder :: k).
(TypeSym r typ, ValueSym r val typ, Literal r val typ,
 MathConstant r val, VariableSym r var typ, VariableValue r var val,
 BooleanExpression r val, Comparison r val, NumericExpression r val,
 ValueExpression r var val binder typ, Argument r val,
 NativeVector r val typ, Reference r val, Set r val, List r val,
 TypeElim r typ) =>
CodeExpr -> GenState (VS (r val))
convExprProc CodeExpr
e
        pure $ [printStr "below ", print ub] <> printExpr e db <>
          [printStrLn "."]
      printConstraint' (Range ConstraintReason
_ (UpFrom (Inclusive
_, CodeExpr
e))) = do
        lb <- CodeExpr -> GenState (VS (r val))
forall {k} (r :: k -> *) (typ :: k) (val :: k) (var :: k)
       (binder :: k).
(TypeSym r typ, ValueSym r val typ, Literal r val typ,
 MathConstant r val, VariableSym r var typ, VariableValue r var val,
 BooleanExpression r val, Comparison r val, NumericExpression r val,
 ValueExpression r var val binder typ, Argument r val,
 NativeVector r val typ, Reference r val, Set r val, List r val,
 TypeElim r typ) =>
CodeExpr -> GenState (VS (r val))
convExprProc CodeExpr
e
        pure $ [printStr "above ", print lb] <> printExpr e db <> [printStrLn "."]
      printConstraint' (Elem ConstraintReason
_ CodeExpr
e) = do
        lb <- CodeExpr -> GenState (VS (r val))
forall {k} (r :: k -> *) (typ :: k) (val :: k) (var :: k)
       (binder :: k).
(TypeSym r typ, ValueSym r val typ, Literal r val typ,
 MathConstant r val, VariableSym r var typ, VariableValue r var val,
 BooleanExpression r val, Comparison r val, NumericExpression r val,
 ValueExpression r var val binder typ, Argument r val,
 NativeVector r val typ, Reference r val, Set r val, List r val,
 TypeElim r typ) =>
CodeExpr -> GenState (VS (r val))
convExprProc CodeExpr
e
        pure $ [printStr "an element of the set ", print lb] <> [printStrLn "."]
  printConstraint' c

-- | Generates a module containing the function for printing outputs.
genOutputModProc
  ::
    ( NativeVector r val typ
    , ProcProg r prg file mod mthd vis param bod block stmt var scope val binder typ
    )
  => GenState [FS (r file)]
genOutputModProc :: forall (r :: * -> *) val typ prg file mod mthd vis param bod block
       stmt var scope binder.
(NativeVector r val typ,
 ProcProg
   r
   prg
   file
   mod
   mthd
   vis
   param
   bod
   block
   stmt
   var
   scope
   val
   binder
   typ) =>
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
    , TypeSym r typ
    , ValueSym r val typ
    , NativeVector r val typ
    , Literal r val typ
    , MathConstant r val
    , ScopeSym r scope
    , VariableSym r var typ
    , VariableValue r var val
    , BooleanExpression r val
    , Comparison r val
    , NumericExpression r val
    , ValueExpression r var val binder typ
    , Argument r val
    , List r val
    , Reference r val
    , Set r val
    , VisibilitySym r vis
    , ParameterSym r param var
    , MultiStatement r stmt
    , DeclStatement r bod stmt var scope val
    , ControlStatement r bod stmt var val
    , FileHandling r stmt var val
    , PrintFile r stmt val
    , MethodSym r mthd vis param bod var typ
    , TypeElim r typ
    , VariableElim r var typ
    )
  => GenState (Maybe (MS (r mthd)))
genOutputFormatProc :: forall {k} (r :: k -> *) (block :: k) (stmt :: k) (bod :: k)
       (typ :: k) (val :: k) (scope :: k) (var :: k) (binder :: k)
       (vis :: k) (param :: k) (mthd :: k).
(BlockSym r block stmt, BodySym r bod block, TypeSym r typ,
 ValueSym r val typ, NativeVector r val typ, Literal r val typ,
 MathConstant r val, ScopeSym r scope, VariableSym r var typ,
 VariableValue r var val, BooleanExpression r val, Comparison r val,
 NumericExpression r val, ValueExpression r var val binder typ,
 Argument r val, List r val, Reference r val, Set r val,
 VisibilitySym r vis, ParameterSym r param var,
 MultiStatement r stmt, DeclStatement r bod stmt var scope val,
 ControlStatement r bod stmt var val, FileHandling r stmt var val,
 PrintFile r stmt val, MethodSym r mthd vis param bod var typ,
 TypeElim r typ, VariableElim r var typ) =>
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
          , TypeSym r typ
          , NativeVector r val typ
          , ValueSym r val typ
          , Literal r val typ
          , MathConstant r val
          , ScopeSym r scope
          , VariableSym r var typ
          , VariableValue r var val
          , BooleanExpression r val
          , Comparison r val
          , NumericExpression r val
          , ValueExpression r var val binder typ
          , Argument r val
          , List r val
          , Reference r val
          , Set r val
          , VisibilitySym r vis
          , ParameterSym r param var
          , MultiStatement r stmt
          , DeclStatement r bod stmt var scope val
          , ControlStatement r bod stmt var val
          , FileHandling r stmt var val
          , PrintFile r stmt val
          , MethodSym r mthd vis param bod var typ
          , TypeElim r typ
          , VariableElim r var typ
          )
        => 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 (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (MS (r mthd))
forall a. Maybe a
Nothing
      genOutput (Just String
_) = do
        let l_outfile :: String
l_outfile = String
"outputfile"
            var_outfile :: VS (r var)
var_outfile = String -> VS (r typ) -> VS (r var)
forall {k} (r :: k -> *) (var :: k) (typ :: k).
VariableSym r var typ =>
String -> VS (r typ) -> VS (r var)
var String
l_outfile VS (r typ)
forall {k} (r :: k -> *) (typ :: k). TypeSym r typ => VS (r typ)
outfile
            v_outfile :: VS (r val)
v_outfile = VS (r var) -> VS (r val)
forall {k} (r :: k -> *) (var :: k) (val :: k).
VariableValue r var val =>
VS (r var) -> VS (r val)
valueOf VS (r var)
var_outfile
        parms <- GenState [Input]
getOutputParams
        let outs = DrasilState -> Input -> Input
resolveOutputDefType DrasilState
g (Input -> Input) -> [Input] -> [Input]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (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 (VS (r val))
forall {k} (r :: k -> *) (val :: k) (typ :: k) (var :: k)
       (binder :: k).
(NativeVector r val typ, TypeSym r typ, ValueSym r val typ,
 Literal r val typ, MathConstant r val, VariableSym r var typ,
 VariableValue r var val, BooleanExpression r val, Comparison r val,
 NumericExpression r val, ValueExpression r var val binder typ,
 Argument r val, List r val, Reference r val, Set r val,
 TypeElim r typ) =>
Input -> GenState (VS (r val))
mkValProc Input
x
          pure $
            printFileStr v_outfile (codeName x <> " = ")
            : writeOutputValue v_outfile v (x ^. typ) ) outs
        desc <- woFuncDesc
        mthd <- publicFuncProc woName void desc (pcAuto <$> parms) Nothing
          [block $ [
          varDec var_outfile local,
          openFileW var_outfile (litString "output.txt") ] <>
          concat outp <> [ closeFile v_outfile ]]
        pure $ Just mthd
  genOutput $ Map.lookup woName (eMap g)

writeOutputValue
  ::
    ( BlockSym r block stmt
    , BodySym r bod block
    , TypeSym r typ
    , Literal r val typ
    , VariableSym r var typ
    , VariableValue r var val
    , Comparison r val
    , NumericExpression r val
    , ControlStatement r bod stmt var val
    , PrintFile r stmt val
    , List r val
    )
  => VS (r val) -> VS (r val) -> Space -> [MS (r stmt)]
writeOutputValue :: forall {k} (r :: k -> *) (block :: k) (stmt :: k) (bod :: k)
       (typ :: k) (val :: k) (var :: k).
(BlockSym r block stmt, BodySym r bod block, TypeSym r typ,
 Literal r val typ, VariableSym r var typ, VariableValue r var val,
 Comparison r val, NumericExpression r val,
 ControlStatement r bod stmt var val, PrintFile r stmt val,
 List r val) =>
VS (r val) -> VS (r val) -> Space -> [MS (r stmt)]
writeOutputValue VS (r val)
out = VS (r val) -> Space -> [MS (r stmt)]
writeTop
  where
    writeTop :: VS (r val) -> Space -> [MS (r stmt)]
writeTop VS (r val)
curr (Vect Space
inner) =
      let idx :: VS (r var)
idx = String -> VS (r typ) -> VS (r var)
forall {k} (r :: k -> *) (var :: k) (typ :: k).
VariableSym r var typ =>
String -> VS (r typ) -> VS (r var)
var String
"list_i1" VS (r typ)
forall {k} (r :: k -> *) (typ :: k). TypeSym r typ => VS (r typ)
int
          vIdx :: VS (r val)
vIdx = VS (r var) -> VS (r val)
forall {k} (r :: k -> *) (var :: k) (val :: k).
VariableValue r var val =>
VS (r var) -> VS (r val)
valueOf VS (r var)
idx
          elemAt :: VS (r val)
elemAt = VS (r val) -> VS (r val) -> VS (r val)
forall {k} (r :: k -> *) (val :: k).
List r val =>
VS (r val) -> VS (r val) -> VS (r val)
listAccess VS (r val)
curr VS (r val)
vIdx
      in [ VS (r val) -> String -> MS (r stmt)
forall {k} (r :: k -> *) (stmt :: k) (val :: k).
PrintFile r stmt val =>
VS (r val) -> String -> MS (r stmt)
printFileStr VS (r val)
out String
"["
         , VS (r var)
-> VS (r val)
-> VS (r val)
-> VS (r val)
-> MS (r bod)
-> MS (r stmt)
forall {k} (r :: k -> *) (bod :: k) (stmt :: k) (var :: k)
       (val :: k).
ControlStatement r bod stmt var val =>
VS (r var)
-> VS (r val)
-> VS (r val)
-> VS (r val)
-> MS (r bod)
-> MS (r stmt)
forRange VS (r var)
idx (Integer -> VS (r val)
forall {k} (r :: k -> *) (val :: k) (typ :: k).
Literal r val typ =>
Integer -> VS (r val)
litInt Integer
0) (VS (r val) -> VS (r val)
forall {k} (r :: k -> *) (val :: k).
List r val =>
VS (r val) -> VS (r val)
listSize VS (r val)
curr) (Integer -> VS (r val)
forall {k} (r :: k -> *) (val :: k) (typ :: k).
Literal r val typ =>
Integer -> VS (r val)
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 -> VS (r val) -> Space -> [MS (r stmt)]
writeInner (Integer
2 :: Integer) VS (r val)
elemAt Space
inner [MS (r stmt)] -> [MS (r stmt)] -> [MS (r stmt)]
forall a. Semigroup a => a -> a -> a
<>
             [[(VS (r val), MS (r bod))] -> MS (r stmt)
forall {k} (r :: k -> *) (bod :: k) (block :: k) (stmt :: k)
       (var :: k) (val :: k).
(BodySym r bod block, ControlStatement r bod stmt var val) =>
[(VS (r val), MS (r bod))] -> MS (r stmt)
ifNoElse [(VS (r val)
vIdx VS (r val) -> VS (r val) -> VS (r val)
forall {k} (r :: k -> *) (val :: k).
Comparison r val =>
VS (r val) -> VS (r val) -> VS (r val)
?< (VS (r val) -> VS (r val)
forall {k} (r :: k -> *) (val :: k).
List r val =>
VS (r val) -> VS (r val)
listSize VS (r val)
curr VS (r val) -> VS (r val) -> VS (r val)
forall {k} (r :: k -> *) (val :: k).
NumericExpression r val =>
VS (r val) -> VS (r val) -> VS (r val)
#- Integer -> VS (r val)
forall {k} (r :: k -> *) (val :: k) (typ :: k).
Literal r val typ =>
Integer -> VS (r val)
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 [VS (r val) -> String -> MS (r stmt)
forall {k} (r :: k -> *) (stmt :: k) (val :: k).
PrintFile r stmt val =>
VS (r val) -> String -> MS (r stmt)
printFileStr VS (r val)
out String
", "])]]
         , VS (r val) -> String -> MS (r stmt)
forall {k} (r :: k -> *) (stmt :: k) (val :: k).
PrintFile r stmt val =>
VS (r val) -> String -> MS (r stmt)
printFileStrLn VS (r val)
out String
"]"
         ]
    writeTop VS (r val)
curr Space
_ = [VS (r val) -> VS (r val) -> MS (r stmt)
forall {k} (r :: k -> *) (stmt :: k) (val :: k).
PrintFile r stmt val =>
VS (r val) -> VS (r val) -> MS (r stmt)
printFileLn VS (r val)
out VS (r val)
curr]
    writeInner :: Integer -> VS (r val) -> Space -> [MS (r stmt)]
writeInner Integer
n VS (r val)
curr (Vect Space
inner) =
      let idx :: VS (r var)
idx = String -> VS (r typ) -> VS (r var)
forall {k} (r :: k -> *) (var :: k) (typ :: k).
VariableSym r var typ =>
String -> VS (r typ) -> VS (r var)
var (String
"list_i" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Integer -> String
forall a. Show a => a -> String
show Integer
n) VS (r typ)
forall {k} (r :: k -> *) (typ :: k). TypeSym r typ => VS (r typ)
int
          vIdx :: VS (r val)
vIdx = VS (r var) -> VS (r val)
forall {k} (r :: k -> *) (var :: k) (val :: k).
VariableValue r var val =>
VS (r var) -> VS (r val)
valueOf VS (r var)
idx
          elemAt :: VS (r val)
elemAt = VS (r val) -> VS (r val) -> VS (r val)
forall {k} (r :: k -> *) (val :: k).
List r val =>
VS (r val) -> VS (r val) -> VS (r val)
listAccess VS (r val)
curr VS (r val)
vIdx
      in [ VS (r val) -> String -> MS (r stmt)
forall {k} (r :: k -> *) (stmt :: k) (val :: k).
PrintFile r stmt val =>
VS (r val) -> String -> MS (r stmt)
printFileStr VS (r val)
out String
"["
         , VS (r var)
-> VS (r val)
-> VS (r val)
-> VS (r val)
-> MS (r bod)
-> MS (r stmt)
forall {k} (r :: k -> *) (bod :: k) (stmt :: k) (var :: k)
       (val :: k).
ControlStatement r bod stmt var val =>
VS (r var)
-> VS (r val)
-> VS (r val)
-> VS (r val)
-> MS (r bod)
-> MS (r stmt)
forRange VS (r var)
idx (Integer -> VS (r val)
forall {k} (r :: k -> *) (val :: k) (typ :: k).
Literal r val typ =>
Integer -> VS (r val)
litInt Integer
0) (VS (r val) -> VS (r val)
forall {k} (r :: k -> *) (val :: k).
List r val =>
VS (r val) -> VS (r val)
listSize VS (r val)
curr) (Integer -> VS (r val)
forall {k} (r :: k -> *) (val :: k) (typ :: k).
Literal r val typ =>
Integer -> VS (r val)
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 -> VS (r val) -> Space -> [MS (r stmt)]
writeInner (Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1) VS (r val)
elemAt Space
inner [MS (r stmt)] -> [MS (r stmt)] -> [MS (r stmt)]
forall a. Semigroup a => a -> a -> a
<>
             [[(VS (r val), MS (r bod))] -> MS (r stmt)
forall {k} (r :: k -> *) (bod :: k) (block :: k) (stmt :: k)
       (var :: k) (val :: k).
(BodySym r bod block, ControlStatement r bod stmt var val) =>
[(VS (r val), MS (r bod))] -> MS (r stmt)
ifNoElse [(VS (r val)
vIdx VS (r val) -> VS (r val) -> VS (r val)
forall {k} (r :: k -> *) (val :: k).
Comparison r val =>
VS (r val) -> VS (r val) -> VS (r val)
?< (VS (r val) -> VS (r val)
forall {k} (r :: k -> *) (val :: k).
List r val =>
VS (r val) -> VS (r val)
listSize VS (r val)
curr VS (r val) -> VS (r val) -> VS (r val)
forall {k} (r :: k -> *) (val :: k).
NumericExpression r val =>
VS (r val) -> VS (r val) -> VS (r val)
#- Integer -> VS (r val)
forall {k} (r :: k -> *) (val :: k) (typ :: k).
Literal r val typ =>
Integer -> VS (r val)
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 [VS (r val) -> String -> MS (r stmt)
forall {k} (r :: k -> *) (stmt :: k) (val :: k).
PrintFile r stmt val =>
VS (r val) -> String -> MS (r stmt)
printFileStr VS (r val)
out String
", "])]]
         , VS (r val) -> String -> MS (r stmt)
forall {k} (r :: k -> *) (stmt :: k) (val :: k).
PrintFile r stmt val =>
VS (r val) -> String -> MS (r stmt)
printFileStr VS (r val)
out String
"]"
         ]
    writeInner Integer
_ VS (r val)
curr Space
_ = [VS (r val) -> VS (r val) -> MS (r stmt)
forall {k} (r :: k -> *) (stmt :: k) (val :: k).
PrintFile r stmt val =>
VS (r val) -> VS (r val) -> MS (r stmt)
printFile VS (r val)
out VS (r val)
curr]