{-# LANGUAGE PostfixOperators, Rank2Types #-}
{-# OPTIONS_GHC -Wno-redundant-constraints #-}
{-# LANGUAGE FlexibleContexts #-}
module Language.Drasil.Code.Imperative.Import (codeType, spaceCodeType,
  publicFunc, publicFuncProc, privateMethod, privateFuncProc, publicInOutFunc,
  publicInOutFuncProc, privateInOutMethod, privateInOutFuncProc, genConstructor,
  mkVar, mkVarProc, mkVal, mkValProc, convExpr, convExprProc, convStmt,
  convStmtProc, genModDef, genModDefProc, genModFuncs, genModFuncsProc,
  genModClasses, readData, readDataProc, renderC
) where

import Prelude hiding (sin, cos, tan, log, exp)
import Control.Lens ((^.))
import qualified Data.Map as Map (lookup)
import Control.Monad (liftM2,liftM3)
import Control.Monad.State (get, modify)
import Data.List ((\\), intersect)

import Drasil.Code.CodeExpr (sy, ($<), ($>), ($<=), ($>=), ($&&), in')
import Drasil.Code.CodeVar (CodeIdea(codeName), CodeVarChunk, obv, quantvar,
  quantfunc, DefiningCodeExpr(..))
import qualified Drasil.Code.CodeExpr.Development as S (CodeExpr(..))
import Drasil.Code.CodeExpr.Development (CodeExpr(..), ArithBinOp(..),
  AssocArithOper(..), AssocBoolOper(..), AssocConcatOper(..), EqBinOp(..),
  LABinOp(..), OrdBinOp(..), UFunc(..), UFuncB(..), UFuncVV(..), UFuncVN(..),
  VVNBinOp(..), VVVBinOp(..), NVVBinOp(..), ESSBinOp(..), ESBBinOp(..))
import Drasil.Database (UID, HasUID(..), IsChunk)
import Language.Drasil (HasSymbol, HasSpace(..),
  Space (Rational, Real), RealInterval(..), Constraint(..), Inclusive (..))
import Language.Drasil.Code.Imperative.Comments (getCommentBrief)
import Language.Drasil.Code.Imperative.ConceptMatch (conceptToGOOL)
import Language.Drasil.Code.Imperative.GenerateGOOL (auxClass, fApp, fAppProc,
  ctorCall, genModuleWithImports, genModuleWithImportsProc, primaryClass)
import Language.Drasil.Code.Imperative.Helpers (convScope)
import Language.Drasil.Code.Imperative.Logging (logBody)
import Language.Drasil.Code.Imperative.DrasilState (GenState, DrasilState(..),
  ScopeType(..), genICName, lookupC, HasChoices(..))
import Language.Drasil.Chunk.Code (ccObjVar)
import Language.Drasil.Chunk.Parameter (ParameterChunk(..), PassBy(..), pcAuto)
import Language.Drasil.Code.CodeQuantityDicts (inFileName, inParams, consts)
import Language.Drasil.Choices (Comments(..), ConstantRepr(..),
  ConstantStructure(..), Structure(..), InternalConcept(..))
import Language.Drasil.CodeSpec (HasCodeSpec(..))
import Language.Drasil.Code.DataDesc (DataItem, LinePattern(Repeat, Straight),
  Data(Line, Lines, JunkData, Singleton), DataDesc, isLine, isLines, getInputs,
  getPatternInputs)
import Language.Drasil.Literal.Development
import Language.Drasil.Mod (Func(..), FuncData(..), FuncDef(..), FuncStmt(..),
  Mod(..), Name, Description, StateVariable(..), fstdecl)
import qualified Language.Drasil.Mod as M (Class(..))
import Language.Drasil.Printers (showHasSymbImpl)

import Drasil.GOOL (Label, File, Body, Block, SVariable, SValue, Class,
  CSStateVar, NamedArgs, Initializers, SharedProg, OOProg, CS, FS, MS, VS,
  AttachmentSym(..), bodyStatements, BlockSym(..), TypeSym(..), VariableSym(..),
  VariableElim(..), VariableValue(..), ScopeSym(..), ScopeData,
  OOVariableSym(..), SelfSym(..), instanceVarSelf, VariableElim(..), ($->),
  ValueSym(..), Literal(..), VariableValue(..), NumericExpression(..),
  BooleanExpression(..), Comparison(..), ValueExpression(..),
  OOValueExpression(..), objMethodCallMixedArgs, Reference(..), Array(..),
  List(..), StatementSym(..), AssignStatement(..), DeclStatement(..),
  IOStatement(..), StringStatement(..), ControlStatement(..), ifNoElse,
  VisibilitySym(..), ParameterSym(..), MethodSym(..), OOMethodSym(..), pubDVar,
  privDVar, nonInitConstructor, convType, convTypeOO, VisibilityTag(..),
  CodeType(..), onStateValue, TypeData, ParamData, SharedStatement, TypeElim,
  OODeclStatement, OOVariableValue, OOStatement)
import qualified Drasil.GOOL as S (Set(..)) -- TODO [Brandon Bosman, 07/09/2026]: Merge this with OO
import qualified Drasil.GOOL as C (CodeType(List, Array))
import Drasil.GProc (ProcProg, NativeVector(..))
import Drasil.System (systemdb)

-- | Gets a chunk's 'CodeType', by checking which 'CodeType' the user has chosen to
-- match the chunk's 'Space' to.
codeType :: (HasSpace c) => c -> GenState CodeType
codeType :: forall c. HasSpace c => c -> StateT DrasilState Identity CodeType
codeType c
c = Space -> StateT DrasilState Identity CodeType
spaceCodeType (c
c c -> Getting Space c Space -> Space
forall s a. s -> Getting a s a -> a
^. Getting Space c Space
forall c. HasSpace c => Getter c Space
Getter c Space
typ)

-- | Gets the 'CodeType' for a 'Space', based on the user's choice.
spaceCodeType :: Space -> GenState CodeType
spaceCodeType :: Space -> StateT DrasilState Identity CodeType
spaceCodeType Space
s = do
  DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  (DrasilState
g DrasilState
-> Getting
     (Space -> StateT DrasilState Identity CodeType)
     DrasilState
     (Space -> StateT DrasilState Identity CodeType)
-> Space
-> StateT DrasilState Identity CodeType
forall s a. s -> Getting a s a -> a
^. Getting
  (Space -> StateT DrasilState Identity CodeType)
  DrasilState
  (Space -> StateT DrasilState Identity CodeType)
forall a.
HasChoices a =>
Lens' a (Space -> StateT DrasilState Identity CodeType)
Lens' DrasilState (Space -> StateT DrasilState Identity CodeType)
spaceMatches) Space
s

-- | If 'UID' for the variable is matched to a concept, call 'conceptToGOOL' to get
-- the GOOL code for the concept, and return.
-- If 'UID' is for a constant and user has chosen 'Inline', convert the constant's
-- defining 'Expr' to a value with 'convExpr'.
-- Otherwise, just a regular variable: construct it by calling the variable, then
-- call 'valueOf' to reference its value.
value
  :: (OOStatement r smt, TypeElim r, VariableElim r)
  => UID -> Name -> VS (r TypeData) -> GenState (SValue r)
value :: forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
UID -> Name -> VS (r TypeData) -> GenState (SValue r)
value UID
u Name
s VS (r TypeData)
t = do
  DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  let cs :: DrasilState
cs = DrasilState
g
      mm :: ConstantMap
mm = DrasilState
cs DrasilState
-> Getting ConstantMap DrasilState ConstantMap -> ConstantMap
forall s a. s -> Getting a s a -> a
^. Getting ConstantMap DrasilState ConstantMap
forall c. HasCodeSpec c => Lens' c ConstantMap
Lens' DrasilState ConstantMap
constMap
      constDef :: Maybe CodeDefinition
constDef = do
        CodeDefinition
cd <- UID -> ConstantMap -> Maybe CodeDefinition
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup UID
u ConstantMap
mm
        ConstantStructure -> CodeDefinition -> Maybe CodeDefinition
forall {a}. ConstantStructure -> a -> Maybe a
maybeInline (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) CodeDefinition
cd
      maybeInline :: ConstantStructure -> a -> Maybe a
maybeInline ConstantStructure
Inline a
m = a -> Maybe a
forall a. a -> Maybe a
Just a
m
      maybeInline ConstantStructure
_ a
_ = Maybe a
forall a. Maybe a
Nothing
      cm :: MatchedConceptMap
cm = DrasilState
g DrasilState
-> Getting MatchedConceptMap DrasilState MatchedConceptMap
-> MatchedConceptMap
forall s a. s -> Getting a s a -> a
^. Getting MatchedConceptMap DrasilState MatchedConceptMap
forall a. HasChoices a => Lens' a MatchedConceptMap
Lens' DrasilState MatchedConceptMap
concMatches
      cdCncpt :: Maybe CodeConcept
cdCncpt = UID -> MatchedConceptMap -> Maybe CodeConcept
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup UID
u MatchedConceptMap
cm
  SValue r
val <- GenState (SValue r)
-> (CodeDefinition -> GenState (SValue r))
-> Maybe CodeDefinition
-> GenState (SValue r)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (SVariable r -> SValue r
forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
valueOf (SVariable r -> SValue r)
-> StateT DrasilState Identity (SVariable r) -> GenState (SValue r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name
-> VS (r TypeData) -> StateT DrasilState Identity (SVariable r)
forall (r :: * -> *).
(SelfSym r, VariableElim r, VariableValue r) =>
Name -> VS (r TypeData) -> GenState (SVariable r)
variable Name
s VS (r TypeData)
t) (CodeExpr -> GenState (SValue r)
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr (CodeExpr -> GenState (SValue r))
-> (CodeDefinition -> CodeExpr)
-> CodeDefinition
-> GenState (SValue r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CodeDefinition
-> Getting CodeExpr CodeDefinition CodeExpr -> CodeExpr
forall s a. s -> Getting a s a -> a
^. Getting CodeExpr CodeDefinition CodeExpr
forall c. DefiningCodeExpr c => Lens' c CodeExpr
Lens' CodeDefinition CodeExpr
codeExpr)) Maybe CodeDefinition
constDef
  SValue r -> GenState (SValue r)
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (SValue r -> GenState (SValue r))
-> SValue r -> GenState (SValue r)
forall a b. (a -> b) -> a -> b
$ SValue r
-> (CodeConcept -> SValue r) -> Maybe CodeConcept -> SValue r
forall b a. b -> (a -> b) -> Maybe a -> b
maybe SValue r
val CodeConcept -> SValue r
forall (r :: * -> *). MathConstant r => CodeConcept -> SValue r
conceptToGOOL Maybe CodeConcept
cdCncpt

-- | If variable is an input, construct it with 'var' and pass to inputVariable.
-- If variable is a constant and 'Var' constant representation is chosen,
-- construct it with 'var' and pass to 'constVariable'.
-- If variable is a constant and 'Const' constant representation is chosen,
-- construct it with 'classConst' and pass to 'constVariable'.
-- If variable is neither, just construct it with 'var' and return it.
variable :: (SelfSym r, VariableElim r, VariableValue r) => Name ->
  VS (r TypeData) -> GenState (SVariable r)
variable :: forall (r :: * -> *).
(SelfSym r, VariableElim r, VariableValue r) =>
Name -> VS (r TypeData) -> GenState (SVariable r)
variable Name
s VS (r TypeData)
t = do
  DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  let cs :: DrasilState
cs = DrasilState
g
      defFunc :: ConstantRepr -> Name -> VS (r TypeData) -> SVariable r
defFunc ConstantRepr
Var = Name -> VS (r TypeData) -> SVariable r
forall (r :: * -> *).
VariableSym r =>
Name -> VS (r TypeData) -> SVariable r
var
      defFunc ConstantRepr
Const = Name -> VS (r TypeData) -> SVariable r
forall (r :: * -> *).
OOVariableSym r =>
Name -> VS (r TypeData) -> SVariable r
classConst
  if Name
s Name -> [Name] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (Input -> Name) -> [Input] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map Input -> Name
forall c. CodeIdea c => c -> Name
codeName (DrasilState
cs 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)
    then Structure -> ConstantRepr -> SVariable r -> GenState (SVariable r)
forall (r :: * -> *).
(SelfSym r, VariableElim r, VariableValue r) =>
Structure -> ConstantRepr -> SVariable r -> GenState (SVariable r)
inputVariable (DrasilState
g DrasilState -> Getting Structure DrasilState Structure -> Structure
forall s a. s -> Getting a s a -> a
^. Getting Structure DrasilState Structure
forall a. HasChoices a => Lens' a Structure
Lens' DrasilState Structure
inStruct) ConstantRepr
Var (Name -> VS (r TypeData) -> SVariable r
forall (r :: * -> *).
VariableSym r =>
Name -> VS (r TypeData) -> SVariable r
var Name
s VS (r TypeData)
t)
    else if Name
s Name -> [Name] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (CodeDefinition -> Name) -> [CodeDefinition] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map CodeDefinition -> Name
forall c. CodeIdea c => c -> Name
codeName (DrasilState
cs DrasilState
-> Getting [CodeDefinition] DrasilState [CodeDefinition]
-> [CodeDefinition]
forall s a. s -> Getting a s a -> a
^. Getting [CodeDefinition] DrasilState [CodeDefinition]
forall c. HasCodeSpec c => Lens' c [CodeDefinition]
Lens' DrasilState [CodeDefinition]
constDefns)
      then ConstantStructure
-> ConstantRepr -> SVariable r -> GenState (SVariable r)
forall (r :: * -> *).
(SelfSym r, VariableElim r, VariableValue r) =>
ConstantStructure
-> ConstantRepr -> SVariable r -> GenState (SVariable r)
constVariable (DrasilState
g DrasilState
-> Getting ConstantStructure DrasilState ConstantStructure
-> ConstantStructure
forall s a. s -> Getting a s a -> a
^. Getting ConstantStructure DrasilState ConstantStructure
forall a. HasChoices a => Lens' a ConstantStructure
Lens' DrasilState ConstantStructure
conStruct) (DrasilState
g DrasilState
-> Getting 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)
              ((ConstantRepr -> Name -> VS (r TypeData) -> SVariable r
forall {r :: * -> *}.
OOVariableSym r =>
ConstantRepr -> Name -> VS (r TypeData) -> SVariable r
defFunc (ConstantRepr -> Name -> VS (r TypeData) -> SVariable r)
-> ConstantRepr -> Name -> VS (r TypeData) -> SVariable r
forall a b. (a -> b) -> a -> b
$ 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) Name
s VS (r TypeData)
t)
      else SVariable r -> GenState (SVariable r)
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (SVariable r -> GenState (SVariable r))
-> SVariable r -> GenState (SVariable r)
forall a b. (a -> b) -> a -> b
$ Name -> VS (r TypeData) -> SVariable r
forall (r :: * -> *).
VariableSym r =>
Name -> VS (r TypeData) -> SVariable r
var Name
s VS (r TypeData)
t

-- | If 'Unbundled' inputs, just return variable as-is.
-- If 'Bundled' inputs, access variable through object, where the object is self
-- if current module is InputParameters, 'inParams' otherwise.
-- Final case is for when 'constVariable' calls inputVariable, when user chooses
-- WithInputs for constant structure, inputs are 'Bundled', and constant
-- representation is 'Const'. Variable should be accessed through class, so
-- 'classVariable' is called.
inputVariable :: (SelfSym r, VariableElim r, VariableValue r) =>
  Structure -> ConstantRepr -> SVariable r -> GenState (SVariable r)
inputVariable :: forall (r :: * -> *).
(SelfSym r, VariableElim r, VariableValue r) =>
Structure -> ConstantRepr -> SVariable r -> GenState (SVariable r)
inputVariable Structure
Unbundled ConstantRepr
_ SVariable r
v = SVariable r -> StateT DrasilState Identity (SVariable r)
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return SVariable r
v
inputVariable Structure
Bundled ConstantRepr
Var SVariable r
v = do
  DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  Name
inClsName <- InternalConcept -> GenState Name
genICName InternalConcept
InputParameters
  SVariable r
ip <- Input -> StateT DrasilState Identity (SVariable r)
forall (r :: * -> *).
(SelfSym r, VariableElim r, VariableValue r) =>
Input -> GenState (SVariable r)
mkVar (DefinedQuantityDict -> Input
forall c. (Quantity c, MayHaveUnit c, Concept c) => c -> Input
quantvar DefinedQuantityDict
inParams)
  SVariable r -> StateT DrasilState Identity (SVariable r)
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (SVariable r -> StateT DrasilState Identity (SVariable r))
-> SVariable r -> StateT DrasilState Identity (SVariable r)
forall a b. (a -> b) -> a -> b
$ if DrasilState -> Name
currentClass DrasilState
g Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
inClsName then SVariable r -> SVariable r
forall (r :: * -> *).
(SelfSym r, VariableValue r) =>
SVariable r -> SVariable r
instanceVarSelf SVariable r
v else SVariable r -> SValue r
forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
valueOf SVariable r
ip SValue r -> SVariable r -> SVariable r
forall (r :: * -> *).
OOVariableSym r =>
SValue r -> SVariable r -> SVariable r
$-> SVariable r
v
inputVariable Structure
Bundled ConstantRepr
Const SVariable r
v = do
  SVariable r
ip <- Input -> StateT DrasilState Identity (SVariable r)
forall (r :: * -> *).
(SelfSym r, VariableElim r, VariableValue r) =>
Input -> GenState (SVariable r)
mkVar (DefinedQuantityDict -> Input
forall c. (Quantity c, MayHaveUnit c, Concept c) => c -> Input
quantvar DefinedQuantityDict
inParams)
  SVariable r
-> SVariable r -> StateT DrasilState Identity (SVariable r)
forall (r :: * -> *).
(OOVariableSym r, VariableElim r) =>
SVariable r -> SVariable r -> GenState (SVariable r)
classVariable SVariable r
ip SVariable r
v

-- | If 'Unbundled' constants, just return variable as-is.
-- If 'Bundled' constants and 'Var' constant representation, access variable
-- through 'consts' object.
-- If 'Bundled' constants and 'Const' constant representation, access variable
-- through class, so call 'classVariable'.
-- If constants stored 'WithInputs', call 'inputVariable'.
-- If constants are 'Inline'd, the generator should not be attempting to make a
-- variable for one of the constants.
constVariable :: (SelfSym r, VariableElim r, VariableValue r) =>
  ConstantStructure -> ConstantRepr -> SVariable r -> GenState (SVariable r)
constVariable :: forall (r :: * -> *).
(SelfSym r, VariableElim r, VariableValue r) =>
ConstantStructure
-> ConstantRepr -> SVariable r -> GenState (SVariable r)
constVariable (Store Structure
Unbundled) ConstantRepr
_ SVariable r
v = SVariable r -> StateT DrasilState Identity (SVariable r)
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return SVariable r
v
constVariable (Store Structure
Bundled) ConstantRepr
Var SVariable r
v = do
  SVariable r
cs <- Input -> StateT DrasilState Identity (SVariable r)
forall (r :: * -> *).
(SelfSym r, VariableElim r, VariableValue r) =>
Input -> GenState (SVariable r)
mkVar (DefinedQuantityDict -> Input
forall c. (Quantity c, MayHaveUnit c, Concept c) => c -> Input
quantvar DefinedQuantityDict
consts)
  SVariable r -> StateT DrasilState Identity (SVariable r)
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (SVariable r -> StateT DrasilState Identity (SVariable r))
-> SVariable r -> StateT DrasilState Identity (SVariable r)
forall a b. (a -> b) -> a -> b
$ SVariable r -> SValue r
forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
valueOf SVariable r
cs SValue r -> SVariable r -> SVariable r
forall (r :: * -> *).
OOVariableSym r =>
SValue r -> SVariable r -> SVariable r
$-> SVariable r
v
constVariable (Store Structure
Bundled) ConstantRepr
Const SVariable r
v = do
  SVariable r
cs <- Input -> StateT DrasilState Identity (SVariable r)
forall (r :: * -> *).
(SelfSym r, VariableElim r, VariableValue r) =>
Input -> GenState (SVariable r)
mkVar (DefinedQuantityDict -> Input
forall c. (Quantity c, MayHaveUnit c, Concept c) => c -> Input
quantvar DefinedQuantityDict
consts)
  SVariable r
-> SVariable r -> StateT DrasilState Identity (SVariable r)
forall (r :: * -> *).
(OOVariableSym r, VariableElim r) =>
SVariable r -> SVariable r -> GenState (SVariable r)
classVariable SVariable r
cs SVariable r
v
constVariable ConstantStructure
WithInputs ConstantRepr
cr SVariable r
v = do
  DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  Structure
-> ConstantRepr
-> SVariable r
-> StateT DrasilState Identity (SVariable r)
forall (r :: * -> *).
(SelfSym r, VariableElim r, VariableValue r) =>
Structure -> ConstantRepr -> SVariable r -> GenState (SVariable r)
inputVariable (DrasilState
g DrasilState -> Getting Structure DrasilState Structure -> Structure
forall s a. s -> Getting a s a -> a
^. Getting Structure DrasilState Structure
forall a. HasChoices a => Lens' a Structure
Lens' DrasilState Structure
inStruct) ConstantRepr
cr SVariable r
v
constVariable ConstantStructure
Inline ConstantRepr
_ SVariable r
_ = Name -> StateT DrasilState Identity (SVariable r)
forall a. HasCallStack => Name -> a
error (Name -> StateT DrasilState Identity (SVariable r))
-> Name -> StateT DrasilState Identity (SVariable r)
forall a b. (a -> b) -> a -> b
$ Name
"mkVar called on a constant, but user " Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++
  Name
"chose to Inline constants. Generator has a bug."

-- | For generating GOOL for a variable that is accessed through a class.
-- If the variable is not in the export map, then it is not a public class variable
-- and cannot be accessed, so throw an error.
-- If the variable is exported by the current module, use 'classVarAccess'.
-- If the variable is exported by a different module, use 'extClassVarAccess'.
classVariable :: (OOVariableSym r, VariableElim r) => SVariable r ->
  SVariable r -> GenState (SVariable r)
classVariable :: forall (r :: * -> *).
(OOVariableSym r, VariableElim r) =>
SVariable r -> SVariable r -> GenState (SVariable r)
classVariable SVariable r
c SVariable r
v = do
  DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  let checkCurrent :: Name -> VS (r TypeData) -> SVariable r -> SVariable r
checkCurrent Name
m = if DrasilState -> Name
currentModule DrasilState
g Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
m then VS (r TypeData) -> SVariable r -> SVariable r
forall (r :: * -> *).
OOVariableSym r =>
VS (r TypeData) -> SVariable r -> SVariable r
classVarAccess else VS (r TypeData) -> SVariable r -> SVariable r
forall (r :: * -> *).
OOVariableSym r =>
VS (r TypeData) -> SVariable r -> SVariable r
extClassVarAccess
  SVariable r -> GenState (SVariable r)
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (SVariable r -> GenState (SVariable r))
-> SVariable r -> GenState (SVariable r)
forall a b. (a -> b) -> a -> b
$ do
    r Variable
v' <- SVariable r
v
    let nm :: Name
nm = r Variable -> Name
forall (r :: * -> *). VariableElim r => r Variable -> Name
variableName r Variable
v'
    (VS (r TypeData) -> SVariable r -> SVariable r)
-> (Name -> VS (r TypeData) -> SVariable r -> SVariable r)
-> Maybe Name
-> VS (r TypeData)
-> SVariable r
-> SVariable r
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Name -> VS (r TypeData) -> SVariable r -> SVariable r
forall a. HasCallStack => Name -> a
error (Name -> VS (r TypeData) -> SVariable r -> SVariable r)
-> Name -> VS (r TypeData) -> SVariable r -> SVariable r
forall a b. (a -> b) -> a -> b
$ Name
"Variable " Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Name
nm Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Name
" missing from export map")
      Name -> VS (r TypeData) -> SVariable r -> SVariable r
forall {r :: * -> *}.
OOVariableSym r =>
Name -> VS (r TypeData) -> SVariable r -> SVariable r
checkCurrent (Name -> Map Name Name -> Maybe Name
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
nm (DrasilState -> Map Name Name
eMap DrasilState
g)) ((r Variable -> r TypeData) -> SVariable r -> VS (r TypeData)
forall a b s. (a -> b) -> State s a -> State s b
onStateValue r Variable -> r TypeData
forall (r :: * -> *). VariableElim r => r Variable -> r TypeData
variableType SVariable r
c) SVariable r
v

-- | Generates a GOOL Value for a variable represented by a 'CodeVarChunk'.
mkVal
  :: (OOStatement r smt, TypeElim r, VariableElim r)
  => CodeVarChunk -> GenState (SValue r)
mkVal :: forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
Input -> GenState (SValue r)
mkVal Input
v = do
  CodeType
t <- Input -> StateT DrasilState Identity CodeType
forall c. HasSpace c => c -> StateT DrasilState Identity CodeType
codeType Input
v
  let toGOOLVal :: Maybe c -> GenState (SValue r)
toGOOLVal Maybe c
Nothing = UID -> Name -> VS (r TypeData) -> GenState (SValue r)
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
UID -> Name -> VS (r TypeData) -> GenState (SValue r)
value (Input
v 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) (Input -> Name
forall c. CodeIdea c => c -> Name
codeName Input
v) (CodeType -> VS (r TypeData)
forall (r :: * -> *). OOTypeSym r => CodeType -> VS (r TypeData)
convTypeOO CodeType
t)
      toGOOLVal (Just c
o) = do
        CodeType
ot <- c -> StateT DrasilState Identity CodeType
forall c. HasSpace c => c -> StateT DrasilState Identity CodeType
codeType c
o
        SValue r -> GenState (SValue r)
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (SValue r -> GenState (SValue r))
-> SValue r -> GenState (SValue r)
forall a b. (a -> b) -> a -> b
$ SVariable r -> SValue r
forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
valueOf (SVariable r -> SValue r) -> SVariable r -> SValue r
forall a b. (a -> b) -> a -> b
$ SValue r -> SVariable r -> SVariable r
forall (r :: * -> *).
OOVariableSym r =>
SValue r -> SVariable r -> SVariable r
instanceVarAccess (SVariable r -> SValue r
forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
valueOf (SVariable r -> SValue r) -> SVariable r -> SValue r
forall a b. (a -> b) -> a -> b
$ Name -> VS (r TypeData) -> SVariable r
forall (r :: * -> *).
VariableSym r =>
Name -> VS (r TypeData) -> SVariable r
var (c -> Name
forall c. CodeIdea c => c -> Name
codeName c
o) (CodeType -> VS (r TypeData)
forall (r :: * -> *). OOTypeSym r => CodeType -> VS (r TypeData)
convTypeOO CodeType
ot))
          (Name -> VS (r TypeData) -> SVariable r
forall (r :: * -> *).
VariableSym r =>
Name -> VS (r TypeData) -> SVariable r
var (Input -> Name
forall c. CodeIdea c => c -> Name
codeName Input
v) (CodeType -> VS (r TypeData)
forall (r :: * -> *). OOTypeSym r => CodeType -> VS (r TypeData)
convTypeOO CodeType
t))
  Maybe CodeChunk -> GenState (SValue r)
forall {r :: * -> *} {smt} {c}.
(OOStatement r smt, TypeElim r, VariableElim r, HasSpace c,
 CodeIdea c) =>
Maybe c -> GenState (SValue r)
toGOOLVal (Input
v Input
-> Getting (Maybe CodeChunk) Input (Maybe CodeChunk)
-> Maybe CodeChunk
forall s a. s -> Getting a s a -> a
^. Getting (Maybe CodeChunk) Input (Maybe CodeChunk)
Lens' Input (Maybe CodeChunk)
obv)

-- | Generates a GOOL Variable for a variable represented by a 'CodeVarChunk'.
mkVar :: (SelfSym r, VariableElim r, VariableValue r) =>
  CodeVarChunk -> GenState (SVariable r)
mkVar :: forall (r :: * -> *).
(SelfSym r, VariableElim r, VariableValue r) =>
Input -> GenState (SVariable r)
mkVar Input
v = do
  CodeType
t <- Input -> StateT DrasilState Identity CodeType
forall c. HasSpace c => c -> StateT DrasilState Identity CodeType
codeType Input
v
  let toGOOLVar :: Maybe c -> GenState (SVariable r)
toGOOLVar Maybe c
Nothing = Name -> VS (r TypeData) -> GenState (SVariable r)
forall (r :: * -> *).
(SelfSym r, VariableElim r, VariableValue r) =>
Name -> VS (r TypeData) -> GenState (SVariable r)
variable (Input -> Name
forall c. CodeIdea c => c -> Name
codeName Input
v) (CodeType -> VS (r TypeData)
forall (r :: * -> *). OOTypeSym r => CodeType -> VS (r TypeData)
convTypeOO CodeType
t)
      toGOOLVar (Just c
o) = do
        CodeType
ot <- c -> StateT DrasilState Identity CodeType
forall c. HasSpace c => c -> StateT DrasilState Identity CodeType
codeType c
o
        SVariable r -> GenState (SVariable r)
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (SVariable r -> GenState (SVariable r))
-> SVariable r -> GenState (SVariable r)
forall a b. (a -> b) -> a -> b
$ SValue r -> SVariable r -> SVariable r
forall (r :: * -> *).
OOVariableSym r =>
SValue r -> SVariable r -> SVariable r
instanceVarAccess (SVariable r -> SValue r
forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
valueOf (SVariable r -> SValue r) -> SVariable r -> SValue r
forall a b. (a -> b) -> a -> b
$ Name -> VS (r TypeData) -> SVariable r
forall (r :: * -> *).
VariableSym r =>
Name -> VS (r TypeData) -> SVariable r
var (c -> Name
forall c. CodeIdea c => c -> Name
codeName c
o) (CodeType -> VS (r TypeData)
forall (r :: * -> *). OOTypeSym r => CodeType -> VS (r TypeData)
convTypeOO CodeType
ot))
          (Name -> VS (r TypeData) -> SVariable r
forall (r :: * -> *).
VariableSym r =>
Name -> VS (r TypeData) -> SVariable r
var (Input -> Name
forall c. CodeIdea c => c -> Name
codeName Input
v) (CodeType -> VS (r TypeData)
forall (r :: * -> *). OOTypeSym r => CodeType -> VS (r TypeData)
convTypeOO CodeType
t))
  Maybe CodeChunk -> GenState (SVariable r)
forall {r :: * -> *} {c}.
(SelfSym r, VariableElim r, VariableValue r, HasSpace c,
 CodeIdea c) =>
Maybe c -> GenState (SVariable r)
toGOOLVar (Input
v Input
-> Getting (Maybe CodeChunk) Input (Maybe CodeChunk)
-> Maybe CodeChunk
forall s a. s -> Getting a s a -> a
^. Getting (Maybe CodeChunk) Input (Maybe CodeChunk)
Lens' Input (Maybe CodeChunk)
obv)

-- | Generates a GOOL Parameter for a parameter represented by a 'ParameterChunk'.
mkParam
  :: (OOStatement r smt, VariableElim r)
  => ParameterChunk -> GenState (MS (r ParamData))
mkParam :: forall (r :: * -> *) smt.
(OOStatement r smt, VariableElim r) =>
ParameterChunk -> GenState (MS (r ParamData))
mkParam ParameterChunk
p = do
  SVariable r
v <- Input -> GenState (SVariable r)
forall (r :: * -> *).
(SelfSym r, VariableElim r, VariableValue r) =>
Input -> GenState (SVariable r)
mkVar (ParameterChunk -> Input
forall c. (Quantity c, MayHaveUnit c, Concept c) => c -> Input
quantvar ParameterChunk
p)
  MS (r ParamData) -> GenState (MS (r ParamData))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (MS (r ParamData) -> GenState (MS (r ParamData)))
-> MS (r ParamData) -> GenState (MS (r ParamData))
forall a b. (a -> b) -> a -> b
$ PassBy -> SVariable r -> MS (r ParamData)
forall {r :: * -> *}.
ParameterSym r =>
PassBy -> SVariable r -> MS (r ParamData)
paramFunc (ParameterChunk -> PassBy
passBy ParameterChunk
p) SVariable r
v
  where paramFunc :: PassBy -> SVariable r -> MS (r ParamData)
paramFunc PassBy
Ref = SVariable r -> MS (r ParamData)
forall (r :: * -> *).
ParameterSym r =>
SVariable r -> MS (r ParamData)
pointerParam
        paramFunc PassBy
Val = SVariable r -> MS (r ParamData)
forall (r :: * -> *).
ParameterSym r =>
SVariable r -> MS (r ParamData)
param

-- | Generates a public function.
publicFunc
  :: (OOProg r vis smt md svr att prg)
  => Label
  -> VS (r TypeData)
  -> Description
  -> [ParameterChunk]
  -> Maybe Description
  -> [MS (r Block)]
  -> GenState (MS (r md))
publicFunc :: forall (r :: * -> *) vis smt md svr att prg.
OOProg r vis smt md svr att prg =>
Name
-> VS (r TypeData)
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MS (r Block)]
-> GenState (MS (r md))
publicFunc Name
n VS (r TypeData)
t Name
desc [ParameterChunk]
ps Maybe Name
r [MS (r Block)]
b = do
  (DrasilState -> DrasilState) -> StateT DrasilState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\DrasilState
st -> DrasilState
st {currentScope = Local})
  ([MS (r ParamData)] -> MS (r Block) -> MS (r md))
-> Name
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MS (r Block)]
-> GenState (MS (r md))
forall (r :: * -> *) vis smt md svr att prg.
OOProg r vis smt md svr att prg =>
([MS (r ParamData)] -> MS (r Block) -> MS (r md))
-> Name
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MS (r Block)]
-> GenState (MS (r md))
genMethod (Name
-> r vis
-> VS (r TypeData)
-> [MS (r ParamData)]
-> MS (r Block)
-> MS (r md)
forall (r :: * -> *) vis smt md.
MethodSym r vis smt md =>
Name
-> r vis
-> VS (r TypeData)
-> [MS (r ParamData)]
-> MS (r Block)
-> MS (r md)
function Name
n r vis
forall (r :: * -> *) vis. VisibilitySym r vis => r vis
public VS (r TypeData)
t) Name
n Name
desc [ParameterChunk]
ps Maybe Name
r [MS (r Block)]
b

-- | Generates a public method.
publicMethod
  :: (OOProg r vis smt md svr att prg)
  => Label
  -> VS (r TypeData)
  -> Description
  -> [ParameterChunk]
  -> Maybe Description
  -> [MS (r Block)]
  -> GenState (MS (r md))
publicMethod :: forall (r :: * -> *) vis smt md svr att prg.
OOProg r vis smt md svr att prg =>
Name
-> VS (r TypeData)
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MS (r Block)]
-> GenState (MS (r md))
publicMethod Name
n VS (r TypeData)
t = do
  ([MS (r ParamData)] -> MS (r Block) -> MS (r md))
-> Name
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MS (r Block)]
-> GenState (MS (r md))
forall (r :: * -> *) vis smt md svr att prg.
OOProg r vis smt md svr att prg =>
([MS (r ParamData)] -> MS (r Block) -> MS (r md))
-> Name
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MS (r Block)]
-> GenState (MS (r md))
genMethod (Name
-> r vis
-> r att
-> VS (r TypeData)
-> [MS (r ParamData)]
-> MS (r Block)
-> MS (r md)
forall (r :: * -> *) vis smt md att.
OOMethodSym r vis smt md att =>
Name
-> r vis
-> r att
-> VS (r TypeData)
-> [MS (r ParamData)]
-> MS (r Block)
-> MS (r md)
method Name
n r vis
forall (r :: * -> *) vis. VisibilitySym r vis => r vis
public r att
forall (r :: * -> *) att. AttachmentSym r att => r att
instanceLevel VS (r TypeData)
t) Name
n

-- | Generates a private method.
privateMethod :: (OOProg r vis smt md svr att prg) => Label -> VS (r TypeData) -> Description ->
  [ParameterChunk] -> Maybe Description -> [MS (r Block)] ->
  GenState (MS (r md))
privateMethod :: forall (r :: * -> *) vis smt md svr att prg.
OOProg r vis smt md svr att prg =>
Name
-> VS (r TypeData)
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MS (r Block)]
-> GenState (MS (r md))
privateMethod Name
n VS (r TypeData)
t = do
  ([MS (r ParamData)] -> MS (r Block) -> MS (r md))
-> Name
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MS (r Block)]
-> GenState (MS (r md))
forall (r :: * -> *) vis smt md svr att prg.
OOProg r vis smt md svr att prg =>
([MS (r ParamData)] -> MS (r Block) -> MS (r md))
-> Name
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MS (r Block)]
-> GenState (MS (r md))
genMethod (Name
-> r vis
-> r att
-> VS (r TypeData)
-> [MS (r ParamData)]
-> MS (r Block)
-> MS (r md)
forall (r :: * -> *) vis smt md att.
OOMethodSym r vis smt md att =>
Name
-> r vis
-> r att
-> VS (r TypeData)
-> [MS (r ParamData)]
-> MS (r Block)
-> MS (r md)
method Name
n r vis
forall (r :: * -> *) vis. VisibilitySym r vis => r vis
private r att
forall (r :: * -> *) att. AttachmentSym r att => r att
instanceLevel VS (r TypeData)
t) Name
n

-- | Generates a public function, defined by its inputs and outputs.
publicInOutFunc :: (OOProg r vis smt md svr att prg) => Label -> Description -> [CodeVarChunk] ->
  [CodeVarChunk] -> [MS (r Block)] -> GenState (MS (r md))
publicInOutFunc :: forall (r :: * -> *) vis smt md svr att prg.
OOProg r vis smt md svr att prg =>
Name
-> Name
-> [Input]
-> [Input]
-> [MS (r Block)]
-> GenState (MS (r md))
publicInOutFunc Name
n = ([SVariable r]
 -> [SVariable r] -> [SVariable r] -> MS (r Block) -> MS (r md))
-> (Name
    -> [(Name, SVariable r)]
    -> [(Name, SVariable r)]
    -> [(Name, SVariable r)]
    -> MS (r Block)
    -> MS (r md))
-> Name
-> Name
-> [Input]
-> [Input]
-> [MS (r Block)]
-> GenState (MS (r md))
forall (r :: * -> *) smt md.
(OOStatement r smt, VariableElim r) =>
([SVariable r]
 -> [SVariable r] -> [SVariable r] -> MS (r Block) -> MS (r md))
-> (Name
    -> [(Name, SVariable r)]
    -> [(Name, SVariable r)]
    -> [(Name, SVariable r)]
    -> MS (r Block)
    -> MS (r md))
-> Name
-> Name
-> [Input]
-> [Input]
-> [MS (r Block)]
-> GenState (MS (r md))
genInOutFunc (Name
-> r vis
-> [SVariable r]
-> [SVariable r]
-> [SVariable r]
-> MS (r Block)
-> MS (r md)
forall (r :: * -> *) vis smt md.
MethodSym r vis smt md =>
Name -> r vis -> InOutFunc r md
inOutFunc Name
n r vis
forall (r :: * -> *) vis. VisibilitySym r vis => r vis
public) (Name
-> r vis
-> Name
-> [(Name, SVariable r)]
-> [(Name, SVariable r)]
-> [(Name, SVariable r)]
-> MS (r Block)
-> MS (r md)
forall (r :: * -> *) vis smt md.
MethodSym r vis smt md =>
Name -> r vis -> DocInOutFunc r md
docInOutFunc Name
n r vis
forall (r :: * -> *) vis. VisibilitySym r vis => r vis
public) Name
n

-- | Generates a private method, defined by its inputs and outputs.
privateInOutMethod :: (OOProg r vis smt md svr att prg) => Label -> Description -> [CodeVarChunk] ->
  [CodeVarChunk] -> [MS (r Block)] -> GenState (MS (r md))
privateInOutMethod :: forall (r :: * -> *) vis smt md svr att prg.
OOProg r vis smt md svr att prg =>
Name
-> Name
-> [Input]
-> [Input]
-> [MS (r Block)]
-> GenState (MS (r md))
privateInOutMethod Name
n = ([SVariable r]
 -> [SVariable r] -> [SVariable r] -> MS (r Block) -> MS (r md))
-> (Name
    -> [(Name, SVariable r)]
    -> [(Name, SVariable r)]
    -> [(Name, SVariable r)]
    -> MS (r Block)
    -> MS (r md))
-> Name
-> Name
-> [Input]
-> [Input]
-> [MS (r Block)]
-> GenState (MS (r md))
forall (r :: * -> *) smt md.
(OOStatement r smt, VariableElim r) =>
([SVariable r]
 -> [SVariable r] -> [SVariable r] -> MS (r Block) -> MS (r md))
-> (Name
    -> [(Name, SVariable r)]
    -> [(Name, SVariable r)]
    -> [(Name, SVariable r)]
    -> MS (r Block)
    -> MS (r md))
-> Name
-> Name
-> [Input]
-> [Input]
-> [MS (r Block)]
-> GenState (MS (r md))
genInOutFunc (Name
-> r vis
-> r att
-> [SVariable r]
-> [SVariable r]
-> [SVariable r]
-> MS (r Block)
-> MS (r md)
forall (r :: * -> *) vis smt md att.
OOMethodSym r vis smt md att =>
Name -> r vis -> r att -> InOutFunc r md
inOutMethod Name
n r vis
forall (r :: * -> *) vis. VisibilitySym r vis => r vis
private r att
forall (r :: * -> *) att. AttachmentSym r att => r att
instanceLevel)
  (Name
-> r vis
-> r att
-> Name
-> [(Name, SVariable r)]
-> [(Name, SVariable r)]
-> [(Name, SVariable r)]
-> MS (r Block)
-> MS (r md)
forall (r :: * -> *) vis smt md att.
OOMethodSym r vis smt md att =>
Name -> r vis -> r att -> DocInOutFunc r md
docInOutMethod Name
n r vis
forall (r :: * -> *) vis. VisibilitySym r vis => r vis
private r att
forall (r :: * -> *) att. AttachmentSym r att => r att
instanceLevel) Name
n

-- | Generates a constructor.
genConstructor :: (OOProg r vis smt md svr att prg) => Label -> Description -> [ParameterChunk] ->
  [MS (r Block)] -> GenState (MS (r md))
genConstructor :: forall (r :: * -> *) vis smt md svr att prg.
OOProg r vis smt md svr att prg =>
Name
-> Name
-> [ParameterChunk]
-> [MS (r Block)]
-> GenState (MS (r md))
genConstructor Name
n Name
desc [ParameterChunk]
p = do
  ([MS (r ParamData)] -> MS (r Block) -> MS (r md))
-> Name
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MS (r Block)]
-> GenState (MS (r md))
forall (r :: * -> *) vis smt md svr att prg.
OOProg r vis smt md svr att prg =>
([MS (r ParamData)] -> MS (r Block) -> MS (r md))
-> Name
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MS (r Block)]
-> GenState (MS (r md))
genMethod [MS (r ParamData)] -> MS (r Block) -> MS (r md)
forall (r :: * -> *) vis smt md att.
OOMethodSym r vis smt md att =>
[MS (r ParamData)] -> MS (r Block) -> MS (r md)
nonInitConstructor Name
n Name
desc [ParameterChunk]
p Maybe Name
forall a. Maybe a
Nothing

-- | Generates a constructor that includes initialization of variables.
genInitConstructor :: (OOProg r vis smt md svr att prg) => Label -> Description -> [ParameterChunk]
  -> Initializers r -> [MS (r Block)] -> GenState (MS (r md))
genInitConstructor :: forall (r :: * -> *) vis smt md svr att prg.
OOProg r vis smt md svr att prg =>
Name
-> Name
-> [ParameterChunk]
-> Initializers r
-> [MS (r Block)]
-> GenState (MS (r md))
genInitConstructor Name
n Name
desc [ParameterChunk]
p Initializers r
is = ([MS (r ParamData)] -> MS (r Block) -> MS (r md))
-> Name
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MS (r Block)]
-> GenState (MS (r md))
forall (r :: * -> *) vis smt md svr att prg.
OOProg r vis smt md svr att prg =>
([MS (r ParamData)] -> MS (r Block) -> MS (r md))
-> Name
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MS (r Block)]
-> GenState (MS (r md))
genMethod ([MS (r ParamData)] -> Initializers r -> MS (r Block) -> MS (r md)
forall (r :: * -> *) vis smt md att.
OOMethodSym r vis smt md att =>
[MS (r ParamData)] -> Initializers r -> MS (r Block) -> MS (r md)
`constructor` Initializers r
is) Name
n Name
desc [ParameterChunk]
p
  Maybe Name
forall a. Maybe a
Nothing

-- | Generates a function or method using the passed GOOL constructor. Other
-- parameters are the method's name, description, list of parameters,
-- description of what is returned (if applicable), and body.
genMethod
  :: (OOProg r vis smt md svr att prg)
  => ([MS (r ParamData)] -> MS (r Body) -> MS (r md))
  -> Label
  -> Description
  -> [ParameterChunk]
  -> Maybe Description
  -> [MS (r Block)]
  -> GenState (MS (r md))
genMethod :: forall (r :: * -> *) vis smt md svr att prg.
OOProg r vis smt md svr att prg =>
([MS (r ParamData)] -> MS (r Block) -> MS (r md))
-> Name
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MS (r Block)]
-> GenState (MS (r md))
genMethod [MS (r ParamData)] -> MS (r Block) -> MS (r md)
f Name
n Name
desc [ParameterChunk]
p Maybe Name
r [MS (r Block)]
b = do
  DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  [SVariable r]
vars <- (ParameterChunk -> StateT DrasilState Identity (SVariable r))
-> [ParameterChunk] -> StateT DrasilState Identity [SVariable r]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Input -> StateT DrasilState Identity (SVariable r)
forall (r :: * -> *).
(SelfSym r, VariableElim r, VariableValue r) =>
Input -> GenState (SVariable r)
mkVar (Input -> StateT DrasilState Identity (SVariable r))
-> (ParameterChunk -> Input)
-> ParameterChunk
-> StateT DrasilState Identity (SVariable r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParameterChunk -> Input
forall c. (Quantity c, MayHaveUnit c, Concept c) => c -> Input
quantvar) [ParameterChunk]
p
  [MS (r ParamData)]
ps <- (ParameterChunk -> StateT DrasilState Identity (MS (r ParamData)))
-> [ParameterChunk]
-> StateT DrasilState Identity [MS (r ParamData)]
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 ParameterChunk -> StateT DrasilState Identity (MS (r ParamData))
forall (r :: * -> *) smt.
(OOStatement r smt, VariableElim r) =>
ParameterChunk -> GenState (MS (r ParamData))
mkParam [ParameterChunk]
p
  MS (r Block)
bod <- Name -> [SVariable r] -> [MS (r Block)] -> GenState (MS (r Block))
forall (r :: * -> *) smt.
(SharedStatement r smt, VariableElim r) =>
Name -> [SVariable r] -> [MS (r Block)] -> GenState (MS (r Block))
logBody Name
n [SVariable r]
vars [MS (r Block)]
b
  let fn :: MS (r md)
fn = [MS (r ParamData)] -> MS (r Block) -> MS (r md)
f [MS (r ParamData)]
ps MS (r Block)
bod
  [Name]
pComms <- (ParameterChunk -> GenState Name)
-> [ParameterChunk] -> StateT DrasilState Identity [Name]
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 ParameterChunk -> GenState Name
forall c. CodeIdea c => c -> GenState Name
getCommentBrief [ParameterChunk]
p
  MS (r md) -> GenState (MS (r md))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (MS (r md) -> GenState (MS (r md)))
-> MS (r md) -> GenState (MS (r md))
forall a b. (a -> b) -> a -> b
$ if Comments
CommentFunc Comments -> [Comments] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` DrasilState
g DrasilState
-> Getting [Comments] DrasilState [Comments] -> [Comments]
forall s a. s -> Getting a s a -> a
^. Getting [Comments] DrasilState [Comments]
forall a. HasChoices a => Lens' a [Comments]
Lens' DrasilState [Comments]
commented
    then Name -> [Name] -> Maybe Name -> MS (r md) -> MS (r md)
forall (r :: * -> *) vis smt md.
MethodSym r vis smt md =>
Name -> [Name] -> Maybe Name -> MS (r md) -> MS (r md)
docFunc Name
desc [Name]
pComms Maybe Name
r MS (r md)
fn else MS (r md)
fn

-- | Generates a function or method defined by its inputs and outputs.
-- Parameters are: the GOOL constructor to use, the equivalent GOOL constructor
-- for a documented function/method, the visibility, attachment, name, description,
-- list of inputs, list of outputs, and body.
genInOutFunc
  :: (OOStatement r smt, VariableElim r)
  => ([SVariable r] -> [SVariable r] -> [SVariable r] -> MS (r Body) -> MS (r md))
  -> (String -> [(String, SVariable r)] -> [(String, SVariable r)] -> [(String, SVariable r)] -> MS (r Body) -> MS (r md))
  -> Label
  -> Description
  -> [CodeVarChunk]
  -> [CodeVarChunk]
  -> [MS (r Block)]
  -> GenState (MS (r md))
genInOutFunc :: forall (r :: * -> *) smt md.
(OOStatement r smt, VariableElim r) =>
([SVariable r]
 -> [SVariable r] -> [SVariable r] -> MS (r Block) -> MS (r md))
-> (Name
    -> [(Name, SVariable r)]
    -> [(Name, SVariable r)]
    -> [(Name, SVariable r)]
    -> MS (r Block)
    -> MS (r md))
-> Name
-> Name
-> [Input]
-> [Input]
-> [MS (r Block)]
-> GenState (MS (r md))
genInOutFunc [SVariable r]
-> [SVariable r] -> [SVariable r] -> MS (r Block) -> MS (r md)
f Name
-> [(Name, SVariable r)]
-> [(Name, SVariable r)]
-> [(Name, SVariable r)]
-> MS (r Block)
-> MS (r md)
docf Name
n Name
desc [Input]
ins' [Input]
outs' [MS (r Block)]
b = do
  DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  (DrasilState -> DrasilState) -> StateT DrasilState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\DrasilState
st -> DrasilState
st {currentScope = Local})
  let ins :: [Input]
ins = [Input]
ins' [Input] -> [Input] -> [Input]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Input]
outs'
      outs :: [Input]
outs = [Input]
outs' [Input] -> [Input] -> [Input]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Input]
ins'
      both :: [Input]
both = [Input]
ins' [Input] -> [Input] -> [Input]
forall a. Eq a => [a] -> [a] -> [a]
`intersect` [Input]
outs'
  [SVariable r]
inVs <- (Input -> StateT DrasilState Identity (SVariable r))
-> [Input] -> StateT DrasilState Identity [SVariable r]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Input -> StateT DrasilState Identity (SVariable r)
forall (r :: * -> *).
(SelfSym r, VariableElim r, VariableValue r) =>
Input -> GenState (SVariable r)
mkVar [Input]
ins
  [SVariable r]
outVs <- (Input -> StateT DrasilState Identity (SVariable r))
-> [Input] -> StateT DrasilState Identity [SVariable r]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Input -> StateT DrasilState Identity (SVariable r)
forall (r :: * -> *).
(SelfSym r, VariableElim r, VariableValue r) =>
Input -> GenState (SVariable r)
mkVar [Input]
outs
  [SVariable r]
bothVs <- (Input -> StateT DrasilState Identity (SVariable r))
-> [Input] -> StateT DrasilState Identity [SVariable r]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Input -> StateT DrasilState Identity (SVariable r)
forall (r :: * -> *).
(SelfSym r, VariableElim r, VariableValue r) =>
Input -> GenState (SVariable r)
mkVar [Input]
both
  MS (r Block)
bod <- Name -> [SVariable r] -> [MS (r Block)] -> GenState (MS (r Block))
forall (r :: * -> *) smt.
(SharedStatement r smt, VariableElim r) =>
Name -> [SVariable r] -> [MS (r Block)] -> GenState (MS (r Block))
logBody Name
n ([SVariable r]
bothVs [SVariable r] -> [SVariable r] -> [SVariable r]
forall a. [a] -> [a] -> [a]
++ [SVariable r]
inVs) [MS (r Block)]
b
  [Name]
pComms <- (Input -> GenState Name)
-> [Input] -> StateT DrasilState Identity [Name]
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 Name
forall c. CodeIdea c => c -> GenState Name
getCommentBrief [Input]
ins
  [Name]
oComms <- (Input -> GenState Name)
-> [Input] -> StateT DrasilState Identity [Name]
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 Name
forall c. CodeIdea c => c -> GenState Name
getCommentBrief [Input]
outs
  [Name]
bComms <- (Input -> GenState Name)
-> [Input] -> StateT DrasilState Identity [Name]
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 Name
forall c. CodeIdea c => c -> GenState Name
getCommentBrief [Input]
both
  MS (r md) -> GenState (MS (r md))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (MS (r md) -> GenState (MS (r md)))
-> MS (r md) -> GenState (MS (r md))
forall a b. (a -> b) -> a -> b
$ if Comments
CommentFunc Comments -> [Comments] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` DrasilState
g DrasilState
-> Getting [Comments] DrasilState [Comments] -> [Comments]
forall s a. s -> Getting a s a -> a
^. Getting [Comments] DrasilState [Comments]
forall a. HasChoices a => Lens' a [Comments]
Lens' DrasilState [Comments]
commented
    then Name
-> [(Name, SVariable r)]
-> [(Name, SVariable r)]
-> [(Name, SVariable r)]
-> MS (r Block)
-> MS (r md)
docf Name
desc ([Name] -> [SVariable r] -> [(Name, SVariable r)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Name]
pComms [SVariable r]
inVs) ([Name] -> [SVariable r] -> [(Name, SVariable r)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Name]
oComms [SVariable r]
outVs) ([Name] -> [SVariable r] -> [(Name, SVariable r)]
forall a b. [a] -> [b] -> [(a, b)]
zip
    [Name]
bComms [SVariable r]
bothVs) MS (r Block)
bod else [SVariable r]
-> [SVariable r] -> [SVariable r] -> MS (r Block) -> MS (r md)
f [SVariable r]
inVs [SVariable r]
outVs [SVariable r]
bothVs MS (r Block)
bod

-- | Converts an 'Expr' to a GOOL Value.
convExpr
  :: (OOStatement r smt, TypeElim r, VariableElim r)
  => CodeExpr -> GenState (SValue r)
convExpr :: forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr (Lit (Dbl Double
d)) = do
  CodeType
sm <- Space -> StateT DrasilState Identity CodeType
spaceCodeType Space
Real
  let getLiteral :: CodeType -> SValue r
getLiteral CodeType
Double = Double -> SValue r
forall (r :: * -> *). Literal r => Double -> SValue r
litDouble Double
d
      getLiteral CodeType
Float = Float -> SValue r
forall (r :: * -> *). Literal r => Float -> SValue r
litFloat (Double -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
d)
      getLiteral CodeType
_ = Name -> SValue r
forall a. HasCallStack => Name -> a
error Name
"convExpr: Real space matched to invalid CodeType; should be Double or Float"
  SValue r -> GenState (SValue r)
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (SValue r -> GenState (SValue r))
-> SValue r -> GenState (SValue r)
forall a b. (a -> b) -> a -> b
$ CodeType -> SValue r
forall {r :: * -> *}. Literal r => CodeType -> SValue r
getLiteral CodeType
sm
convExpr (Lit (ExactDbl Integer
d)) = CodeExpr -> GenState (SValue r)
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr (CodeExpr -> GenState (SValue r))
-> CodeExpr -> GenState (SValue r)
forall a b. (a -> b) -> a -> b
$ Literal -> CodeExpr
Lit (Literal -> CodeExpr) -> (Double -> Literal) -> Double -> CodeExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Literal
Dbl (Double -> CodeExpr) -> Double -> CodeExpr
forall a b. (a -> b) -> a -> b
$ Integer -> Double
forall a. Num a => Integer -> a
fromInteger Integer
d
convExpr (Lit (Int Integer
i))      = SValue r -> GenState (SValue r)
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (SValue r -> GenState (SValue r))
-> SValue r -> GenState (SValue r)
forall a b. (a -> b) -> a -> b
$ Integer -> SValue r
forall (r :: * -> *). Literal r => Integer -> SValue r
litInt Integer
i
convExpr (Lit (Str Name
s))      = SValue r -> GenState (SValue r)
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (SValue r -> GenState (SValue r))
-> SValue r -> GenState (SValue r)
forall a b. (a -> b) -> a -> b
$ Name -> SValue r
forall (r :: * -> *). Literal r => Name -> SValue r
litString Name
s
convExpr (Lit (Perc Integer
a Integer
b)) = do
  CodeType
sm <- Space -> StateT DrasilState Identity CodeType
spaceCodeType Space
Rational
  let getLiteral :: CodeType -> Double -> SValue r
getLiteral CodeType
Double = Double -> SValue r
forall (r :: * -> *). Literal r => Double -> SValue r
litDouble
      getLiteral CodeType
Float = Float -> SValue r
forall (r :: * -> *). Literal r => Float -> SValue r
litFloat (Float -> SValue r) -> (Double -> Float) -> Double -> SValue r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac
      getLiteral CodeType
_ = Name -> Double -> SValue r
forall a. HasCallStack => Name -> a
error Name
"convExpr: Rational space matched to invalid CodeType; should be Double or Float"
  SValue r -> GenState (SValue r)
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (SValue r -> GenState (SValue r))
-> SValue r -> GenState (SValue r)
forall a b. (a -> b) -> a -> b
$ CodeType -> Double -> SValue r
forall {r :: * -> *}. Literal r => CodeType -> Double -> SValue r
getLiteral CodeType
sm (Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
a Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
10 Double -> Double -> Double
forall a. Floating a => a -> a -> a
** Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
b))
convExpr (AssocA AssocArithOper
Add [CodeExpr]
l) = (SValue r -> SValue r -> SValue r) -> [SValue r] -> SValue r
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 SValue r -> SValue r -> SValue r
forall (r :: * -> *).
NumericExpression r =>
SValue r -> SValue r -> SValue r
(#+)  ([SValue r] -> SValue r)
-> StateT DrasilState Identity [SValue r] -> GenState (SValue r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CodeExpr -> GenState (SValue r))
-> [CodeExpr] -> StateT DrasilState Identity [SValue r]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM CodeExpr -> GenState (SValue r)
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr [CodeExpr]
l
convExpr (AssocA AssocArithOper
Mul [CodeExpr]
l) = (SValue r -> SValue r -> SValue r) -> [SValue r] -> SValue r
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 SValue r -> SValue r -> SValue r
forall (r :: * -> *).
NumericExpression r =>
SValue r -> SValue r -> SValue r
(#*)  ([SValue r] -> SValue r)
-> StateT DrasilState Identity [SValue r] -> GenState (SValue r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CodeExpr -> GenState (SValue r))
-> [CodeExpr] -> StateT DrasilState Identity [SValue r]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM CodeExpr -> GenState (SValue r)
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr [CodeExpr]
l
convExpr (AssocB AssocBoolOper
And [CodeExpr]
l) = (SValue r -> SValue r -> SValue r) -> [SValue r] -> SValue r
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 SValue r -> SValue r -> SValue r
forall (r :: * -> *).
BooleanExpression r =>
SValue r -> SValue r -> SValue r
(?&&) ([SValue r] -> SValue r)
-> StateT DrasilState Identity [SValue r] -> GenState (SValue r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CodeExpr -> GenState (SValue r))
-> [CodeExpr] -> StateT DrasilState Identity [SValue r]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM CodeExpr -> GenState (SValue r)
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr [CodeExpr]
l
convExpr (AssocB AssocBoolOper
Or [CodeExpr]
l)  = (SValue r -> SValue r -> SValue r) -> [SValue r] -> SValue r
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 SValue r -> SValue r -> SValue r
forall (r :: * -> *).
BooleanExpression r =>
SValue r -> SValue r -> SValue r
(?||) ([SValue r] -> SValue r)
-> StateT DrasilState Identity [SValue r] -> GenState (SValue r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CodeExpr -> GenState (SValue r))
-> [CodeExpr] -> StateT DrasilState Identity [SValue r]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM CodeExpr -> GenState (SValue r)
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr [CodeExpr]
l
convExpr (AssocC AssocConcatOper
SUnion [CodeExpr]
l)  = (SValue r -> SValue r -> SValue r) -> [SValue r] -> SValue r
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 SValue r -> SValue r -> SValue r
forall (r :: * -> *).
NumericExpression r =>
SValue r -> SValue r -> SValue r
(#+) ([SValue r] -> SValue r)
-> StateT DrasilState Identity [SValue r] -> GenState (SValue r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CodeExpr -> GenState (SValue r))
-> [CodeExpr] -> StateT DrasilState Identity [SValue r]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM CodeExpr -> GenState (SValue r)
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr [CodeExpr]
l
convExpr (C UID
c)   = do
  DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  let v :: Input
v = DefinedQuantityDict -> Input
forall c. (Quantity c, MayHaveUnit c, Concept c) => c -> Input
quantvar (DrasilState -> UID -> DefinedQuantityDict
lookupC DrasilState
g UID
c)
  Input -> GenState (SValue r)
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
Input -> GenState (SValue r)
mkVal Input
v
convExpr (FCall UID
c [CodeExpr]
x [(UID, CodeExpr)]
ns) = UID
-> [CodeExpr]
-> [(UID, CodeExpr)]
-> (Name
    -> Name
    -> VS (r TypeData)
    -> [SValue r]
    -> NamedArgs r
    -> GenState (SValue r))
-> (Name
    -> Name
    -> VS (r TypeData)
    -> [SValue r]
    -> NamedArgs r
    -> SValue r)
-> GenState (SValue r)
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
UID
-> [CodeExpr]
-> [(UID, CodeExpr)]
-> (Name
    -> Name
    -> VS (r TypeData)
    -> [SValue r]
    -> NamedArgs r
    -> GenState (SValue r))
-> (Name
    -> Name
    -> VS (r TypeData)
    -> [SValue r]
    -> NamedArgs r
    -> SValue r)
-> GenState (SValue r)
convCall UID
c [CodeExpr]
x [(UID, CodeExpr)]
ns Name
-> Name
-> VS (r TypeData)
-> [SValue r]
-> NamedArgs r
-> GenState (SValue r)
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r) =>
Name
-> Name
-> VS (r TypeData)
-> [SValue r]
-> NamedArgs r
-> GenState (SValue r)
fApp Name
-> Name -> VS (r TypeData) -> [SValue r] -> NamedArgs r -> SValue r
forall (r :: * -> *). ValueExpression r => Name -> MixedCall r
libFuncAppMixedArgs
convExpr (New UID
c [CodeExpr]
x [(UID, CodeExpr)]
ns) = UID
-> [CodeExpr]
-> [(UID, CodeExpr)]
-> (Name
    -> Name
    -> VS (r TypeData)
    -> [SValue r]
    -> NamedArgs r
    -> GenState (SValue r))
-> (Name
    -> Name
    -> VS (r TypeData)
    -> [SValue r]
    -> NamedArgs r
    -> SValue r)
-> GenState (SValue r)
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
UID
-> [CodeExpr]
-> [(UID, CodeExpr)]
-> (Name
    -> Name
    -> VS (r TypeData)
    -> [SValue r]
    -> NamedArgs r
    -> GenState (SValue r))
-> (Name
    -> Name
    -> VS (r TypeData)
    -> [SValue r]
    -> NamedArgs r
    -> SValue r)
-> GenState (SValue r)
convCall UID
c [CodeExpr]
x [(UID, CodeExpr)]
ns (\Name
m Name
_ -> Name
-> VS (r TypeData)
-> [SValue r]
-> NamedArgs r
-> GenState (SValue r)
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r) =>
Name
-> VS (r TypeData)
-> [SValue r]
-> NamedArgs r
-> GenState (SValue r)
ctorCall Name
m)
  (\Name
m Name
_ -> Name -> VS (r TypeData) -> [SValue r] -> NamedArgs r -> SValue r
forall (r :: * -> *).
OOValueExpression r =>
Name -> MixedCtorCall r
libNewObjMixedArgs Name
m)
convExpr (Message UID
a UID
m [CodeExpr]
x [(UID, CodeExpr)]
ns) = do
  DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  let objCd :: Input
objCd = DefinedQuantityDict -> Input
forall c. (Quantity c, MayHaveUnit c, Concept c) => c -> Input
quantvar (DrasilState -> UID -> DefinedQuantityDict
lookupC DrasilState
g UID
a)
  SValue r
o <- Input -> GenState (SValue r)
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
Input -> GenState (SValue r)
mkVal Input
objCd
  UID
-> [CodeExpr]
-> [(UID, CodeExpr)]
-> (Name
    -> Name
    -> VS (r TypeData)
    -> [SValue r]
    -> NamedArgs r
    -> GenState (SValue r))
-> (Name
    -> Name
    -> VS (r TypeData)
    -> [SValue r]
    -> NamedArgs r
    -> SValue r)
-> GenState (SValue r)
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
UID
-> [CodeExpr]
-> [(UID, CodeExpr)]
-> (Name
    -> Name
    -> VS (r TypeData)
    -> [SValue r]
    -> NamedArgs r
    -> GenState (SValue r))
-> (Name
    -> Name
    -> VS (r TypeData)
    -> [SValue r]
    -> NamedArgs r
    -> SValue r)
-> GenState (SValue r)
convCall UID
m [CodeExpr]
x [(UID, CodeExpr)]
ns
    (\Name
_ Name
n VS (r TypeData)
t [SValue r]
ps NamedArgs r
nas -> SValue r -> GenState (SValue r)
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (VS (r TypeData)
-> SValue r -> Name -> [SValue r] -> NamedArgs r -> SValue r
forall (r :: * -> *).
InternalValueExp r =>
VS (r TypeData)
-> SValue r -> Name -> [SValue r] -> NamedArgs r -> SValue r
objMethodCallMixedArgs VS (r TypeData)
t SValue r
o Name
n [SValue r]
ps NamedArgs r
nas))
    (\Name
_ Name
n VS (r TypeData)
t -> VS (r TypeData)
-> SValue r -> Name -> [SValue r] -> NamedArgs r -> SValue r
forall (r :: * -> *).
InternalValueExp r =>
VS (r TypeData)
-> SValue r -> Name -> [SValue r] -> NamedArgs r -> SValue r
objMethodCallMixedArgs VS (r TypeData)
t SValue r
o Name
n)
convExpr (Field UID
o UID
f) = do
  DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  let ob :: Input
ob  = DefinedQuantityDict -> Input
forall c. (Quantity c, MayHaveUnit c, Concept c) => c -> Input
quantvar (DrasilState -> UID -> DefinedQuantityDict
lookupC DrasilState
g UID
o)
      fld :: Input
fld = DefinedQuantityDict -> Input
forall c. (Quantity c, MayHaveUnit c, Concept c) => c -> Input
quantvar (DrasilState -> UID -> DefinedQuantityDict
lookupC DrasilState
g UID
f)
  SVariable r
v <- Input -> GenState (SVariable r)
forall (r :: * -> *).
(SelfSym r, VariableElim r, VariableValue r) =>
Input -> GenState (SVariable r)
mkVar (Input -> Input -> Input
ccObjVar Input
ob Input
fld)
  SValue r -> GenState (SValue r)
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (SValue r -> GenState (SValue r))
-> SValue r -> GenState (SValue r)
forall a b. (a -> b) -> a -> b
$ SVariable r -> SValue r
forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
valueOf SVariable r
v
convExpr (UnaryOp UFunc
o CodeExpr
u)    = (SValue r -> SValue r)
-> GenState (SValue r) -> GenState (SValue r)
forall a b.
(a -> b)
-> StateT DrasilState Identity a -> StateT DrasilState Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (UFunc -> SValue r -> SValue r
forall (r :: * -> *).
(NumericExpression r, Reference r) =>
UFunc -> SValue r -> SValue r
unop UFunc
o) (CodeExpr -> GenState (SValue r)
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr CodeExpr
u)
convExpr (UnaryOpB UFuncB
o CodeExpr
u)   = (SValue r -> SValue r)
-> GenState (SValue r) -> GenState (SValue r)
forall a b.
(a -> b)
-> StateT DrasilState Identity a -> StateT DrasilState Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (UFuncB -> SValue r -> SValue r
forall (r :: * -> *).
BooleanExpression r =>
UFuncB -> SValue r -> SValue r
unopB UFuncB
o) (CodeExpr -> GenState (SValue r)
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr CodeExpr
u)
convExpr (UnaryOpVV UFuncVV
o CodeExpr
u)  = (SValue r -> SValue r)
-> GenState (SValue r) -> GenState (SValue r)
forall a b.
(a -> b)
-> StateT DrasilState Identity a -> StateT DrasilState Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (UFuncVV -> SValue r -> SValue r
forall (r :: * -> *). ValueSym r => UFuncVV -> SValue r -> SValue r
unopVV UFuncVV
o) (CodeExpr -> GenState (SValue r)
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr CodeExpr
u)
convExpr (UnaryOpVN UFuncVN
o CodeExpr
u)  = (SValue r -> SValue r)
-> GenState (SValue r) -> GenState (SValue r)
forall a b.
(a -> b)
-> StateT DrasilState Identity a -> StateT DrasilState Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (UFuncVN -> SValue r -> SValue r
forall (r :: * -> *) smt.
List r smt =>
UFuncVN -> SValue r -> SValue r
unopVN UFuncVN
o) (CodeExpr -> GenState (SValue r)
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr CodeExpr
u)
convExpr (ArithBinaryOp ArithBinOp
Frac (Lit (Int Integer
a)) (Lit (Int Integer
b))) = do -- hack to deal with integer division
  CodeType
sm <- Space -> StateT DrasilState Identity CodeType
spaceCodeType Space
Rational
  let getLiteral :: CodeType -> SValue r
getLiteral CodeType
Double = Double -> SValue r
forall (r :: * -> *). Literal r => Double -> SValue r
litDouble (Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
a) SValue r -> SValue r -> SValue r
forall (r :: * -> *).
NumericExpression r =>
SValue r -> SValue r -> SValue r
#/ Double -> SValue r
forall (r :: * -> *). Literal r => Double -> SValue r
litDouble (Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
b)
      getLiteral CodeType
Float = Float -> SValue r
forall (r :: * -> *). Literal r => Float -> SValue r
litFloat (Integer -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
a) SValue r -> SValue r -> SValue r
forall (r :: * -> *).
NumericExpression r =>
SValue r -> SValue r -> SValue r
#/ Float -> SValue r
forall (r :: * -> *). Literal r => Float -> SValue r
litFloat (Integer -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
b)
      getLiteral CodeType
_ = Name -> SValue r
forall a. HasCallStack => Name -> a
error Name
"convExpr: Rational space matched to invalid CodeType; should be Double or Float"
  SValue r -> GenState (SValue r)
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (SValue r -> GenState (SValue r))
-> SValue r -> GenState (SValue r)
forall a b. (a -> b) -> a -> b
$ CodeType -> SValue r
forall {r :: * -> *}.
(NumericExpression r, Literal r) =>
CodeType -> SValue r
getLiteral CodeType
sm
convExpr (ArithBinaryOp ArithBinOp
o CodeExpr
a CodeExpr
b) = (SValue r -> SValue r -> SValue r)
-> GenState (SValue r)
-> GenState (SValue r)
-> GenState (SValue r)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (ArithBinOp -> SValue r -> SValue r -> SValue r
forall (r :: * -> *).
NumericExpression r =>
ArithBinOp -> SValue r -> SValue r -> SValue r
arithBfunc ArithBinOp
o) (CodeExpr -> GenState (SValue r)
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr CodeExpr
a) (CodeExpr -> GenState (SValue r)
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr CodeExpr
b)
convExpr (LABinaryOp LABinOp
o CodeExpr
a CodeExpr
b)    = (SValue r -> SValue r -> SValue r)
-> GenState (SValue r)
-> GenState (SValue r)
-> GenState (SValue r)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (LABinOp -> SValue r -> SValue r -> SValue r
forall (r :: * -> *) smt.
List r smt =>
LABinOp -> SValue r -> SValue r -> SValue r
laBfunc LABinOp
o) (CodeExpr -> GenState (SValue r)
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr CodeExpr
a) (CodeExpr -> GenState (SValue r)
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr CodeExpr
b)
convExpr (EqBinaryOp EqBinOp
o CodeExpr
a CodeExpr
b)    = (SValue r -> SValue r -> SValue r)
-> GenState (SValue r)
-> GenState (SValue r)
-> GenState (SValue r)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (EqBinOp -> SValue r -> SValue r -> SValue r
forall (r :: * -> *).
Comparison r =>
EqBinOp -> SValue r -> SValue r -> SValue r
eqBfunc EqBinOp
o) (CodeExpr -> GenState (SValue r)
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr CodeExpr
a) (CodeExpr -> GenState (SValue r)
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr CodeExpr
b)
convExpr (OrdBinaryOp OrdBinOp
o CodeExpr
a CodeExpr
b)   = (SValue r -> SValue r -> SValue r)
-> GenState (SValue r)
-> GenState (SValue r)
-> GenState (SValue r)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (OrdBinOp -> SValue r -> SValue r -> SValue r
forall (r :: * -> *).
Comparison r =>
OrdBinOp -> SValue r -> SValue r -> SValue r
ordBfunc OrdBinOp
o) (CodeExpr -> GenState (SValue r)
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr CodeExpr
a) (CodeExpr -> GenState (SValue r)
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr CodeExpr
b)
convExpr (VVVBinaryOp VVVBinOp
o CodeExpr
a CodeExpr
b)   = (SValue r -> SValue r -> SValue r)
-> GenState (SValue r)
-> GenState (SValue r)
-> GenState (SValue r)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (VVVBinOp -> SValue r -> SValue r -> SValue r
forall (r :: * -> *). VVVBinOp -> SValue r -> SValue r -> SValue r
vecVecVecBfunc VVVBinOp
o) (CodeExpr -> GenState (SValue r)
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr CodeExpr
a) (CodeExpr -> GenState (SValue r)
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr CodeExpr
b)
convExpr (VVNBinaryOp VVNBinOp
o CodeExpr
a CodeExpr
b)   = (SValue r -> SValue r -> SValue r)
-> GenState (SValue r)
-> GenState (SValue r)
-> GenState (SValue r)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (VVNBinOp -> SValue r -> SValue r -> SValue r
forall (r :: * -> *). VVNBinOp -> SValue r -> SValue r -> SValue r
vecVecNumBfunc VVNBinOp
o) (CodeExpr -> GenState (SValue r)
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr CodeExpr
a) (CodeExpr -> GenState (SValue r)
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr CodeExpr
b)
convExpr (NVVBinaryOp NVVBinOp
o CodeExpr
a CodeExpr
b)   = (SValue r -> SValue r -> SValue r)
-> GenState (SValue r)
-> GenState (SValue r)
-> GenState (SValue r)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (NVVBinOp -> SValue r -> SValue r -> SValue r
forall (r :: * -> *). NVVBinOp -> SValue r -> SValue r -> SValue r
numVecVecBfunc NVVBinOp
o) (CodeExpr -> GenState (SValue r)
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr CodeExpr
a) (CodeExpr -> GenState (SValue r)
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr CodeExpr
b)
convExpr (ESSBinaryOp ESSBinOp
o CodeExpr
a CodeExpr
b)   = (SValue r -> SValue r -> SValue r)
-> GenState (SValue r)
-> GenState (SValue r)
-> GenState (SValue r)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (ESSBinOp -> SValue r -> SValue r -> SValue r
forall (r :: * -> *).
Set r =>
ESSBinOp -> SValue r -> SValue r -> SValue r
elementSetSetBfunc ESSBinOp
o) (CodeExpr -> GenState (SValue r)
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr CodeExpr
a) (CodeExpr -> GenState (SValue r)
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr CodeExpr
b)
convExpr (ESBBinaryOp ESBBinOp
o CodeExpr
a CodeExpr
b)   = (SValue r -> SValue r -> SValue r)
-> GenState (SValue r)
-> GenState (SValue r)
-> GenState (SValue r)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (ESBBinOp -> SValue r -> SValue r -> SValue r
forall (r :: * -> *).
Set r =>
ESBBinOp -> SValue r -> SValue r -> SValue r
elementSetBoolBfunc ESBBinOp
o) (CodeExpr -> GenState (SValue r)
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr CodeExpr
a) (CodeExpr -> GenState (SValue r)
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr CodeExpr
b)
convExpr (Case Completeness
c [(CodeExpr, CodeExpr)]
l)            = [(CodeExpr, CodeExpr)] -> GenState (SValue r)
forall {r :: * -> *} {smt}.
(OOStatement r smt, VariableElim r, TypeElim r) =>
[(CodeExpr, CodeExpr)] -> GenState (SValue r)
doit [(CodeExpr, CodeExpr)]
l -- FIXME this is sub-optimal
  where
    doit :: [(CodeExpr, CodeExpr)] -> GenState (SValue r)
doit [] = Name -> GenState (SValue r)
forall a. HasCallStack => Name -> a
error Name
"should never happen" -- TODO: change error message?
    doit [(CodeExpr
e,CodeExpr
_)] = CodeExpr -> GenState (SValue r)
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr CodeExpr
e -- should always be the else clause
    doit ((CodeExpr
e,CodeExpr
cond):[(CodeExpr, CodeExpr)]
xs) = (SValue r -> SValue r -> SValue r -> SValue r)
-> GenState (SValue r)
-> GenState (SValue r)
-> GenState (SValue r)
-> GenState (SValue r)
forall (m :: * -> *) a1 a2 a3 r.
Monad m =>
(a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r
liftM3 SValue r -> SValue r -> SValue r -> SValue r
forall (r :: * -> *).
ValueExpression r =>
SValue r -> SValue r -> SValue r -> SValue r
inlineIf (CodeExpr -> GenState (SValue r)
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr CodeExpr
cond) (CodeExpr -> GenState (SValue r)
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr CodeExpr
e)
      (CodeExpr -> GenState (SValue r)
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr (Completeness -> [(CodeExpr, CodeExpr)] -> CodeExpr
Case Completeness
c [(CodeExpr, CodeExpr)]
xs))
convExpr (Matrix [[CodeExpr]
l]) = do
  [SValue r]
ar <- (CodeExpr -> GenState (SValue r))
-> [CodeExpr] -> StateT DrasilState Identity [SValue r]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM CodeExpr -> GenState (SValue r)
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr [CodeExpr]
l
                                    -- hd will never fail here
  SValue r -> GenState (SValue r)
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (SValue r -> GenState (SValue r))
-> SValue r -> GenState (SValue r)
forall a b. (a -> b) -> a -> b
$ VS (r TypeData) -> [SValue r] -> SValue r
forall (r :: * -> *).
Literal r =>
VS (r TypeData) -> [SValue r] -> SValue r
litArray ((r Value -> r TypeData) -> SValue r -> VS (r TypeData)
forall a b.
(a -> b)
-> StateT ValueState Identity a -> StateT ValueState Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap r Value -> r TypeData
forall (r :: * -> *). ValueSym r => r Value -> r TypeData
valueType ([SValue r] -> SValue r
forall a. HasCallStack => [a] -> a
head [SValue r]
ar)) [SValue r]
ar
convExpr Matrix{} = Name -> GenState (SValue r)
forall a. HasCallStack => Name -> a
error Name
"convExpr: Matrix"
convExpr (S.Set Space
s [CodeExpr]
l) = do
  [SValue r]
ar <- (CodeExpr -> GenState (SValue r))
-> [CodeExpr] -> StateT DrasilState Identity [SValue r]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM CodeExpr -> GenState (SValue r)
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr [CodeExpr]
l
  CodeType
sm <- Space -> StateT DrasilState Identity CodeType
spaceCodeType Space
s
  SValue r -> GenState (SValue r)
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (SValue r -> GenState (SValue r))
-> SValue r -> GenState (SValue r)
forall a b. (a -> b) -> a -> b
$ VS (r TypeData) -> [SValue r] -> SValue r
forall (r :: * -> *).
Literal r =>
VS (r TypeData) -> [SValue r] -> SValue r
litSet (CodeType -> VS (r TypeData)
forall (r :: * -> *). OOTypeSym r => CodeType -> VS (r TypeData)
convTypeOO CodeType
sm) [SValue r]
ar
convExpr(Variable Name
s (S.Set Space
l [CodeExpr]
_)) = do
  CodeType
sm <- Space -> StateT DrasilState Identity CodeType
spaceCodeType Space
l
  let varSet :: SVariable r
varSet = Name -> VS (r TypeData) -> SVariable r
forall (r :: * -> *).
VariableSym r =>
Name -> VS (r TypeData) -> SVariable r
var Name
s (VS (r TypeData) -> VS (r TypeData)
forall (r :: * -> *).
TypeSym r =>
VS (r TypeData) -> VS (r TypeData)
setType (VS (r TypeData) -> VS (r TypeData))
-> VS (r TypeData) -> VS (r TypeData)
forall a b. (a -> b) -> a -> b
$ CodeType -> VS (r TypeData)
forall (r :: * -> *). OOTypeSym r => CodeType -> VS (r TypeData)
convTypeOO CodeType
sm)
  SValue r -> GenState (SValue r)
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (SValue r -> GenState (SValue r))
-> SValue r -> GenState (SValue r)
forall a b. (a -> b) -> a -> b
$ SVariable r -> SValue r
forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
valueOf SVariable r
varSet
convExpr(Variable Name
_ CodeExpr
_) = Name -> GenState (SValue r)
forall a. HasCallStack => Name -> a
error Name
"convExpr: Variable"
convExpr Operator{} = Name -> GenState (SValue r)
forall a. HasCallStack => Name -> a
error Name
"convExpr: Operator"
convExpr (RealI UID
c RealInterval CodeExpr CodeExpr
ri)  = do
  DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  CodeExpr -> GenState (SValue r)
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr (CodeExpr -> GenState (SValue r))
-> CodeExpr -> GenState (SValue r)
forall a b. (a -> b) -> a -> b
$ DefinedQuantityDict -> RealInterval CodeExpr CodeExpr -> CodeExpr
forall c.
(IsChunk c, HasSymbol c) =>
c -> RealInterval CodeExpr CodeExpr -> CodeExpr
renderRealInt (DrasilState -> UID -> DefinedQuantityDict
lookupC DrasilState
g UID
c) RealInterval CodeExpr CodeExpr
ri

-- | Generates a function/method call, based on the 'UID' of the chunk representing
-- the function, the list of argument 'Expr's, the list of named argument 'Expr's,
-- the function call generator to use, and the library version of the function
-- call generator (used if the function is in the library export map).
convCall
  :: (OOStatement r smt, TypeElim r, VariableElim r)
  => UID
  -> [CodeExpr]
  -> [(UID, CodeExpr)]
  -> (Name -> Name -> VS (r TypeData) -> [SValue r] -> NamedArgs r -> GenState (SValue r))
  -> (Name -> Name -> VS (r TypeData) -> [SValue r] -> NamedArgs r -> SValue r)
  -> GenState (SValue r)
convCall :: forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
UID
-> [CodeExpr]
-> [(UID, CodeExpr)]
-> (Name
    -> Name
    -> VS (r TypeData)
    -> [SValue r]
    -> NamedArgs r
    -> GenState (SValue r))
-> (Name
    -> Name
    -> VS (r TypeData)
    -> [SValue r]
    -> NamedArgs r
    -> SValue r)
-> GenState (SValue r)
convCall UID
c [CodeExpr]
x [(UID, CodeExpr)]
ns Name
-> Name
-> VS (r TypeData)
-> [SValue r]
-> NamedArgs r
-> GenState (SValue r)
f Name
-> Name -> VS (r TypeData) -> [SValue r] -> NamedArgs r -> SValue r
libf = do
  DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  let mem :: Map Name Name
mem = DrasilState -> Map Name Name
eMap DrasilState
g
      lem :: Map Name Name
lem = DrasilState -> Map Name Name
libEMap DrasilState
g
      funcCd :: CodeFuncChunk
funcCd = DefinedQuantityDict -> CodeFuncChunk
forall c.
(Quantity c, MayHaveUnit c, Concept c) =>
c -> CodeFuncChunk
quantfunc (DrasilState -> UID -> DefinedQuantityDict
lookupC DrasilState
g UID
c)
      funcNm :: Name
funcNm = CodeFuncChunk -> Name
forall c. CodeIdea c => c -> Name
codeName CodeFuncChunk
funcCd
  CodeType
funcTp <- CodeFuncChunk -> StateT DrasilState Identity CodeType
forall c. HasSpace c => c -> StateT DrasilState Identity CodeType
codeType CodeFuncChunk
funcCd
  [SValue r]
args <- (CodeExpr -> GenState (SValue r))
-> [CodeExpr] -> StateT DrasilState Identity [SValue r]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM CodeExpr -> GenState (SValue r)
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr [CodeExpr]
x
  [SVariable r]
nms <- ((UID, CodeExpr) -> StateT DrasilState Identity (SVariable r))
-> [(UID, CodeExpr)] -> StateT DrasilState Identity [SVariable r]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Input -> StateT DrasilState Identity (SVariable r)
forall (r :: * -> *).
(SelfSym r, VariableElim r, VariableValue r) =>
Input -> GenState (SVariable r)
mkVar (Input -> StateT DrasilState Identity (SVariable r))
-> ((UID, CodeExpr) -> Input)
-> (UID, CodeExpr)
-> StateT DrasilState Identity (SVariable r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DefinedQuantityDict -> Input
forall c. (Quantity c, MayHaveUnit c, Concept c) => c -> Input
quantvar (DefinedQuantityDict -> Input)
-> ((UID, CodeExpr) -> DefinedQuantityDict)
-> (UID, CodeExpr)
-> Input
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DrasilState -> UID -> DefinedQuantityDict
lookupC DrasilState
g (UID -> DefinedQuantityDict)
-> ((UID, CodeExpr) -> UID)
-> (UID, CodeExpr)
-> DefinedQuantityDict
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UID, CodeExpr) -> UID
forall a b. (a, b) -> a
fst) [(UID, CodeExpr)]
ns
  [SValue r]
nargs <- ((UID, CodeExpr) -> GenState (SValue r))
-> [(UID, CodeExpr)] -> StateT DrasilState Identity [SValue r]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (CodeExpr -> GenState (SValue r)
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr (CodeExpr -> GenState (SValue r))
-> ((UID, CodeExpr) -> CodeExpr)
-> (UID, CodeExpr)
-> GenState (SValue r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UID, CodeExpr) -> CodeExpr
forall a b. (a, b) -> b
snd) [(UID, CodeExpr)]
ns
  GenState (SValue r)
-> (Name -> GenState (SValue r))
-> Maybe Name
-> GenState (SValue r)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (GenState (SValue r)
-> (Name -> GenState (SValue r))
-> Maybe Name
-> GenState (SValue r)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Name -> GenState (SValue r)
forall a. HasCallStack => Name -> a
error (Name -> GenState (SValue r)) -> Name -> GenState (SValue r)
forall a b. (a -> b) -> a -> b
$ Name
"Call to non-existent function " Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Name
funcNm)
      (\Name
m -> SValue r -> GenState (SValue r)
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (SValue r -> GenState (SValue r))
-> SValue r -> GenState (SValue r)
forall a b. (a -> b) -> a -> b
$ Name
-> Name -> VS (r TypeData) -> [SValue r] -> NamedArgs r -> SValue r
libf Name
m Name
funcNm (CodeType -> VS (r TypeData)
forall (r :: * -> *). OOTypeSym r => CodeType -> VS (r TypeData)
convTypeOO CodeType
funcTp) [SValue r]
args ([SVariable r] -> [SValue r] -> NamedArgs r
forall a b. [a] -> [b] -> [(a, b)]
zip [SVariable r]
nms [SValue r]
nargs))
      (Name -> Map Name Name -> Maybe Name
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
funcNm Map Name Name
lem))
    (\Name
m -> Name
-> Name
-> VS (r TypeData)
-> [SValue r]
-> NamedArgs r
-> GenState (SValue r)
f Name
m Name
funcNm (CodeType -> VS (r TypeData)
forall (r :: * -> *). OOTypeSym r => CodeType -> VS (r TypeData)
convTypeOO CodeType
funcTp) [SValue r]
args ([SVariable r] -> [SValue r] -> NamedArgs r
forall a b. [a] -> [b] -> [(a, b)]
zip [SVariable r]
nms [SValue r]
nargs))
    (Name -> Map Name Name -> Maybe Name
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
funcNm Map Name Name
mem)

-- | Converts a 'Constraint' to a 'CodeExpr'.
renderC :: (IsChunk c, HasSymbol c) => c -> Constraint CodeExpr -> CodeExpr
renderC :: forall c.
(IsChunk c, HasSymbol c) =>
c -> Constraint CodeExpr -> CodeExpr
renderC c
s (Range ConstraintReason
_ RealInterval CodeExpr CodeExpr
rr)         = c -> RealInterval CodeExpr CodeExpr -> CodeExpr
forall c.
(IsChunk c, HasSymbol c) =>
c -> RealInterval CodeExpr CodeExpr -> CodeExpr
renderRealInt c
s RealInterval CodeExpr CodeExpr
rr
renderC c
s (Elem ConstraintReason
_ CodeExpr
rr)          = c -> CodeExpr -> CodeExpr
forall c. (IsChunk c, HasSymbol c) => c -> CodeExpr -> CodeExpr
renderSet c
s CodeExpr
rr

-- | Converts an interval ('RealInterval') to a 'CodeExpr'.
renderRealInt :: (IsChunk c, HasSymbol c) => c -> RealInterval CodeExpr CodeExpr -> CodeExpr
renderRealInt :: forall c.
(IsChunk c, HasSymbol c) =>
c -> RealInterval CodeExpr CodeExpr -> CodeExpr
renderRealInt c
s (Bounded (Inclusive
Inc, CodeExpr
a) (Inclusive
Inc, CodeExpr
b)) = (CodeExpr
a CodeExpr -> CodeExpr -> CodeExpr
forall r. ExprC r => r -> r -> r
$<= c -> CodeExpr
forall c. (IsChunk c, HasSymbol c) => c -> CodeExpr
forall r c. (ExprC r, IsChunk c, HasSymbol c) => c -> r
sy c
s) CodeExpr -> CodeExpr -> CodeExpr
forall r. ExprC r => r -> r -> r
$&& (c -> CodeExpr
forall c. (IsChunk c, HasSymbol c) => c -> CodeExpr
forall r c. (ExprC r, IsChunk c, HasSymbol c) => c -> r
sy c
s CodeExpr -> CodeExpr -> CodeExpr
forall r. ExprC r => r -> r -> r
$<= CodeExpr
b)
renderRealInt c
s (Bounded (Inclusive
Inc, CodeExpr
a) (Inclusive
Exc, CodeExpr
b)) = (CodeExpr
a CodeExpr -> CodeExpr -> CodeExpr
forall r. ExprC r => r -> r -> r
$<= c -> CodeExpr
forall c. (IsChunk c, HasSymbol c) => c -> CodeExpr
forall r c. (ExprC r, IsChunk c, HasSymbol c) => c -> r
sy c
s) CodeExpr -> CodeExpr -> CodeExpr
forall r. ExprC r => r -> r -> r
$&& (c -> CodeExpr
forall c. (IsChunk c, HasSymbol c) => c -> CodeExpr
forall r c. (ExprC r, IsChunk c, HasSymbol c) => c -> r
sy c
s CodeExpr -> CodeExpr -> CodeExpr
forall r. ExprC r => r -> r -> r
$<  CodeExpr
b)
renderRealInt c
s (Bounded (Inclusive
Exc, CodeExpr
a) (Inclusive
Inc, CodeExpr
b)) = (CodeExpr
a CodeExpr -> CodeExpr -> CodeExpr
forall r. ExprC r => r -> r -> r
$<  c -> CodeExpr
forall c. (IsChunk c, HasSymbol c) => c -> CodeExpr
forall r c. (ExprC r, IsChunk c, HasSymbol c) => c -> r
sy c
s) CodeExpr -> CodeExpr -> CodeExpr
forall r. ExprC r => r -> r -> r
$&& (c -> CodeExpr
forall c. (IsChunk c, HasSymbol c) => c -> CodeExpr
forall r c. (ExprC r, IsChunk c, HasSymbol c) => c -> r
sy c
s CodeExpr -> CodeExpr -> CodeExpr
forall r. ExprC r => r -> r -> r
$<= CodeExpr
b)
renderRealInt c
s (Bounded (Inclusive
Exc, CodeExpr
a) (Inclusive
Exc, CodeExpr
b)) = (CodeExpr
a CodeExpr -> CodeExpr -> CodeExpr
forall r. ExprC r => r -> r -> r
$<  c -> CodeExpr
forall c. (IsChunk c, HasSymbol c) => c -> CodeExpr
forall r c. (ExprC r, IsChunk c, HasSymbol c) => c -> r
sy c
s) CodeExpr -> CodeExpr -> CodeExpr
forall r. ExprC r => r -> r -> r
$&& (c -> CodeExpr
forall c. (IsChunk c, HasSymbol c) => c -> CodeExpr
forall r c. (ExprC r, IsChunk c, HasSymbol c) => c -> r
sy c
s CodeExpr -> CodeExpr -> CodeExpr
forall r. ExprC r => r -> r -> r
$<  CodeExpr
b)
renderRealInt c
s (UpTo    (Inclusive
Inc, CodeExpr
a))          = c -> CodeExpr
forall c. (IsChunk c, HasSymbol c) => c -> CodeExpr
forall r c. (ExprC r, IsChunk c, HasSymbol c) => c -> r
sy c
s CodeExpr -> CodeExpr -> CodeExpr
forall r. ExprC r => r -> r -> r
$<= CodeExpr
a
renderRealInt c
s (UpTo    (Inclusive
Exc, CodeExpr
a))          = c -> CodeExpr
forall c. (IsChunk c, HasSymbol c) => c -> CodeExpr
forall r c. (ExprC r, IsChunk c, HasSymbol c) => c -> r
sy c
s CodeExpr -> CodeExpr -> CodeExpr
forall r. ExprC r => r -> r -> r
$<  CodeExpr
a
renderRealInt c
s (UpFrom  (Inclusive
Inc, CodeExpr
a))          = c -> CodeExpr
forall c. (IsChunk c, HasSymbol c) => c -> CodeExpr
forall r c. (ExprC r, IsChunk c, HasSymbol c) => c -> r
sy c
s CodeExpr -> CodeExpr -> CodeExpr
forall r. ExprC r => r -> r -> r
$>= CodeExpr
a
renderRealInt c
s (UpFrom  (Inclusive
Exc, CodeExpr
a))          = c -> CodeExpr
forall c. (IsChunk c, HasSymbol c) => c -> CodeExpr
forall r c. (ExprC r, IsChunk c, HasSymbol c) => c -> r
sy c
s CodeExpr -> CodeExpr -> CodeExpr
forall r. ExprC r => r -> r -> r
$>  CodeExpr
a

renderSet :: (IsChunk c, HasSymbol c) => c -> CodeExpr -> CodeExpr
renderSet :: forall c. (IsChunk c, HasSymbol c) => c -> CodeExpr -> CodeExpr
renderSet c
e CodeExpr
s = CodeExpr -> CodeExpr -> CodeExpr
forall r. ExprC r => r -> r -> r
in' (Name -> CodeExpr -> CodeExpr
Variable (Name
"set_" Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ c -> Name
forall x. HasSymbol x => x -> Name
showHasSymbImpl c
e) CodeExpr
s) (c -> CodeExpr
forall c. (IsChunk c, HasSymbol c) => c -> CodeExpr
forall r c. (ExprC r, IsChunk c, HasSymbol c) => c -> r
sy c
e)

-- | Maps a 'UFunc' to the corresponding GOOL unary function.
unop :: (NumericExpression r, Reference r) => UFunc -> (SValue r -> SValue r)
unop :: forall (r :: * -> *).
(NumericExpression r, Reference r) =>
UFunc -> SValue r -> SValue r
unop UFunc
Sqrt = SValue r -> SValue r
forall (r :: * -> *). NumericExpression r => SValue r -> SValue r
(#/^)
unop UFunc
Log  = SValue r -> SValue r
forall (r :: * -> *). NumericExpression r => SValue r -> SValue r
log
unop UFunc
Ln   = SValue r -> SValue r
forall (r :: * -> *). NumericExpression r => SValue r -> SValue r
ln
unop UFunc
Abs  = SValue r -> SValue r
forall (r :: * -> *). NumericExpression r => SValue r -> SValue r
(#|)
unop UFunc
Exp  = SValue r -> SValue r
forall (r :: * -> *). NumericExpression r => SValue r -> SValue r
exp
unop UFunc
Sin  = SValue r -> SValue r
forall (r :: * -> *). NumericExpression r => SValue r -> SValue r
sin
unop UFunc
Cos  = SValue r -> SValue r
forall (r :: * -> *). NumericExpression r => SValue r -> SValue r
cos
unop UFunc
Tan  = SValue r -> SValue r
forall (r :: * -> *). NumericExpression r => SValue r -> SValue r
tan
unop UFunc
Csc  = SValue r -> SValue r
forall (r :: * -> *). NumericExpression r => SValue r -> SValue r
csc
unop UFunc
Sec  = SValue r -> SValue r
forall (r :: * -> *). NumericExpression r => SValue r -> SValue r
sec
unop UFunc
Cot  = SValue r -> SValue r
forall (r :: * -> *). NumericExpression r => SValue r -> SValue r
cot
unop UFunc
Arcsin = SValue r -> SValue r
forall (r :: * -> *). NumericExpression r => SValue r -> SValue r
arcsin
unop UFunc
Arccos = SValue r -> SValue r
forall (r :: * -> *). NumericExpression r => SValue r -> SValue r
arccos
unop UFunc
Arctan = SValue r -> SValue r
forall (r :: * -> *). NumericExpression r => SValue r -> SValue r
arctan
unop UFunc
Neg  = SValue r -> SValue r
forall (r :: * -> *). NumericExpression r => SValue r -> SValue r
(#~)
unop UFunc
MakeRef = SValue r -> SValue r
forall (r :: * -> *). Reference r => SValue r -> SValue r
makeRef

-- | Similar to 'unop', but for the 'Not' constructor.
unopB :: (BooleanExpression r) => UFuncB -> (SValue r -> SValue r)
unopB :: forall (r :: * -> *).
BooleanExpression r =>
UFuncB -> SValue r -> SValue r
unopB UFuncB
Not = SValue r -> SValue r
forall (r :: * -> *). BooleanExpression r => SValue r -> SValue r
(?!)

-- | Similar to 'unop', but for vectors.
unopVN :: (List r smt) => UFuncVN -> (SValue r -> SValue r)
unopVN :: forall (r :: * -> *) smt.
List r smt =>
UFuncVN -> SValue r -> SValue r
unopVN UFuncVN
Dim = SValue r -> SValue r
forall (r :: * -> *) smt. List r smt => SValue r -> SValue r
listSize
unopVN UFuncVN
Norm = Name -> SValue r -> SValue r
forall a. HasCallStack => Name -> a
error Name
"unop: Norm not implemented" -- TODO

-- | Similar to 'unop', but for vectors.
unopVV :: (ValueSym r) => UFuncVV -> (SValue r -> SValue r)
unopVV :: forall (r :: * -> *). ValueSym r => UFuncVV -> SValue r -> SValue r
unopVV UFuncVV
NegV = Name -> SValue r -> SValue r
forall a. HasCallStack => Name -> a
error Name
"unop: Negation on Vectors not implemented" -- TODO

-- Maps an 'ArithBinOp' to it's corresponding GOOL binary function.
arithBfunc :: (NumericExpression r) => ArithBinOp -> (SValue r -> SValue r -> SValue r)
arithBfunc :: forall (r :: * -> *).
NumericExpression r =>
ArithBinOp -> SValue r -> SValue r -> SValue r
arithBfunc ArithBinOp
Pow  = SValue r -> SValue r -> SValue r
forall (r :: * -> *).
NumericExpression r =>
SValue r -> SValue r -> SValue r
(#^)
arithBfunc ArithBinOp
Subt = SValue r -> SValue r -> SValue r
forall (r :: * -> *).
NumericExpression r =>
SValue r -> SValue r -> SValue r
(#-)
arithBfunc ArithBinOp
Frac = SValue r -> SValue r -> SValue r
forall (r :: * -> *).
NumericExpression r =>
SValue r -> SValue r -> SValue r
(#/)

-- Maps an 'EqBinOp' to it's corresponding GOOL binary function.
eqBfunc :: (Comparison r) => EqBinOp -> (SValue r -> SValue r -> SValue r)
eqBfunc :: forall (r :: * -> *).
Comparison r =>
EqBinOp -> SValue r -> SValue r -> SValue r
eqBfunc EqBinOp
Eq  = SValue r -> SValue r -> SValue r
forall (r :: * -> *).
Comparison r =>
SValue r -> SValue r -> SValue r
(?==)
eqBfunc EqBinOp
NEq = SValue r -> SValue r -> SValue r
forall (r :: * -> *).
Comparison r =>
SValue r -> SValue r -> SValue r
(?!=)

-- Maps an 'LABinOp' to it's corresponding GOOL binary function.
laBfunc :: (List r smt) => LABinOp -> (SValue r -> SValue r -> SValue r)
laBfunc :: forall (r :: * -> *) smt.
List r smt =>
LABinOp -> SValue r -> SValue r -> SValue r
laBfunc LABinOp
Index = SValue r -> SValue r -> SValue r
forall (r :: * -> *) smt.
List r smt =>
SValue r -> SValue r -> SValue r
listAccess
laBfunc LABinOp
IndexOf = SValue r -> SValue r -> SValue r
forall (r :: * -> *) smt.
List r smt =>
SValue r -> SValue r -> SValue r
indexOf

-- Maps an 'OrdBinOp' to it's corresponding GOOL binary function.
ordBfunc :: (Comparison r) => OrdBinOp -> (SValue r -> SValue r -> SValue r)
ordBfunc :: forall (r :: * -> *).
Comparison r =>
OrdBinOp -> SValue r -> SValue r -> SValue r
ordBfunc OrdBinOp
Gt  = SValue r -> SValue r -> SValue r
forall (r :: * -> *).
Comparison r =>
SValue r -> SValue r -> SValue r
(?>)
ordBfunc OrdBinOp
Lt  = SValue r -> SValue r -> SValue r
forall (r :: * -> *).
Comparison r =>
SValue r -> SValue r -> SValue r
(?<)
ordBfunc OrdBinOp
LEq = SValue r -> SValue r -> SValue r
forall (r :: * -> *).
Comparison r =>
SValue r -> SValue r -> SValue r
(?<=)
ordBfunc OrdBinOp
GEq = SValue r -> SValue r -> SValue r
forall (r :: * -> *).
Comparison r =>
SValue r -> SValue r -> SValue r
(?>=)

-- Maps a 'VVVBinOp' to it's corresponding GOOL binary function.
vecVecVecBfunc :: VVVBinOp -> (SValue r -> SValue r -> SValue r)
vecVecVecBfunc :: forall (r :: * -> *). VVVBinOp -> SValue r -> SValue r -> SValue r
vecVecVecBfunc VVVBinOp
Cross = Name -> SValue r -> SValue r -> SValue r
forall a. HasCallStack => Name -> a
error Name
"bfunc: Cross not implemented"
vecVecVecBfunc VVVBinOp
VAdd = Name -> SValue r -> SValue r -> SValue r
forall a. HasCallStack => Name -> a
error Name
"bfunc: Vector addition not implemented"
vecVecVecBfunc VVVBinOp
VSub = Name -> SValue r -> SValue r -> SValue r
forall a. HasCallStack => Name -> a
error Name
"bfunc: Vector subtraction not implemented"

-- Maps a 'VVNBinOp' to it's corresponding GOOL binary function.
vecVecNumBfunc :: VVNBinOp -> (SValue r -> SValue r -> SValue r)
vecVecNumBfunc :: forall (r :: * -> *). VVNBinOp -> SValue r -> SValue r -> SValue r
vecVecNumBfunc VVNBinOp
Dot = Name -> SValue r -> SValue r -> SValue r
forall a. HasCallStack => Name -> a
error Name
"convExpr DotProduct"

-- Maps a 'NVVBinOp' to it's corresponding GOOL binary function.
numVecVecBfunc :: NVVBinOp -> (SValue r -> SValue r -> SValue r)
numVecVecBfunc :: forall (r :: * -> *). NVVBinOp -> SValue r -> SValue r -> SValue r
numVecVecBfunc NVVBinOp
Scale = Name -> SValue r -> SValue r -> SValue r
forall a. HasCallStack => Name -> a
error Name
"convExpr Scaling of Vectors"

-- Maps a 'ESSBinOp' to its corresponding GOOL binary function.
elementSetSetBfunc :: (S.Set r) => ESSBinOp -> (SValue r -> SValue r -> SValue r)
elementSetSetBfunc :: forall (r :: * -> *).
Set r =>
ESSBinOp -> SValue r -> SValue r -> SValue r
elementSetSetBfunc ESSBinOp
SAdd = SValue r -> SValue r -> SValue r
forall (r :: * -> *). Set r => SValue r -> SValue r -> SValue r
S.setAdd
elementSetSetBfunc ESSBinOp
SRemove = SValue r -> SValue r -> SValue r
forall (r :: * -> *). Set r => SValue r -> SValue r -> SValue r
S.setRemove

-- Maps a 'ESSBinOp' to it's corresponding GOOL binary function.
elementSetBoolBfunc :: (S.Set r) => ESBBinOp -> (SValue r -> SValue r -> SValue r)
elementSetBoolBfunc :: forall (r :: * -> *).
Set r =>
ESBBinOp -> SValue r -> SValue r -> SValue r
elementSetBoolBfunc ESBBinOp
SContains = SValue r -> SValue r -> SValue r
forall (r :: * -> *). Set r => SValue r -> SValue r -> SValue r
S.contains

-- medium hacks --

-- | Converts a 'Mod' to GOOL.
genModDef :: (OOProg r vis smt md svr att prg) =>
  Mod -> GenState (FS (r File))
genModDef :: forall (r :: * -> *) vis smt md svr att prg.
OOProg r vis smt md svr att prg =>
Mod -> GenState (FS (r File))
genModDef (Mod Name
n Name
desc [Name]
is [Class]
cs [Func]
fs) = Name
-> Name
-> [Name]
-> [GenState (Maybe (MS (r md)))]
-> [GenState (Maybe (CS (r Block)))]
-> GenState (FS (r File))
forall (r :: * -> *) vis smt md svr att prg.
OOProg r vis smt md svr att prg =>
Name
-> Name
-> [Name]
-> [GenState (Maybe (MS (r md)))]
-> [GenState (Maybe (CS (r Block)))]
-> GenState (FS (r File))
genModuleWithImports Name
n Name
desc [Name]
is ((Func -> GenState (Maybe (MS (r md))))
-> [Func] -> [GenState (Maybe (MS (r md)))]
forall a b. (a -> b) -> [a] -> [b]
map ((MS (r md) -> Maybe (MS (r md)))
-> StateT DrasilState Identity (MS (r md))
-> GenState (Maybe (MS (r md)))
forall a b.
(a -> b)
-> StateT DrasilState Identity a -> StateT DrasilState Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
  MS (r md) -> Maybe (MS (r md))
forall a. a -> Maybe a
Just (StateT DrasilState Identity (MS (r md))
 -> GenState (Maybe (MS (r md))))
-> (Func -> StateT DrasilState Identity (MS (r md)))
-> Func
-> GenState (Maybe (MS (r md)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name
 -> VS (r TypeData)
 -> Name
 -> [ParameterChunk]
 -> Maybe Name
 -> [MS (r Block)]
 -> StateT DrasilState Identity (MS (r md)))
-> [StateVariable]
-> Func
-> StateT DrasilState Identity (MS (r md))
forall (r :: * -> *) vis smt md svr att prg.
OOProg r vis smt md svr att prg =>
(Name
 -> VS (r TypeData)
 -> Name
 -> [ParameterChunk]
 -> Maybe Name
 -> [MS (r Block)]
 -> GenState (MS (r md)))
-> [StateVariable] -> Func -> GenState (MS (r md))
genFunc Name
-> VS (r TypeData)
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MS (r Block)]
-> StateT DrasilState Identity (MS (r md))
forall (r :: * -> *) vis smt md svr att prg.
OOProg r vis smt md svr att prg =>
Name
-> VS (r TypeData)
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MS (r Block)]
-> GenState (MS (r md))
publicFunc []) [Func]
fs)
  (case [Class]
cs of [] -> []
              (Class
cl:[Class]
cls) -> (CS (r Block) -> Maybe (CS (r Block)))
-> StateT DrasilState Identity (CS (r Block))
-> GenState (Maybe (CS (r Block)))
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 CS (r Block) -> Maybe (CS (r Block))
forall a. a -> Maybe a
Just ((Name
 -> Maybe Name
 -> Name
 -> [CSStateVar r svr]
 -> GenState [MS (r md)]
 -> GenState [MS (r md)]
 -> StateT DrasilState Identity (CS (r Block)))
-> Class -> StateT DrasilState Identity (CS (r Block))
forall (r :: * -> *) vis smt md svr att prg.
OOProg r vis smt md svr att prg =>
(Name
 -> Maybe Name
 -> Name
 -> [CSStateVar r svr]
 -> GenState [MS (r md)]
 -> GenState [MS (r md)]
 -> GenState (CS (r Block)))
-> Class -> GenState (CS (r Block))
genClass Name
-> Maybe Name
-> Name
-> [CSStateVar r svr]
-> GenState [MS (r md)]
-> GenState [MS (r md)]
-> StateT DrasilState Identity (CS (r Block))
forall (r :: * -> *) vis smt md svr att.
ClassSym r vis smt md svr att =>
Name
-> Maybe Name
-> Name
-> [CSStateVar r svr]
-> GenState [MS (r md)]
-> GenState [MS (r md)]
-> GenState (CS (r Block))
primaryClass Class
cl) GenState (Maybe (CS (r Block)))
-> [GenState (Maybe (CS (r Block)))]
-> [GenState (Maybe (CS (r Block)))]
forall a. a -> [a] -> [a]
:
                (Class -> GenState (Maybe (CS (r Block))))
-> [Class] -> [GenState (Maybe (CS (r Block)))]
forall a b. (a -> b) -> [a] -> [b]
map ((CS (r Block) -> Maybe (CS (r Block)))
-> StateT DrasilState Identity (CS (r Block))
-> GenState (Maybe (CS (r Block)))
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 CS (r Block) -> Maybe (CS (r Block))
forall a. a -> Maybe a
Just (StateT DrasilState Identity (CS (r Block))
 -> GenState (Maybe (CS (r Block))))
-> (Class -> StateT DrasilState Identity (CS (r Block)))
-> Class
-> GenState (Maybe (CS (r Block)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name
 -> Maybe Name
 -> Name
 -> [CSStateVar r svr]
 -> GenState [MS (r md)]
 -> GenState [MS (r md)]
 -> StateT DrasilState Identity (CS (r Block)))
-> Class -> StateT DrasilState Identity (CS (r Block))
forall (r :: * -> *) vis smt md svr att prg.
OOProg r vis smt md svr att prg =>
(Name
 -> Maybe Name
 -> Name
 -> [CSStateVar r svr]
 -> GenState [MS (r md)]
 -> GenState [MS (r md)]
 -> GenState (CS (r Block)))
-> Class -> GenState (CS (r Block))
genClass Name
-> Maybe Name
-> Name
-> [CSStateVar r svr]
-> GenState [MS (r md)]
-> GenState [MS (r md)]
-> StateT DrasilState Identity (CS (r Block))
forall (r :: * -> *) vis smt md svr att.
ClassSym r vis smt md svr att =>
Name
-> Maybe Name
-> Name
-> [CSStateVar r svr]
-> GenState [MS (r md)]
-> GenState [MS (r md)]
-> GenState (CS (r Block))
auxClass) [Class]
cls)

-- | Converts a 'Mod'\'s functions to GOOL.
genModFuncs :: (OOProg r vis smt md svr att prg) => Mod -> [GenState (MS (r md))]
genModFuncs :: forall (r :: * -> *) vis smt md svr att prg.
OOProg r vis smt md svr att prg =>
Mod -> [GenState (MS (r md))]
genModFuncs (Mod Name
_ Name
_ [Name]
_ [Class]
_ [Func]
fs) = (Func -> GenState (MS (r md))) -> [Func] -> [GenState (MS (r md))]
forall a b. (a -> b) -> [a] -> [b]
map ((Name
 -> VS (r TypeData)
 -> Name
 -> [ParameterChunk]
 -> Maybe Name
 -> [MS (r Block)]
 -> GenState (MS (r md)))
-> [StateVariable] -> Func -> GenState (MS (r md))
forall (r :: * -> *) vis smt md svr att prg.
OOProg r vis smt md svr att prg =>
(Name
 -> VS (r TypeData)
 -> Name
 -> [ParameterChunk]
 -> Maybe Name
 -> [MS (r Block)]
 -> GenState (MS (r md)))
-> [StateVariable] -> Func -> GenState (MS (r md))
genFunc Name
-> VS (r TypeData)
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MS (r Block)]
-> GenState (MS (r md))
forall (r :: * -> *) vis smt md svr att prg.
OOProg r vis smt md svr att prg =>
Name
-> VS (r TypeData)
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MS (r Block)]
-> GenState (MS (r md))
publicFunc []) [Func]
fs

-- | Converts a 'Mod'\'s classes to GOOL.
genModClasses :: (OOProg r vis smt md svr att prg) => Mod -> [GenState (CS (r Class))]
genModClasses :: forall (r :: * -> *) vis smt md svr att prg.
OOProg r vis smt md svr att prg =>
Mod -> [GenState (CS (r Block))]
genModClasses (Mod Name
_ Name
_ [Name]
_ [Class]
cs [Func]
_) = (Class -> GenState (CS (r Block)))
-> [Class] -> [GenState (CS (r Block))]
forall a b. (a -> b) -> [a] -> [b]
map ((Name
 -> Maybe Name
 -> Name
 -> [CSStateVar r svr]
 -> GenState [MS (r md)]
 -> GenState [MS (r md)]
 -> GenState (CS (r Block)))
-> Class -> GenState (CS (r Block))
forall (r :: * -> *) vis smt md svr att prg.
OOProg r vis smt md svr att prg =>
(Name
 -> Maybe Name
 -> Name
 -> [CSStateVar r svr]
 -> GenState [MS (r md)]
 -> GenState [MS (r md)]
 -> GenState (CS (r Block)))
-> Class -> GenState (CS (r Block))
genClass Name
-> Maybe Name
-> Name
-> [CSStateVar r svr]
-> GenState [MS (r md)]
-> GenState [MS (r md)]
-> GenState (CS (r Block))
forall (r :: * -> *) vis smt md svr att.
ClassSym r vis smt md svr att =>
Name
-> Maybe Name
-> Name
-> [CSStateVar r svr]
-> GenState [MS (r md)]
-> GenState [MS (r md)]
-> GenState (CS (r Block))
auxClass) [Class]
cs

-- | Converts a Class (from the Mod AST) to GOOL.
-- The class generator to use is passed as a parameter.
genClass
  :: (OOProg r vis smt md svr att prg)
  => (Name -> Maybe Name -> Description -> [CSStateVar r svr] -> GenState [MS (r md)] -> GenState [MS (r md)] -> GenState (CS (r Class)))
  -> M.Class
  -> GenState (CS (r Class))
genClass :: forall (r :: * -> *) vis smt md svr att prg.
OOProg r vis smt md svr att prg =>
(Name
 -> Maybe Name
 -> Name
 -> [CSStateVar r svr]
 -> GenState [MS (r md)]
 -> GenState [MS (r md)]
 -> GenState (CS (r Block)))
-> Class -> GenState (CS (r Block))
genClass Name
-> Maybe Name
-> Name
-> [CSStateVar r svr]
-> GenState [MS (r md)]
-> GenState [MS (r md)]
-> GenState (CS (r Block))
f (M.ClassDef Name
n Maybe Name
i Name
desc [StateVariable]
svs [Func]
cs [Func]
ms) = let svar :: VisibilityTag -> SVariable r -> CSStateVar r svr
svar VisibilityTag
Pub = SVariable r -> CSStateVar r svr
forall (r :: * -> *) vis svr att.
StateVarSym r vis svr att =>
SVariable r -> CSStateVar r svr
pubDVar
                                                 svar VisibilityTag
Priv = SVariable r -> CSStateVar r svr
forall (r :: * -> *) vis svr att.
StateVarSym r vis svr att =>
SVariable r -> CSStateVar r svr
privDVar
  in do
  (DrasilState -> DrasilState) -> StateT DrasilState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\DrasilState
st -> DrasilState
st {currentScope = Local})
  [CSStateVar r svr]
svrs <- (StateVariable -> StateT DrasilState Identity (CSStateVar r svr))
-> [StateVariable]
-> StateT DrasilState Identity [CSStateVar r svr]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\(SV VisibilityTag
s Input
v) -> (CodeType -> CSStateVar r svr)
-> StateT DrasilState Identity CodeType
-> StateT DrasilState Identity (CSStateVar r svr)
forall a b.
(a -> b)
-> StateT DrasilState Identity a -> StateT DrasilState Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (VisibilityTag -> SVariable r -> CSStateVar r svr
forall {r :: * -> *} {att} {vis} {svr}.
StateVarSym r vis svr att =>
VisibilityTag -> SVariable r -> CSStateVar r svr
svar VisibilityTag
s (SVariable r -> CSStateVar r svr)
-> (CodeType -> SVariable r) -> CodeType -> CSStateVar r svr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> VS (r TypeData) -> SVariable r
forall (r :: * -> *).
VariableSym r =>
Name -> VS (r TypeData) -> SVariable r
var (Input -> Name
forall c. CodeIdea c => c -> Name
codeName Input
v) (VS (r TypeData) -> SVariable r)
-> (CodeType -> VS (r TypeData)) -> CodeType -> SVariable r
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                CodeType -> VS (r TypeData)
forall (r :: * -> *). OOTypeSym r => CodeType -> VS (r TypeData)
convTypeOO) (Input -> StateT DrasilState Identity CodeType
forall c. HasSpace c => c -> StateT DrasilState Identity CodeType
codeType Input
v)) [StateVariable]
svs
  Name
-> Maybe Name
-> Name
-> [CSStateVar r svr]
-> GenState [MS (r md)]
-> GenState [MS (r md)]
-> GenState (CS (r Block))
f Name
n Maybe Name
i Name
desc [CSStateVar r svr]
svrs ((Func -> StateT DrasilState Identity (MS (r md)))
-> [Func] -> GenState [MS (r md)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((Name
 -> VS (r TypeData)
 -> Name
 -> [ParameterChunk]
 -> Maybe Name
 -> [MS (r Block)]
 -> StateT DrasilState Identity (MS (r md)))
-> [StateVariable]
-> Func
-> StateT DrasilState Identity (MS (r md))
forall (r :: * -> *) vis smt md svr att prg.
OOProg r vis smt md svr att prg =>
(Name
 -> VS (r TypeData)
 -> Name
 -> [ParameterChunk]
 -> Maybe Name
 -> [MS (r Block)]
 -> GenState (MS (r md)))
-> [StateVariable] -> Func -> GenState (MS (r md))
genFunc Name
-> VS (r TypeData)
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MS (r Block)]
-> StateT DrasilState Identity (MS (r md))
forall (r :: * -> *) vis smt md svr att prg.
OOProg r vis smt md svr att prg =>
Name
-> VS (r TypeData)
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MS (r Block)]
-> GenState (MS (r md))
publicMethod [StateVariable]
svs) [Func]
cs)
                  ((Func -> StateT DrasilState Identity (MS (r md)))
-> [Func] -> GenState [MS (r md)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((Name
 -> VS (r TypeData)
 -> Name
 -> [ParameterChunk]
 -> Maybe Name
 -> [MS (r Block)]
 -> StateT DrasilState Identity (MS (r md)))
-> [StateVariable]
-> Func
-> StateT DrasilState Identity (MS (r md))
forall (r :: * -> *) vis smt md svr att prg.
OOProg r vis smt md svr att prg =>
(Name
 -> VS (r TypeData)
 -> Name
 -> [ParameterChunk]
 -> Maybe Name
 -> [MS (r Block)]
 -> GenState (MS (r md)))
-> [StateVariable] -> Func -> GenState (MS (r md))
genFunc Name
-> VS (r TypeData)
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MS (r Block)]
-> StateT DrasilState Identity (MS (r md))
forall (r :: * -> *) vis smt md svr att prg.
OOProg r vis smt md svr att prg =>
Name
-> VS (r TypeData)
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MS (r Block)]
-> GenState (MS (r md))
publicMethod [StateVariable]
svs) [Func]
ms)

-- | Converts a 'Func' (from the Mod AST) to GOOL.
-- The function generator to use is passed as a parameter. Automatically adds
-- variable declaration statements for any undeclared variables. For methods,
-- the list of StateVariables is needed so they can be included in the list of
-- declared variables.
genFunc
  :: (OOProg r vis smt md svr att prg)
  => (Name -> VS (r TypeData) -> Description -> [ParameterChunk] -> Maybe Description -> [MS (r Block)] -> GenState (MS (r md)))
  -> [StateVariable]
  -> Func
  -> GenState (MS (r md))
genFunc :: forall (r :: * -> *) vis smt md svr att prg.
OOProg r vis smt md svr att prg =>
(Name
 -> VS (r TypeData)
 -> Name
 -> [ParameterChunk]
 -> Maybe Name
 -> [MS (r Block)]
 -> GenState (MS (r md)))
-> [StateVariable] -> Func -> GenState (MS (r md))
genFunc Name
-> VS (r TypeData)
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MS (r Block)]
-> GenState (MS (r md))
f [StateVariable]
svs (FDef (FuncDef Name
n Name
desc [ParameterChunk]
parms Space
o Maybe Name
rd [FuncStmt]
s)) = do
  DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  (DrasilState -> DrasilState) -> StateT DrasilState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\DrasilState
st -> DrasilState
st {currentScope = Local})
  [MS (r smt)]
stmts <- (FuncStmt -> StateT DrasilState Identity (MS (r smt)))
-> [FuncStmt] -> StateT DrasilState Identity [MS (r smt)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM FuncStmt -> StateT DrasilState Identity (MS (r smt))
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
FuncStmt -> GenState (MS (r smt))
convStmt [FuncStmt]
s
  [SVariable r]
vars <- (Input -> StateT DrasilState Identity (SVariable r))
-> [Input] -> StateT DrasilState Identity [SVariable r]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Input -> StateT DrasilState Identity (SVariable r)
forall (r :: * -> *).
(SelfSym r, VariableElim r, VariableValue r) =>
Input -> GenState (SVariable r)
mkVar (ChunkDB -> [FuncStmt] -> [Input]
fstdecl (DrasilState
g DrasilState -> Getting ChunkDB DrasilState ChunkDB -> ChunkDB
forall s a. s -> Getting a s a -> a
^. Getting ChunkDB DrasilState ChunkDB
forall c. HasSystemMeta c => Lens' c ChunkDB
Lens' DrasilState ChunkDB
systemdb) [FuncStmt]
s
    [Input] -> [Input] -> [Input]
forall a. Eq a => [a] -> [a] -> [a]
\\ ((ParameterChunk -> Input) -> [ParameterChunk] -> [Input]
forall a b. (a -> b) -> [a] -> [b]
map ParameterChunk -> Input
forall c. (Quantity c, MayHaveUnit c, Concept c) => c -> Input
quantvar [ParameterChunk]
parms [Input] -> [Input] -> [Input]
forall a. [a] -> [a] -> [a]
++ (StateVariable -> Input) -> [StateVariable] -> [Input]
forall a b. (a -> b) -> [a] -> [b]
map StateVariable -> Input
stVar [StateVariable]
svs))
  CodeType
t <- Space -> StateT DrasilState Identity CodeType
spaceCodeType Space
o
  Name
-> VS (r TypeData)
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MS (r Block)]
-> GenState (MS (r md))
f Name
n (CodeType -> VS (r TypeData)
forall (r :: * -> *). OOTypeSym r => CodeType -> VS (r TypeData)
convTypeOO CodeType
t) Name
desc [ParameterChunk]
parms Maybe Name
rd [[MS (r smt)] -> MS (r Block)
forall (r :: * -> *) smt.
BlockSym r smt =>
[MS (r smt)] -> MS (r Block)
block ([MS (r smt)] -> MS (r Block)) -> [MS (r smt)] -> MS (r Block)
forall a b. (a -> b) -> a -> b
$ (SVariable r -> MS (r smt)) -> [SVariable r] -> [MS (r smt)]
forall a b. (a -> b) -> [a] -> [b]
map (SVariable r -> r ScopeData -> MS (r smt)
forall (r :: * -> *) smt.
DeclStatement r smt =>
SVariable r -> r ScopeData -> MS (r smt)
`varDec` r ScopeData
forall (r :: * -> *). ScopeSym r => r ScopeData
local) [SVariable r]
vars, [MS (r smt)] -> MS (r Block)
forall (r :: * -> *) smt.
BlockSym r smt =>
[MS (r smt)] -> MS (r Block)
block [MS (r smt)]
stmts]
genFunc Name
-> VS (r TypeData)
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MS (r Block)]
-> GenState (MS (r md))
_ [StateVariable]
svs (FDef (CtorDef Name
n Name
desc [ParameterChunk]
parms [Initializer]
i [FuncStmt]
s)) = do
  DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  (DrasilState -> DrasilState) -> StateT DrasilState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\DrasilState
st -> DrasilState
st {currentScope = Local})
  [SValue r]
inits <- (Initializer -> StateT DrasilState Identity (SValue r))
-> [Initializer] -> StateT DrasilState Identity [SValue r]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (CodeExpr -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr (CodeExpr -> StateT DrasilState Identity (SValue r))
-> (Initializer -> CodeExpr)
-> Initializer
-> StateT DrasilState Identity (SValue r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Initializer -> CodeExpr
forall a b. (a, b) -> b
snd) [Initializer]
i
  [SVariable r]
initvars <- (Initializer -> StateT DrasilState Identity (SVariable r))
-> [Initializer] -> StateT DrasilState Identity [SVariable r]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((\Input
iv -> (CodeType -> SVariable r)
-> StateT DrasilState Identity CodeType
-> StateT DrasilState Identity (SVariable r)
forall a b.
(a -> b)
-> StateT DrasilState Identity a -> StateT DrasilState Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Name -> VS (r TypeData) -> SVariable r
forall (r :: * -> *).
VariableSym r =>
Name -> VS (r TypeData) -> SVariable r
var (Input -> Name
forall c. CodeIdea c => c -> Name
codeName Input
iv) (VS (r TypeData) -> SVariable r)
-> (CodeType -> VS (r TypeData)) -> CodeType -> SVariable r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CodeType -> VS (r TypeData)
forall (r :: * -> *). OOTypeSym r => CodeType -> VS (r TypeData)
convTypeOO)
    (Input -> StateT DrasilState Identity CodeType
forall c. HasSpace c => c -> StateT DrasilState Identity CodeType
codeType Input
iv)) (Input -> StateT DrasilState Identity (SVariable r))
-> (Initializer -> Input)
-> Initializer
-> StateT DrasilState Identity (SVariable r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Initializer -> Input
forall a b. (a, b) -> a
fst) [Initializer]
i
  [MS (r smt)]
stmts <- (FuncStmt -> StateT DrasilState Identity (MS (r smt)))
-> [FuncStmt] -> StateT DrasilState Identity [MS (r smt)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM FuncStmt -> StateT DrasilState Identity (MS (r smt))
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
FuncStmt -> GenState (MS (r smt))
convStmt [FuncStmt]
s
  [SVariable r]
vars <- (Input -> StateT DrasilState Identity (SVariable r))
-> [Input] -> StateT DrasilState Identity [SVariable r]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Input -> StateT DrasilState Identity (SVariable r)
forall (r :: * -> *).
(SelfSym r, VariableElim r, VariableValue r) =>
Input -> GenState (SVariable r)
mkVar (ChunkDB -> [FuncStmt] -> [Input]
fstdecl (DrasilState
g DrasilState -> Getting ChunkDB DrasilState ChunkDB -> ChunkDB
forall s a. s -> Getting a s a -> a
^. Getting ChunkDB DrasilState ChunkDB
forall c. HasSystemMeta c => Lens' c ChunkDB
Lens' DrasilState ChunkDB
systemdb) [FuncStmt]
s
    [Input] -> [Input] -> [Input]
forall a. Eq a => [a] -> [a] -> [a]
\\ ((ParameterChunk -> Input) -> [ParameterChunk] -> [Input]
forall a b. (a -> b) -> [a] -> [b]
map ParameterChunk -> Input
forall c. (Quantity c, MayHaveUnit c, Concept c) => c -> Input
quantvar [ParameterChunk]
parms [Input] -> [Input] -> [Input]
forall a. [a] -> [a] -> [a]
++ (StateVariable -> Input) -> [StateVariable] -> [Input]
forall a b. (a -> b) -> [a] -> [b]
map StateVariable -> Input
stVar [StateVariable]
svs))
  Name
-> Name
-> [ParameterChunk]
-> Initializers r
-> [MS (r Block)]
-> GenState (MS (r md))
forall (r :: * -> *) vis smt md svr att prg.
OOProg r vis smt md svr att prg =>
Name
-> Name
-> [ParameterChunk]
-> Initializers r
-> [MS (r Block)]
-> GenState (MS (r md))
genInitConstructor Name
n Name
desc [ParameterChunk]
parms ([SVariable r] -> [SValue r] -> Initializers r
forall a b. [a] -> [b] -> [(a, b)]
zip [SVariable r]
initvars [SValue r]
inits)
    [[MS (r smt)] -> MS (r Block)
forall (r :: * -> *) smt.
BlockSym r smt =>
[MS (r smt)] -> MS (r Block)
block ([MS (r smt)] -> MS (r Block)) -> [MS (r smt)] -> MS (r Block)
forall a b. (a -> b) -> a -> b
$ (SVariable r -> MS (r smt)) -> [SVariable r] -> [MS (r smt)]
forall a b. (a -> b) -> [a] -> [b]
map (SVariable r -> r ScopeData -> MS (r smt)
forall (r :: * -> *) smt.
DeclStatement r smt =>
SVariable r -> r ScopeData -> MS (r smt)
`varDec` r ScopeData
forall (r :: * -> *). ScopeSym r => r ScopeData
local) [SVariable r]
vars, [MS (r smt)] -> MS (r Block)
forall (r :: * -> *) smt.
BlockSym r smt =>
[MS (r smt)] -> MS (r Block)
block [MS (r smt)]
stmts]
genFunc Name
-> VS (r TypeData)
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MS (r Block)]
-> GenState (MS (r md))
_ [StateVariable]
_ (FData (FuncData Name
n Name
desc DataDesc
ddef)) = do
  (DrasilState -> DrasilState) -> StateT DrasilState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\DrasilState
st -> DrasilState
st {currentScope = Local})
  Name -> Name -> DataDesc -> GenState (MS (r md))
forall (r :: * -> *) vis smt md svr att prg.
OOProg r vis smt md svr att prg =>
Name -> Name -> DataDesc -> GenState (MS (r md))
genDataFunc Name
n Name
desc DataDesc
ddef

-- | Converts a 'FuncStmt' to a GOOL Statement.
convStmt
  :: (OOStatement r smt, TypeElim r, VariableElim r)
  => FuncStmt -> GenState (MS (r smt))
convStmt :: forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
FuncStmt -> GenState (MS (r smt))
convStmt (FAsg Input
v (Matrix [[CodeExpr]
es])) = do
  [SValue r]
els <- (CodeExpr -> StateT DrasilState Identity (SValue r))
-> [CodeExpr] -> StateT DrasilState Identity [SValue r]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM CodeExpr -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr [CodeExpr]
es
  SVariable r
v' <- Input -> GenState (SVariable r)
forall (r :: * -> *).
(SelfSym r, VariableElim r, VariableValue r) =>
Input -> GenState (SVariable r)
mkVar Input
v
  CodeType
t <- Input -> StateT DrasilState Identity CodeType
forall c. HasSpace c => c -> StateT DrasilState Identity CodeType
codeType Input
v
  let listFunc :: CodeType -> VS (r TypeData) -> [SValue r] -> SValue r
listFunc (C.List CodeType
_) = VS (r TypeData) -> [SValue r] -> SValue r
forall (r :: * -> *).
Literal r =>
VS (r TypeData) -> [SValue r] -> SValue r
litList
      listFunc (C.Array CodeType
_) = VS (r TypeData) -> [SValue r] -> SValue r
forall (r :: * -> *).
Literal r =>
VS (r TypeData) -> [SValue r] -> SValue r
litArray
      listFunc CodeType
_ = Name -> VS (r TypeData) -> [SValue r] -> SValue r
forall a. HasCallStack => Name -> a
error Name
"Type mismatch between variable and value in assignment FuncStmt"
  MS (r smt) -> GenState (MS (r smt))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (MS (r smt) -> GenState (MS (r smt)))
-> MS (r smt) -> GenState (MS (r smt))
forall a b. (a -> b) -> a -> b
$ SVariable r -> SValue r -> MS (r smt)
forall (r :: * -> *) smt.
AssignStatement r smt =>
SVariable r -> SValue r -> MS (r smt)
assign SVariable r
v' (CodeType -> VS (r TypeData) -> [SValue r] -> SValue r
forall {r :: * -> *}.
Literal r =>
CodeType -> VS (r TypeData) -> [SValue r] -> SValue r
listFunc CodeType
t (VS (r TypeData) -> VS (r TypeData)
forall (r :: * -> *).
TypeSym r =>
VS (r TypeData) -> VS (r TypeData)
innerType (VS (r TypeData) -> VS (r TypeData))
-> VS (r TypeData) -> VS (r TypeData)
forall a b. (a -> b) -> a -> b
$ (r Variable -> r TypeData) -> SVariable r -> VS (r TypeData)
forall a b.
(a -> b)
-> StateT ValueState Identity a -> StateT ValueState Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap r Variable -> r TypeData
forall (r :: * -> *). VariableElim r => r Variable -> r TypeData
variableType SVariable r
v') [SValue r]
els)
convStmt (FAsg Input
v CodeExpr
e) = do
  SValue r
e' <- CodeExpr -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr CodeExpr
e
  SVariable r
v' <- Input -> GenState (SVariable r)
forall (r :: * -> *).
(SelfSym r, VariableElim r, VariableValue r) =>
Input -> GenState (SVariable r)
mkVar Input
v
  MS (r smt) -> GenState (MS (r smt))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (MS (r smt) -> GenState (MS (r smt)))
-> MS (r smt) -> GenState (MS (r smt))
forall a b. (a -> b) -> a -> b
$ SVariable r -> SValue r -> MS (r smt)
forall (r :: * -> *) smt.
AssignStatement r smt =>
SVariable r -> SValue r -> MS (r smt)
assign SVariable r
v' SValue r
e'
convStmt (FAsgIndex Input
v Integer
i CodeExpr
e) = do
  SValue r
e' <- CodeExpr -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr CodeExpr
e
  SVariable r
v' <- Input -> GenState (SVariable r)
forall (r :: * -> *).
(SelfSym r, VariableElim r, VariableValue r) =>
Input -> GenState (SVariable r)
mkVar Input
v
  CodeType
t <- Input -> StateT DrasilState Identity CodeType
forall c. HasSpace c => c -> StateT DrasilState Identity CodeType
codeType Input
v
  let asgFunc :: CodeType -> MS (r smt)
asgFunc (C.List CodeType
_) = SValue r -> SValue r -> SValue r -> MS (r smt)
forall (r :: * -> *) smt.
List r smt =>
SValue r -> SValue r -> SValue r -> MS (r smt)
listSet (SVariable r -> SValue r
forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
valueOf SVariable r
v') (Integer -> SValue r
forall (r :: * -> *). Literal r => Integer -> SValue r
litInt Integer
i) SValue r
e'
      asgFunc (C.Array CodeType
_) = SVariable r -> SValue r -> MS (r smt)
forall (r :: * -> *) smt.
AssignStatement r smt =>
SVariable r -> SValue r -> MS (r smt)
assign (SValue r -> SValue r -> SVariable r
forall (r :: * -> *).
Array r =>
SValue r -> SValue r -> SVariable r
arrayElem (SVariable r -> SValue r
forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
valueOf SVariable r
v') (Integer -> SValue r
forall (r :: * -> *). Literal r => Integer -> SValue r
litInt Integer
i)) SValue r
e'
      asgFunc CodeType
_ = Name -> MS (r smt)
forall a. HasCallStack => Name -> a
error Name
"FAsgIndex used with non-indexed value"
  MS (r smt) -> GenState (MS (r smt))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (MS (r smt) -> GenState (MS (r smt)))
-> MS (r smt) -> GenState (MS (r smt))
forall a b. (a -> b) -> a -> b
$ CodeType -> MS (r smt)
asgFunc CodeType
t
convStmt (FFor Input
v CodeExpr
start CodeExpr
end CodeExpr
step [FuncStmt]
st) = do
  [MS (r smt)]
stmts <- (FuncStmt -> GenState (MS (r smt)))
-> [FuncStmt] -> StateT DrasilState Identity [MS (r smt)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM FuncStmt -> GenState (MS (r smt))
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
FuncStmt -> GenState (MS (r smt))
convStmt [FuncStmt]
st
  SVariable r
vari <- Input -> GenState (SVariable r)
forall (r :: * -> *).
(SelfSym r, VariableElim r, VariableValue r) =>
Input -> GenState (SVariable r)
mkVar Input
v
  SValue r
start' <- CodeExpr -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr CodeExpr
start
  SValue r
end' <- CodeExpr -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr CodeExpr
end
  SValue r
step' <- CodeExpr -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr CodeExpr
step
  MS (r smt) -> GenState (MS (r smt))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (MS (r smt) -> GenState (MS (r smt)))
-> MS (r smt) -> GenState (MS (r smt))
forall a b. (a -> b) -> a -> b
$ SVariable r
-> SValue r -> SValue r -> SValue r -> MS (r Block) -> MS (r smt)
forall (r :: * -> *) smt.
ControlStatement r smt =>
SVariable r
-> SValue r -> SValue r -> SValue r -> MS (r Block) -> MS (r smt)
forRange SVariable r
vari SValue r
start' SValue r
end' SValue r
step' ([MS (r smt)] -> MS (r Block)
forall (r :: * -> *) smt.
BodySym r smt =>
[MS (r smt)] -> MS (r Block)
bodyStatements [MS (r smt)]
stmts)
convStmt (FForEach Input
v CodeExpr
e [FuncStmt]
st) = do
  [MS (r smt)]
stmts <- (FuncStmt -> GenState (MS (r smt)))
-> [FuncStmt] -> StateT DrasilState Identity [MS (r smt)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM FuncStmt -> GenState (MS (r smt))
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
FuncStmt -> GenState (MS (r smt))
convStmt [FuncStmt]
st
  SVariable r
vari <- Input -> GenState (SVariable r)
forall (r :: * -> *).
(SelfSym r, VariableElim r, VariableValue r) =>
Input -> GenState (SVariable r)
mkVar Input
v
  SValue r
e' <- CodeExpr -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr CodeExpr
e
  MS (r smt) -> GenState (MS (r smt))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (MS (r smt) -> GenState (MS (r smt)))
-> MS (r smt) -> GenState (MS (r smt))
forall a b. (a -> b) -> a -> b
$ SVariable r -> SValue r -> MS (r Block) -> MS (r smt)
forall (r :: * -> *) smt.
ControlStatement r smt =>
SVariable r -> SValue r -> MS (r Block) -> MS (r smt)
forEach SVariable r
vari SValue r
e' ([MS (r smt)] -> MS (r Block)
forall (r :: * -> *) smt.
BodySym r smt =>
[MS (r smt)] -> MS (r Block)
bodyStatements [MS (r smt)]
stmts)
convStmt (FWhile CodeExpr
e [FuncStmt]
st) = do
  [MS (r smt)]
stmts <- (FuncStmt -> GenState (MS (r smt)))
-> [FuncStmt] -> StateT DrasilState Identity [MS (r smt)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM FuncStmt -> GenState (MS (r smt))
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
FuncStmt -> GenState (MS (r smt))
convStmt [FuncStmt]
st
  SValue r
e' <- CodeExpr -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr CodeExpr
e
  MS (r smt) -> GenState (MS (r smt))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (MS (r smt) -> GenState (MS (r smt)))
-> MS (r smt) -> GenState (MS (r smt))
forall a b. (a -> b) -> a -> b
$ SValue r -> MS (r Block) -> MS (r smt)
forall (r :: * -> *) smt.
ControlStatement r smt =>
SValue r -> MS (r Block) -> MS (r smt)
while SValue r
e' ([MS (r smt)] -> MS (r Block)
forall (r :: * -> *) smt.
BodySym r smt =>
[MS (r smt)] -> MS (r Block)
bodyStatements [MS (r smt)]
stmts)
convStmt (FCond CodeExpr
e [FuncStmt]
tSt []) = do
  [MS (r smt)]
stmts <- (FuncStmt -> GenState (MS (r smt)))
-> [FuncStmt] -> StateT DrasilState Identity [MS (r smt)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM FuncStmt -> GenState (MS (r smt))
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
FuncStmt -> GenState (MS (r smt))
convStmt [FuncStmt]
tSt
  SValue r
e' <- CodeExpr -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr CodeExpr
e
  MS (r smt) -> GenState (MS (r smt))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (MS (r smt) -> GenState (MS (r smt)))
-> MS (r smt) -> GenState (MS (r smt))
forall a b. (a -> b) -> a -> b
$ [(SValue r, MS (r Block))] -> MS (r smt)
forall (r :: * -> *) smt.
ControlStatement r smt =>
[(SValue r, MS (r Block))] -> MS (r smt)
ifNoElse [(SValue r
e', [MS (r smt)] -> MS (r Block)
forall (r :: * -> *) smt.
BodySym r smt =>
[MS (r smt)] -> MS (r Block)
bodyStatements [MS (r smt)]
stmts)]
convStmt (FCond CodeExpr
e [FuncStmt]
tSt [FuncStmt]
eSt) = do
  [MS (r smt)]
stmt1 <- (FuncStmt -> GenState (MS (r smt)))
-> [FuncStmt] -> StateT DrasilState Identity [MS (r smt)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM FuncStmt -> GenState (MS (r smt))
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
FuncStmt -> GenState (MS (r smt))
convStmt [FuncStmt]
tSt
  [MS (r smt)]
stmt2 <- (FuncStmt -> GenState (MS (r smt)))
-> [FuncStmt] -> StateT DrasilState Identity [MS (r smt)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM FuncStmt -> GenState (MS (r smt))
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
FuncStmt -> GenState (MS (r smt))
convStmt [FuncStmt]
eSt
  SValue r
e' <- CodeExpr -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr CodeExpr
e
  MS (r smt) -> GenState (MS (r smt))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (MS (r smt) -> GenState (MS (r smt)))
-> MS (r smt) -> GenState (MS (r smt))
forall a b. (a -> b) -> a -> b
$ [(SValue r, MS (r Block))] -> MS (r Block) -> MS (r smt)
forall (r :: * -> *) smt.
ControlStatement r smt =>
[(SValue r, MS (r Block))] -> MS (r Block) -> MS (r smt)
ifCond [(SValue r
e', [MS (r smt)] -> MS (r Block)
forall (r :: * -> *) smt.
BodySym r smt =>
[MS (r smt)] -> MS (r Block)
bodyStatements [MS (r smt)]
stmt1)] ([MS (r smt)] -> MS (r Block)
forall (r :: * -> *) smt.
BodySym r smt =>
[MS (r smt)] -> MS (r Block)
bodyStatements [MS (r smt)]
stmt2)
convStmt (FRet CodeExpr
e) = do
  SValue r
e' <- CodeExpr -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr CodeExpr
e
  MS (r smt) -> GenState (MS (r smt))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (MS (r smt) -> GenState (MS (r smt)))
-> MS (r smt) -> GenState (MS (r smt))
forall a b. (a -> b) -> a -> b
$ SValue r -> MS (r smt)
forall (r :: * -> *) smt.
ControlStatement r smt =>
SValue r -> MS (r smt)
returnStmt SValue r
e'
convStmt (FThrow Name
s) = MS (r smt) -> GenState (MS (r smt))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (MS (r smt) -> GenState (MS (r smt)))
-> MS (r smt) -> GenState (MS (r smt))
forall a b. (a -> b) -> a -> b
$ Name -> MS (r smt)
forall (r :: * -> *) smt.
ControlStatement r smt =>
Name -> MS (r smt)
throw Name
s
convStmt (FTry [FuncStmt]
t [FuncStmt]
c) = do
  [MS (r smt)]
stmt1 <- (FuncStmt -> GenState (MS (r smt)))
-> [FuncStmt] -> StateT DrasilState Identity [MS (r smt)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM FuncStmt -> GenState (MS (r smt))
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
FuncStmt -> GenState (MS (r smt))
convStmt [FuncStmt]
t
  [MS (r smt)]
stmt2 <- (FuncStmt -> GenState (MS (r smt)))
-> [FuncStmt] -> StateT DrasilState Identity [MS (r smt)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM FuncStmt -> GenState (MS (r smt))
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
FuncStmt -> GenState (MS (r smt))
convStmt [FuncStmt]
c
  MS (r smt) -> GenState (MS (r smt))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (MS (r smt) -> GenState (MS (r smt)))
-> MS (r smt) -> GenState (MS (r smt))
forall a b. (a -> b) -> a -> b
$ MS (r Block) -> MS (r Block) -> MS (r smt)
forall (r :: * -> *) smt.
ControlStatement r smt =>
MS (r Block) -> MS (r Block) -> MS (r smt)
tryCatch ([MS (r smt)] -> MS (r Block)
forall (r :: * -> *) smt.
BodySym r smt =>
[MS (r smt)] -> MS (r Block)
bodyStatements [MS (r smt)]
stmt1) ([MS (r smt)] -> MS (r Block)
forall (r :: * -> *) smt.
BodySym r smt =>
[MS (r smt)] -> MS (r Block)
bodyStatements [MS (r smt)]
stmt2)
convStmt FuncStmt
FContinue = MS (r smt) -> GenState (MS (r smt))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return MS (r smt)
forall (r :: * -> *) smt. ControlStatement r smt => MS (r smt)
continue
convStmt (FDecDef Input
v (Matrix [[]])) = do
  DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  let scp :: r ScopeData
scp = ScopeType -> r ScopeData
forall (r :: * -> *). ScopeSym r => ScopeType -> r ScopeData
convScope (ScopeType -> r ScopeData) -> ScopeType -> r ScopeData
forall a b. (a -> b) -> a -> b
$ DrasilState -> ScopeType
currentScope DrasilState
g
  SVariable r
vari <- Input -> GenState (SVariable r)
forall (r :: * -> *).
(SelfSym r, VariableElim r, VariableValue r) =>
Input -> GenState (SVariable r)
mkVar Input
v
  let convDec :: CodeType -> r ScopeData -> MS (r smt)
convDec (C.List CodeType
_) = Integer -> SVariable r -> r ScopeData -> MS (r smt)
forall (r :: * -> *) smt.
DeclStatement r smt =>
Integer -> SVariable r -> r ScopeData -> MS (r smt)
listDec Integer
0 SVariable r
vari
      convDec (C.Array CodeType
_) = Integer -> SValue r -> SVariable r -> r ScopeData -> MS (r smt)
forall (r :: * -> *) smt.
DeclStatement r smt =>
Integer -> SValue r -> SVariable r -> r ScopeData -> MS (r smt)
arrayDec Integer
0 SValue r
forall a. HasCallStack => a
undefined SVariable r
vari
      convDec CodeType
_ = SVariable r -> r ScopeData -> MS (r smt)
forall (r :: * -> *) smt.
DeclStatement r smt =>
SVariable r -> r ScopeData -> MS (r smt)
varDec SVariable r
vari
  (CodeType -> MS (r smt))
-> StateT DrasilState Identity CodeType -> GenState (MS (r smt))
forall a b.
(a -> b)
-> StateT DrasilState Identity a -> StateT DrasilState Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (CodeType -> r ScopeData -> MS (r smt)
`convDec` r ScopeData
scp) (Input -> StateT DrasilState Identity CodeType
forall c. HasSpace c => c -> StateT DrasilState Identity CodeType
codeType Input
v)
convStmt (FDecDef Input
v CodeExpr
e) = do
  DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  let scp :: r ScopeData
scp = ScopeType -> r ScopeData
forall (r :: * -> *). ScopeSym r => ScopeType -> r ScopeData
convScope (ScopeType -> r ScopeData) -> ScopeType -> r ScopeData
forall a b. (a -> b) -> a -> b
$ DrasilState -> ScopeType
currentScope DrasilState
g
  SVariable r
v' <- Input -> GenState (SVariable r)
forall (r :: * -> *).
(SelfSym r, VariableElim r, VariableValue r) =>
Input -> GenState (SVariable r)
mkVar Input
v
  CodeType
t <- Input -> StateT DrasilState Identity CodeType
forall c. HasSpace c => c -> StateT DrasilState Identity CodeType
codeType Input
v
  let convDecDef :: CodeExpr -> GenState (MS (r smt))
convDecDef (Matrix [[CodeExpr]
lst]) = do
        let contDecDef :: CodeType -> SVariable r -> r ScopeData -> [SValue r] -> MS (r smt)
contDecDef (C.List CodeType
_) = SVariable r -> r ScopeData -> [SValue r] -> MS (r smt)
forall (r :: * -> *) smt.
DeclStatement r smt =>
SVariable r -> r ScopeData -> [SValue r] -> MS (r smt)
listDecDef
            contDecDef (C.Array CodeType
_) = SVariable r -> r ScopeData -> [SValue r] -> MS (r smt)
forall (r :: * -> *) smt.
DeclStatement r smt =>
SVariable r -> r ScopeData -> [SValue r] -> MS (r smt)
arrayDecDef
            contDecDef CodeType
_ = Name -> SVariable r -> r ScopeData -> [SValue r] -> MS (r smt)
forall a. HasCallStack => Name -> a
error Name
"Type mismatch between variable and value in declare-define FuncStmt"
        [SValue r]
e' <- (CodeExpr -> StateT DrasilState Identity (SValue r))
-> [CodeExpr] -> StateT DrasilState Identity [SValue r]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM CodeExpr -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr [CodeExpr]
lst
        MS (r smt) -> GenState (MS (r smt))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (MS (r smt) -> GenState (MS (r smt)))
-> MS (r smt) -> GenState (MS (r smt))
forall a b. (a -> b) -> a -> b
$ CodeType -> SVariable r -> r ScopeData -> [SValue r] -> MS (r smt)
forall {r :: * -> *} {smt}.
DeclStatement r smt =>
CodeType -> SVariable r -> r ScopeData -> [SValue r] -> MS (r smt)
contDecDef CodeType
t SVariable r
v' r ScopeData
scp [SValue r]
e'
      convDecDef CodeExpr
_ = do
        SValue r
e' <- CodeExpr -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr CodeExpr
e
        MS (r smt) -> GenState (MS (r smt))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (MS (r smt) -> GenState (MS (r smt)))
-> MS (r smt) -> GenState (MS (r smt))
forall a b. (a -> b) -> a -> b
$ SVariable r -> r ScopeData -> SValue r -> MS (r smt)
forall (r :: * -> *) smt.
DeclStatement r smt =>
SVariable r -> r ScopeData -> SValue r -> MS (r smt)
varDecDef SVariable r
v' r ScopeData
scp SValue r
e'
  CodeExpr -> GenState (MS (r smt))
convDecDef CodeExpr
e
convStmt (FFuncDef CodeFuncChunk
f [ParameterChunk]
ps [FuncStmt]
sts) = do
  DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  let scp :: r ScopeData
scp = ScopeType -> r ScopeData
forall (r :: * -> *). ScopeSym r => ScopeType -> r ScopeData
convScope (ScopeType -> r ScopeData) -> ScopeType -> r ScopeData
forall a b. (a -> b) -> a -> b
$ DrasilState -> ScopeType
currentScope DrasilState
g
  SVariable r
f' <- Input -> GenState (SVariable r)
forall (r :: * -> *).
(SelfSym r, VariableElim r, VariableValue r) =>
Input -> GenState (SVariable r)
mkVar (CodeFuncChunk -> Input
forall c. (Quantity c, MayHaveUnit c, Concept c) => c -> Input
quantvar CodeFuncChunk
f)
  [SVariable r]
pms <- (ParameterChunk -> GenState (SVariable r))
-> [ParameterChunk] -> StateT DrasilState Identity [SVariable r]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Input -> GenState (SVariable r)
forall (r :: * -> *).
(SelfSym r, VariableElim r, VariableValue r) =>
Input -> GenState (SVariable r)
mkVar (Input -> GenState (SVariable r))
-> (ParameterChunk -> Input)
-> ParameterChunk
-> GenState (SVariable r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParameterChunk -> Input
forall c. (Quantity c, MayHaveUnit c, Concept c) => c -> Input
quantvar) [ParameterChunk]
ps
  [MS (r smt)]
b <- (FuncStmt -> GenState (MS (r smt)))
-> [FuncStmt] -> StateT DrasilState Identity [MS (r smt)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM FuncStmt -> GenState (MS (r smt))
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
FuncStmt -> GenState (MS (r smt))
convStmt [FuncStmt]
sts
  MS (r smt) -> GenState (MS (r smt))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (MS (r smt) -> GenState (MS (r smt)))
-> MS (r smt) -> GenState (MS (r smt))
forall a b. (a -> b) -> a -> b
$ SVariable r
-> r ScopeData -> [SVariable r] -> MS (r Block) -> MS (r smt)
forall (r :: * -> *) smt.
DeclStatement r smt =>
SVariable r
-> r ScopeData -> [SVariable r] -> MS (r Block) -> MS (r smt)
funcDecDef SVariable r
f' r ScopeData
scp [SVariable r]
pms ([MS (r smt)] -> MS (r Block)
forall (r :: * -> *) smt.
BodySym r smt =>
[MS (r smt)] -> MS (r Block)
bodyStatements [MS (r smt)]
b)
convStmt (FVal CodeExpr
e) = do
  SValue r
e' <- CodeExpr -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr CodeExpr
e
  MS (r smt) -> GenState (MS (r smt))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (MS (r smt) -> GenState (MS (r smt)))
-> MS (r smt) -> GenState (MS (r smt))
forall a b. (a -> b) -> a -> b
$ SValue r -> MS (r smt)
forall (r :: * -> *) smt.
StatementSym r smt =>
SValue r -> MS (r smt)
valStmt SValue r
e'
convStmt (FMulti [FuncStmt]
ss) = do
  [MS (r smt)]
stmts <- (FuncStmt -> GenState (MS (r smt)))
-> [FuncStmt] -> StateT DrasilState Identity [MS (r smt)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM FuncStmt -> GenState (MS (r smt))
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
FuncStmt -> GenState (MS (r smt))
convStmt [FuncStmt]
ss
  MS (r smt) -> GenState (MS (r smt))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (MS (r smt) -> GenState (MS (r smt)))
-> MS (r smt) -> GenState (MS (r smt))
forall a b. (a -> b) -> a -> b
$ [MS (r smt)] -> MS (r smt)
forall (r :: * -> *) smt.
StatementSym r smt =>
[MS (r smt)] -> MS (r smt)
multi [MS (r smt)]
stmts
convStmt (FAppend CodeExpr
a CodeExpr
b) = do
  SValue r
a' <- CodeExpr -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr CodeExpr
a
  SValue r
b' <- CodeExpr -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr CodeExpr
b
  MS (r smt) -> GenState (MS (r smt))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (MS (r smt) -> GenState (MS (r smt)))
-> MS (r smt) -> GenState (MS (r smt))
forall a b. (a -> b) -> a -> b
$ SValue r -> SValue r -> MS (r smt)
forall (r :: * -> *) smt.
List r smt =>
SValue r -> SValue r -> MS (r smt)
listAppend SValue r
a' SValue r
b'

-- | Generates a function that reads a file whose format is based on the passed
-- 'DataDesc'.
genDataFunc
  :: (OOProg r vis smt md svr att prg)
  => Name -> Description -> DataDesc -> GenState (MS (r md))
genDataFunc :: forall (r :: * -> *) vis smt md svr att prg.
OOProg r vis smt md svr att prg =>
Name -> Name -> DataDesc -> GenState (MS (r md))
genDataFunc Name
nameTitle Name
desc DataDesc
ddef = do
  let parms :: [Input]
parms = DataDesc -> [Input]
getInputs DataDesc
ddef
  [MS (r Block)]
bod <- DataDesc -> GenState [MS (r Block)]
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
DataDesc -> GenState [MS (r Block)]
readData DataDesc
ddef
  Name
-> VS (r TypeData)
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MS (r Block)]
-> GenState (MS (r md))
forall (r :: * -> *) vis smt md svr att prg.
OOProg r vis smt md svr att prg =>
Name
-> VS (r TypeData)
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MS (r Block)]
-> GenState (MS (r md))
publicFunc Name
nameTitle VS (r TypeData)
forall (r :: * -> *). TypeSym r => VS (r TypeData)
void Name
desc ((Input -> ParameterChunk) -> [Input] -> [ParameterChunk]
forall a b. (a -> b) -> [a] -> [b]
map Input -> ParameterChunk
forall c. CodeIdea c => c -> ParameterChunk
pcAuto ([Input] -> [ParameterChunk]) -> [Input] -> [ParameterChunk]
forall a b. (a -> b) -> a -> b
$ DefinedQuantityDict -> Input
forall c. (Quantity c, MayHaveUnit c, Concept c) => c -> Input
quantvar DefinedQuantityDict
inFileName Input -> [Input] -> [Input]
forall a. a -> [a] -> [a]
: [Input]
parms)
    Maybe Name
forall a. Maybe a
Nothing [MS (r Block)]
bod

-- this is really ugly!!
-- | Read from a data description into an 'MS Block' of 'MS Statement's.
readData
  :: (OOStatement r smt, TypeElim r, VariableElim r)
  => DataDesc -> GenState [MS (r Block)]
readData :: forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
DataDesc -> GenState [MS (r Block)]
readData DataDesc
ddef = do
  DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  let localScope :: r ScopeData
localScope = ScopeType -> r ScopeData
forall (r :: * -> *). ScopeSym r => ScopeType -> r ScopeData
convScope (ScopeType -> r ScopeData) -> ScopeType -> r ScopeData
forall a b. (a -> b) -> a -> b
$ DrasilState -> ScopeType
currentScope DrasilState
g
  [[MS (r smt)]]
inD <- (Data -> StateT DrasilState Identity [MS (r smt)])
-> DataDesc -> StateT DrasilState Identity [[MS (r smt)]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Data -> r ScopeData -> StateT DrasilState Identity [MS (r smt)]
forall (r :: * -> *) smt.
(OOStatement r smt, VariableElim r) =>
Data -> r ScopeData -> GenState [MS (r smt)]
`inData` r ScopeData
localScope) DataDesc
ddef
  SValue r
v_filename <- Input -> GenState (SValue r)
forall (r :: * -> *) smt.
(OOStatement r smt, TypeElim r, VariableElim r) =>
Input -> GenState (SValue r)
mkVal (DefinedQuantityDict -> Input
forall c. (Quantity c, MayHaveUnit c, Concept c) => c -> Input
quantvar DefinedQuantityDict
inFileName)
  [MS (r Block)] -> GenState [MS (r Block)]
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return [[MS (r smt)] -> MS (r Block)
forall (r :: * -> *) smt.
BlockSym r smt =>
[MS (r smt)] -> MS (r Block)
block ([MS (r smt)] -> MS (r Block)) -> [MS (r smt)] -> MS (r Block)
forall a b. (a -> b) -> a -> b
$
    SVariable r -> r ScopeData -> MS (r smt)
forall (r :: * -> *) smt.
DeclStatement r smt =>
SVariable r -> r ScopeData -> MS (r smt)
varDec SVariable r
forall (r :: * -> *). VariableSym r => SVariable r
var_infile r ScopeData
localScope MS (r smt) -> [MS (r smt)] -> [MS (r smt)]
forall a. a -> [a] -> [a]
:
    (if (Data -> Bool) -> DataDesc -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Data
d -> Data -> Bool
isLine Data
d Bool -> Bool -> Bool
|| Data -> Bool
isLines Data
d) DataDesc
ddef then [SVariable r -> r ScopeData -> MS (r smt)
forall (r :: * -> *) smt.
DeclStatement r smt =>
SVariable r -> r ScopeData -> MS (r smt)
varDec SVariable r
forall (r :: * -> *). VariableSym r => SVariable r
var_line r ScopeData
localScope,
    Integer -> SVariable r -> r ScopeData -> MS (r smt)
forall (r :: * -> *) smt.
DeclStatement r smt =>
Integer -> SVariable r -> r ScopeData -> MS (r smt)
listDec Integer
0 SVariable r
forall (r :: * -> *). VariableSym r => SVariable r
var_linetokens r ScopeData
localScope ] else []) [MS (r smt)] -> [MS (r smt)] -> [MS (r smt)]
forall a. [a] -> [a] -> [a]
++
    [Integer -> SVariable r -> r ScopeData -> MS (r smt)
forall (r :: * -> *) smt.
DeclStatement r smt =>
Integer -> SVariable r -> r ScopeData -> MS (r smt)
listDec Integer
0 SVariable r
forall (r :: * -> *). VariableSym r => SVariable r
var_lines r ScopeData
localScope | (Data -> Bool) -> DataDesc -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Data -> Bool
isLines DataDesc
ddef] [MS (r smt)] -> [MS (r smt)] -> [MS (r smt)]
forall a. [a] -> [a] -> [a]
++ SVariable r -> SValue r -> MS (r smt)
forall (r :: * -> *) smt.
IOStatement r smt =>
SVariable r -> SValue r -> MS (r smt)
openFileR SVariable r
forall (r :: * -> *). VariableSym r => SVariable r
var_infile
    SValue r
v_filename MS (r smt) -> [MS (r smt)] -> [MS (r smt)]
forall a. a -> [a] -> [a]
: [[MS (r smt)]] -> [MS (r smt)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[MS (r smt)]]
inD [MS (r smt)] -> [MS (r smt)] -> [MS (r smt)]
forall a. [a] -> [a] -> [a]
++ [SValue r -> MS (r smt)
forall (r :: * -> *) smt.
IOStatement r smt =>
SValue r -> MS (r smt)
closeFile SValue r
forall (r :: * -> *). VariableValue r => SValue r
v_infile]]
  where inData
          :: (OOStatement r smt, VariableElim r)
          => Data -> r ScopeData -> GenState [MS (r smt)]
        inData :: forall (r :: * -> *) smt.
(OOStatement r smt, VariableElim r) =>
Data -> r ScopeData -> GenState [MS (r smt)]
inData (Singleton Input
v) r ScopeData
_ = do
            SVariable r
vv <- Input -> GenState (SVariable r)
forall (r :: * -> *).
(SelfSym r, VariableElim r, VariableValue r) =>
Input -> GenState (SVariable r)
mkVar Input
v
            [MS (r smt)] -> GenState [MS (r smt)]
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return [SValue r -> SVariable r -> MS (r smt)
forall (r :: * -> *) smt.
IOStatement r smt =>
SValue r -> SVariable r -> MS (r smt)
getFileInput SValue r
forall (r :: * -> *). VariableValue r => SValue r
v_infile SVariable r
vv]
        inData Data
JunkData r ScopeData
_ = [MS (r smt)] -> GenState [MS (r smt)]
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return [SValue r -> MS (r smt)
forall (r :: * -> *) smt.
IOStatement r smt =>
SValue r -> MS (r smt)
discardFileLine SValue r
forall (r :: * -> *). VariableValue r => SValue r
v_infile]
        inData (Line LinePattern
lp Char
d) r ScopeData
scp = do
          [MS (r smt)]
lnI <- Maybe Name -> LinePattern -> r ScopeData -> GenState [MS (r smt)]
forall (r :: * -> *) smt.
(OOStatement r smt, VariableElim r) =>
Maybe Name -> LinePattern -> r ScopeData -> GenState [MS (r smt)]
lineData Maybe Name
forall a. Maybe a
Nothing LinePattern
lp r ScopeData
scp
          [MS (r smt)] -> GenState [MS (r smt)]
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([MS (r smt)] -> GenState [MS (r smt)])
-> [MS (r smt)] -> GenState [MS (r smt)]
forall a b. (a -> b) -> a -> b
$ [SValue r -> SVariable r -> MS (r smt)
forall (r :: * -> *) smt.
IOStatement r smt =>
SValue r -> SVariable r -> MS (r smt)
getFileInputLine SValue r
forall (r :: * -> *). VariableValue r => SValue r
v_infile SVariable r
forall (r :: * -> *). VariableSym r => SVariable r
var_line,
            Char -> SVariable r -> SValue r -> MS (r smt)
forall (r :: * -> *) smt.
StringStatement r smt =>
Char -> SVariable r -> SValue r -> MS (r smt)
stringSplit Char
d SVariable r
forall (r :: * -> *). VariableSym r => SVariable r
var_linetokens SValue r
forall (r :: * -> *). VariableValue r => SValue r
v_line] [MS (r smt)] -> [MS (r smt)] -> [MS (r smt)]
forall a. [a] -> [a] -> [a]
++ [MS (r smt)]
lnI
        inData (Lines LinePattern
lp Maybe Integer
ls Char
d) r ScopeData
scp = do
          [MS (r smt)]
lnV <- Maybe Name -> LinePattern -> r ScopeData -> GenState [MS (r smt)]
forall (r :: * -> *) smt.
(OOStatement r smt, VariableElim r) =>
Maybe Name -> LinePattern -> r ScopeData -> GenState [MS (r smt)]
lineData (Name -> Maybe Name
forall a. a -> Maybe a
Just Name
"_temp") LinePattern
lp r ScopeData
scp
          let readLines :: Maybe Integer -> [MS (r smt)]
readLines Maybe Integer
Nothing = [SValue r -> SVariable r -> MS (r smt)
forall (r :: * -> *) smt.
IOStatement r smt =>
SValue r -> SVariable r -> MS (r smt)
getFileInputAll SValue r
forall (r :: * -> *). VariableValue r => SValue r
v_infile SVariable r
forall (r :: * -> *). VariableSym r => SVariable r
var_lines,
                SVariable r
-> SValue r -> SValue r -> SValue r -> MS (r Block) -> MS (r smt)
forall (r :: * -> *) smt.
ControlStatement r smt =>
SVariable r
-> SValue r -> SValue r -> SValue r -> MS (r Block) -> MS (r smt)
forRange SVariable r
forall (r :: * -> *). VariableSym r => SVariable r
var_i (Integer -> SValue r
forall (r :: * -> *). Literal r => Integer -> SValue r
litInt Integer
0) (SValue r -> SValue r
forall (r :: * -> *) smt. List r smt => SValue r -> SValue r
listSize SValue r
forall (r :: * -> *). VariableValue r => SValue r
v_lines) (Integer -> SValue r
forall (r :: * -> *). Literal r => Integer -> SValue r
litInt Integer
1)
                  ([MS (r smt)] -> MS (r Block)
forall (r :: * -> *) smt.
BodySym r smt =>
[MS (r smt)] -> MS (r Block)
bodyStatements ([MS (r smt)] -> MS (r Block)) -> [MS (r smt)] -> MS (r Block)
forall a b. (a -> b) -> a -> b
$ Char -> SVariable r -> SValue r -> MS (r smt)
forall (r :: * -> *) smt.
StringStatement r smt =>
Char -> SVariable r -> SValue r -> MS (r smt)
stringSplit Char
d SVariable r
forall (r :: * -> *). VariableSym r => SVariable r
var_linetokens (
                  SValue r -> SValue r -> SValue r
forall (r :: * -> *) smt.
List r smt =>
SValue r -> SValue r -> SValue r
listAccess SValue r
forall (r :: * -> *). VariableValue r => SValue r
v_lines SValue r
forall (r :: * -> *). VariableValue r => SValue r
v_i) MS (r smt) -> [MS (r smt)] -> [MS (r smt)]
forall a. a -> [a] -> [a]
: [MS (r smt)]
lnV)]
              readLines (Just Integer
numLines) = [SVariable r
-> SValue r -> SValue r -> SValue r -> MS (r Block) -> MS (r smt)
forall (r :: * -> *) smt.
ControlStatement r smt =>
SVariable r
-> SValue r -> SValue r -> SValue r -> MS (r Block) -> MS (r smt)
forRange SVariable r
forall (r :: * -> *). VariableSym r => SVariable r
var_i (Integer -> SValue r
forall (r :: * -> *). Literal r => Integer -> SValue r
litInt Integer
0)
                (Integer -> SValue r
forall (r :: * -> *). Literal r => Integer -> SValue r
litInt Integer
numLines) (Integer -> SValue r
forall (r :: * -> *). Literal r => Integer -> SValue r
litInt Integer
1)
                ([MS (r smt)] -> MS (r Block)
forall (r :: * -> *) smt.
BodySym r smt =>
[MS (r smt)] -> MS (r Block)
bodyStatements ([MS (r smt)] -> MS (r Block)) -> [MS (r smt)] -> MS (r Block)
forall a b. (a -> b) -> a -> b
$
                  [SValue r -> SVariable r -> MS (r smt)
forall (r :: * -> *) smt.
IOStatement r smt =>
SValue r -> SVariable r -> MS (r smt)
getFileInputLine SValue r
forall (r :: * -> *). VariableValue r => SValue r
v_infile SVariable r
forall (r :: * -> *). VariableSym r => SVariable r
var_line,
                   Char -> SVariable r -> SValue r -> MS (r smt)
forall (r :: * -> *) smt.
StringStatement r smt =>
Char -> SVariable r -> SValue r -> MS (r smt)
stringSplit Char
d SVariable r
forall (r :: * -> *). VariableSym r => SVariable r
var_linetokens SValue r
forall (r :: * -> *). VariableValue r => SValue r
v_line
                  ] [MS (r smt)] -> [MS (r smt)] -> [MS (r smt)]
forall a. [a] -> [a] -> [a]
++ [MS (r smt)]
lnV)]
          [MS (r smt)] -> GenState [MS (r smt)]
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([MS (r smt)] -> GenState [MS (r smt)])
-> [MS (r smt)] -> GenState [MS (r smt)]
forall a b. (a -> b) -> a -> b
$ Maybe Integer -> [MS (r smt)]
readLines Maybe Integer
ls
        ---------------
        lineData
          :: (OOStatement r smt, VariableElim r)
          => Maybe String -> LinePattern -> r ScopeData -> GenState [MS (r smt)]
        lineData :: forall (r :: * -> *) smt.
(OOStatement r smt, VariableElim r) =>
Maybe Name -> LinePattern -> r ScopeData -> GenState [MS (r smt)]
lineData Maybe Name
s p :: LinePattern
p@(Straight [Input]
_) r ScopeData
_ = do
          [SVariable r]
vs <- Maybe Name -> LinePattern -> GenState [SVariable r]
forall (r :: * -> *).
(SelfSym r, VariableElim r, VariableValue r) =>
Maybe Name -> LinePattern -> GenState [SVariable r]
getEntryVars Maybe Name
s LinePattern
p
          [MS (r smt)] -> GenState [MS (r smt)]
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return [[SVariable r] -> SValue r -> MS (r smt)
forall (r :: * -> *) smt.
StringStatement r smt =>
[SVariable r] -> SValue r -> MS (r smt)
stringListVals [SVariable r]
vs SValue r
forall (r :: * -> *). VariableValue r => SValue r
v_linetokens]
        lineData Maybe Name
s p :: LinePattern
p@(Repeat [Input]
ds) r ScopeData
scp = do
          [SVariable r]
vs <- Maybe Name -> LinePattern -> GenState [SVariable r]
forall (r :: * -> *).
(SelfSym r, VariableElim r, VariableValue r) =>
Maybe Name -> LinePattern -> GenState [SVariable r]
getEntryVars Maybe Name
s LinePattern
p
          [StateT DrasilState Identity (MS (r smt))] -> GenState [MS (r smt)]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ([StateT DrasilState Identity (MS (r smt))]
 -> GenState [MS (r smt)])
-> [StateT DrasilState Identity (MS (r smt))]
-> GenState [MS (r smt)]
forall a b. (a -> b) -> a -> b
$ Maybe Name
-> [Input]
-> r ScopeData
-> [StateT DrasilState Identity (MS (r smt))]
forall (r :: * -> *) smt.
OODeclStatement r smt =>
Maybe Name -> [Input] -> r ScopeData -> [GenState (MS (r smt))]
clearTemps Maybe Name
s [Input]
ds r ScopeData
scp [StateT DrasilState Identity (MS (r smt))]
-> [StateT DrasilState Identity (MS (r smt))]
-> [StateT DrasilState Identity (MS (r smt))]
forall a. [a] -> [a] -> [a]
++ MS (r smt) -> StateT DrasilState Identity (MS (r smt))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return
            ([SVariable r] -> SValue r -> MS (r smt)
forall (r :: * -> *) smt.
StringStatement r smt =>
[SVariable r] -> SValue r -> MS (r smt)
stringListLists [SVariable r]
vs SValue r
forall (r :: * -> *). VariableValue r => SValue r
v_linetokens) StateT DrasilState Identity (MS (r smt))
-> [StateT DrasilState Identity (MS (r smt))]
-> [StateT DrasilState Identity (MS (r smt))]
forall a. a -> [a] -> [a]
: Maybe Name -> [Input] -> [StateT DrasilState Identity (MS (r smt))]
forall (r :: * -> *) smt.
(List r smt, OOVariableValue r) =>
Maybe Name -> [Input] -> [GenState (MS (r smt))]
appendTemps Maybe Name
s [Input]
ds
        ---------------
        clearTemps
          :: (OODeclStatement r smt)
          => Maybe String -> [DataItem] -> r ScopeData -> [GenState (MS (r smt))]
        clearTemps :: forall (r :: * -> *) smt.
OODeclStatement r smt =>
Maybe Name -> [Input] -> r ScopeData -> [GenState (MS (r smt))]
clearTemps Maybe Name
Nothing    [Input]
_  r ScopeData
_   = []
        clearTemps (Just Name
sfx) [Input]
es r ScopeData
scp = (Input -> GenState (MS (r smt)))
-> [Input] -> [GenState (MS (r smt))]
forall a b. (a -> b) -> [a] -> [b]
map (\Input
v -> Name -> Input -> r ScopeData -> GenState (MS (r smt))
forall (r :: * -> *) smt.
OODeclStatement r smt =>
Name -> Input -> r ScopeData -> GenState (MS (r smt))
clearTemp Name
sfx Input
v r ScopeData
scp) [Input]
es
        ---------------
        clearTemp
          :: (OODeclStatement r smt)
          => String -> DataItem -> r ScopeData -> GenState (MS (r smt))
        clearTemp :: forall (r :: * -> *) smt.
OODeclStatement r smt =>
Name -> Input -> r ScopeData -> GenState (MS (r smt))
clearTemp Name
sfx Input
v r ScopeData
scp = (CodeType -> MS (r smt))
-> StateT DrasilState Identity CodeType
-> StateT DrasilState Identity (MS (r smt))
forall a b.
(a -> b)
-> StateT DrasilState Identity a -> StateT DrasilState Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\CodeType
t -> SVariable r -> r ScopeData -> [SValue r] -> MS (r smt)
forall (r :: * -> *) smt.
DeclStatement r smt =>
SVariable r -> r ScopeData -> [SValue r] -> MS (r smt)
listDecDef (Name -> VS (r TypeData) -> SVariable r
forall (r :: * -> *).
VariableSym r =>
Name -> VS (r TypeData) -> SVariable r
var (Input -> Name
forall c. CodeIdea c => c -> Name
codeName Input
v Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Name
sfx)
          (VS (r TypeData) -> VS (r TypeData)
forall (r :: * -> *).
TypeSym r =>
VS (r TypeData) -> VS (r TypeData)
innerType (VS (r TypeData) -> VS (r TypeData))
-> VS (r TypeData) -> VS (r TypeData)
forall a b. (a -> b) -> a -> b
$ CodeType -> VS (r TypeData)
forall (r :: * -> *). OOTypeSym r => CodeType -> VS (r TypeData)
convTypeOO CodeType
t)) r ScopeData
scp []) (Input -> StateT DrasilState Identity CodeType
forall c. HasSpace c => c -> StateT DrasilState Identity CodeType
codeType Input
v)
        ---------------
        appendTemps
          :: (List r smt, OOVariableValue r)
          => Maybe String -> [DataItem] -> [GenState (MS (r smt))]
        appendTemps :: forall (r :: * -> *) smt.
(List r smt, OOVariableValue r) =>
Maybe Name -> [Input] -> [GenState (MS (r smt))]
appendTemps Maybe Name
Nothing [Input]
_ = []
        appendTemps (Just Name
sfx) [Input]
es = (Input -> GenState (MS (r smt)))
-> [Input] -> [GenState (MS (r smt))]
forall a b. (a -> b) -> [a] -> [b]
map (Name -> Input -> GenState (MS (r smt))
forall (r :: * -> *) smt.
(List r smt, OOVariableValue r) =>
Name -> Input -> GenState (MS (r smt))
appendTemp Name
sfx) [Input]
es
        ---------------
        appendTemp
          :: (List r smt, OOVariableValue r)
          => String -> DataItem -> GenState (MS (r smt))
        appendTemp :: forall (r :: * -> *) smt.
(List r smt, OOVariableValue r) =>
Name -> Input -> GenState (MS (r smt))
appendTemp Name
sfx Input
v = (CodeType -> MS (r smt))
-> StateT DrasilState Identity CodeType
-> StateT DrasilState Identity (MS (r smt))
forall a b.
(a -> b)
-> StateT DrasilState Identity a -> StateT DrasilState Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\CodeType
t -> SValue r -> SValue r -> MS (r smt)
forall (r :: * -> *) smt.
List r smt =>
SValue r -> SValue r -> MS (r smt)
listAppend
          (SVariable r -> SValue r
forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
valueOf (SVariable r -> SValue r) -> SVariable r -> SValue r
forall a b. (a -> b) -> a -> b
$ Name -> VS (r TypeData) -> SVariable r
forall (r :: * -> *).
VariableSym r =>
Name -> VS (r TypeData) -> SVariable r
var (Input -> Name
forall c. CodeIdea c => c -> Name
codeName Input
v) (CodeType -> VS (r TypeData)
forall (r :: * -> *). OOTypeSym r => CodeType -> VS (r TypeData)
convTypeOO CodeType
t))
          (SVariable r -> SValue r
forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
valueOf (SVariable r -> SValue r) -> SVariable r -> SValue r
forall a b. (a -> b) -> a -> b
$ Name -> VS (r TypeData) -> SVariable r
forall (r :: * -> *).
VariableSym r =>
Name -> VS (r TypeData) -> SVariable r
var (Input -> Name
forall c. CodeIdea c => c -> Name
codeName Input
v Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Name
sfx) (CodeType -> VS (r TypeData)
forall (r :: * -> *). OOTypeSym r => CodeType -> VS (r TypeData)
convTypeOO CodeType
t))) (Input -> StateT DrasilState Identity CodeType
forall c. HasSpace c => c -> StateT DrasilState Identity CodeType
codeType Input
v)

-- | Get entry variables.
getEntryVars :: (SelfSym r, VariableElim r, VariableValue r) =>
  Maybe String -> LinePattern -> GenState [SVariable r]
getEntryVars :: forall (r :: * -> *).
(SelfSym r, VariableElim r, VariableValue r) =>
Maybe Name -> LinePattern -> GenState [SVariable r]
getEntryVars Maybe Name
s LinePattern
lp = (Input -> StateT DrasilState Identity (SVariable r))
-> [Input] -> StateT DrasilState Identity [SVariable r]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((Input -> StateT DrasilState Identity (SVariable r))
-> (Name -> Input -> StateT DrasilState Identity (SVariable r))
-> Maybe Name
-> Input
-> StateT DrasilState Identity (SVariable r)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Input -> StateT DrasilState Identity (SVariable r)
forall (r :: * -> *).
(SelfSym r, VariableElim r, VariableValue r) =>
Input -> GenState (SVariable r)
mkVar (\Name
st Input
v -> Input -> StateT DrasilState Identity CodeType
forall c. HasSpace c => c -> StateT DrasilState Identity CodeType
codeType Input
v StateT DrasilState Identity CodeType
-> (CodeType -> StateT DrasilState Identity (SVariable r))
-> StateT DrasilState Identity (SVariable r)
forall a b.
StateT DrasilState Identity a
-> (a -> StateT DrasilState Identity b)
-> StateT DrasilState Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
  (Name
-> VS (r TypeData) -> StateT DrasilState Identity (SVariable r)
forall (r :: * -> *).
(SelfSym r, VariableElim r, VariableValue r) =>
Name -> VS (r TypeData) -> GenState (SVariable r)
variable (Input -> Name
forall c. CodeIdea c => c -> Name
codeName Input
v Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Name
st) (VS (r TypeData) -> StateT DrasilState Identity (SVariable r))
-> (CodeType -> VS (r TypeData))
-> CodeType
-> StateT DrasilState Identity (SVariable r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VS (r TypeData) -> VS (r TypeData)
forall (r :: * -> *).
TypeSym r =>
VS (r TypeData) -> VS (r TypeData)
innerType (VS (r TypeData) -> VS (r TypeData))
-> (CodeType -> VS (r TypeData)) -> CodeType -> VS (r TypeData)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CodeType -> VS (r TypeData)
forall (r :: * -> *). OOTypeSym r => CodeType -> VS (r TypeData)
convTypeOO))
    Maybe Name
s) (LinePattern -> [Input]
getPatternInputs LinePattern
lp)

-- Procedural Versions --

-- | If 'UID' for the variable is matched to a concept, call 'conceptToGOOL' to get
-- the GOOL code for the concept, and return.
-- If 'UID' is for a constant and user has chosen 'Inline', convert the constant's
-- defining 'Expr' to a value with 'convExpr'.
-- Otherwise, just a regular variable: construct it by calling the variable, then
-- call 'valueOf' to reference its value.
valueProc
  :: (NativeVector r, SharedStatement r smt, TypeElim r)
  => UID -> Name -> VS (r TypeData) -> GenState (SValue r)
valueProc :: forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
UID -> Name -> VS (r TypeData) -> GenState (SValue r)
valueProc UID
u Name
s VS (r TypeData)
t = do
  DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  let cs :: DrasilState
cs = DrasilState
g
      mm :: ConstantMap
mm = DrasilState
cs DrasilState
-> Getting ConstantMap DrasilState ConstantMap -> ConstantMap
forall s a. s -> Getting a s a -> a
^. Getting ConstantMap DrasilState ConstantMap
forall c. HasCodeSpec c => Lens' c ConstantMap
Lens' DrasilState ConstantMap
constMap
      constDef :: Maybe CodeDefinition
constDef = do
        CodeDefinition
cd <- UID -> ConstantMap -> Maybe CodeDefinition
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup UID
u ConstantMap
mm
        ConstantStructure -> CodeDefinition -> Maybe CodeDefinition
forall {a}. ConstantStructure -> a -> Maybe a
maybeInline (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) CodeDefinition
cd
      maybeInline :: ConstantStructure -> a -> Maybe a
maybeInline ConstantStructure
Inline a
m = a -> Maybe a
forall a. a -> Maybe a
Just a
m
      maybeInline ConstantStructure
_ a
_ = Maybe a
forall a. Maybe a
Nothing
      cm :: MatchedConceptMap
cm = DrasilState
g DrasilState
-> Getting MatchedConceptMap DrasilState MatchedConceptMap
-> MatchedConceptMap
forall s a. s -> Getting a s a -> a
^. Getting MatchedConceptMap DrasilState MatchedConceptMap
forall a. HasChoices a => Lens' a MatchedConceptMap
Lens' DrasilState MatchedConceptMap
concMatches
      cdCncpt :: Maybe CodeConcept
cdCncpt = UID -> MatchedConceptMap -> Maybe CodeConcept
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup UID
u MatchedConceptMap
cm
  SValue r
val <- GenState (SValue r)
-> (CodeDefinition -> GenState (SValue r))
-> Maybe CodeDefinition
-> GenState (SValue r)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (SVariable r -> SValue r
forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
valueOf (SVariable r -> SValue r)
-> StateT DrasilState Identity (SVariable r) -> GenState (SValue r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name
-> VS (r TypeData) -> StateT DrasilState Identity (SVariable r)
forall (r :: * -> *).
VariableSym r =>
Name -> VS (r TypeData) -> GenState (SVariable r)
variableProc Name
s VS (r TypeData)
t)
                (CodeExpr -> GenState (SValue r)
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc (CodeExpr -> GenState (SValue r))
-> (CodeDefinition -> CodeExpr)
-> CodeDefinition
-> GenState (SValue r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CodeDefinition
-> Getting CodeExpr CodeDefinition CodeExpr -> CodeExpr
forall s a. s -> Getting a s a -> a
^. Getting CodeExpr CodeDefinition CodeExpr
forall c. DefiningCodeExpr c => Lens' c CodeExpr
Lens' CodeDefinition CodeExpr
codeExpr)) Maybe CodeDefinition
constDef
  SValue r -> GenState (SValue r)
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (SValue r -> GenState (SValue r))
-> SValue r -> GenState (SValue r)
forall a b. (a -> b) -> a -> b
$ SValue r
-> (CodeConcept -> SValue r) -> Maybe CodeConcept -> SValue r
forall b a. b -> (a -> b) -> Maybe a -> b
maybe SValue r
val CodeConcept -> SValue r
forall (r :: * -> *). MathConstant r => CodeConcept -> SValue r
conceptToGOOL Maybe CodeConcept
cdCncpt

-- | If variable is an input, construct it with 'var' and pass to inputVariable.
-- If variable is a constant and 'Var' constant representation is chosen,
-- construct it with 'var' and pass to 'constVariable'.
-- If variable is a constant and 'Const' constant representation is chosen,
-- construct it with 'constant' and pass to 'constVariable'.
-- If variable is neither, just construct it with 'var' and return it.
variableProc :: (VariableSym r) => Name -> VS (r TypeData) -> GenState (SVariable r)
variableProc :: forall (r :: * -> *).
VariableSym r =>
Name -> VS (r TypeData) -> GenState (SVariable r)
variableProc Name
s VS (r TypeData)
t = do
  DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  let cs :: DrasilState
cs = DrasilState
g
      defFunc :: ConstantRepr -> Name -> VS (r TypeData) -> SVariable r
defFunc ConstantRepr
Var = Name -> VS (r TypeData) -> SVariable r
forall (r :: * -> *).
VariableSym r =>
Name -> VS (r TypeData) -> SVariable r
var
      defFunc ConstantRepr
Const = Name -> VS (r TypeData) -> SVariable r
forall (r :: * -> *).
VariableSym r =>
Name -> VS (r TypeData) -> SVariable r
constant -- This might be wrong
  if Name
s Name -> [Name] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (Input -> Name) -> [Input] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map Input -> Name
forall c. CodeIdea c => c -> Name
codeName (DrasilState
cs 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)
    then Structure -> ConstantRepr -> SVariable r -> GenState (SVariable r)
forall (r :: * -> *).
VariableSym r =>
Structure -> ConstantRepr -> SVariable r -> GenState (SVariable r)
inputVariableProc (DrasilState
g DrasilState -> Getting Structure DrasilState Structure -> Structure
forall s a. s -> Getting a s a -> a
^. Getting Structure DrasilState Structure
forall a. HasChoices a => Lens' a Structure
Lens' DrasilState Structure
inStruct) ConstantRepr
Var (Name -> VS (r TypeData) -> SVariable r
forall (r :: * -> *).
VariableSym r =>
Name -> VS (r TypeData) -> SVariable r
var Name
s VS (r TypeData)
t)
    else if Name
s Name -> [Name] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (CodeDefinition -> Name) -> [CodeDefinition] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map CodeDefinition -> Name
forall c. CodeIdea c => c -> Name
codeName (DrasilState
cs DrasilState
-> Getting [CodeDefinition] DrasilState [CodeDefinition]
-> [CodeDefinition]
forall s a. s -> Getting a s a -> a
^. Getting [CodeDefinition] DrasilState [CodeDefinition]
forall c. HasCodeSpec c => Lens' c [CodeDefinition]
Lens' DrasilState [CodeDefinition]
constDefns)
      then ConstantStructure
-> ConstantRepr -> SVariable r -> GenState (SVariable r)
forall (r :: * -> *).
VariableSym r =>
ConstantStructure
-> ConstantRepr -> SVariable r -> GenState (SVariable r)
constVariableProc (DrasilState
g DrasilState
-> Getting ConstantStructure DrasilState ConstantStructure
-> ConstantStructure
forall s a. s -> Getting a s a -> a
^. Getting ConstantStructure DrasilState ConstantStructure
forall a. HasChoices a => Lens' a ConstantStructure
Lens' DrasilState ConstantStructure
conStruct) (DrasilState
g DrasilState
-> Getting 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)
              ((ConstantRepr -> Name -> VS (r TypeData) -> SVariable r
forall {r :: * -> *}.
VariableSym r =>
ConstantRepr -> Name -> VS (r TypeData) -> SVariable r
defFunc (ConstantRepr -> Name -> VS (r TypeData) -> SVariable r)
-> ConstantRepr -> Name -> VS (r TypeData) -> SVariable r
forall a b. (a -> b) -> a -> b
$ 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) Name
s VS (r TypeData)
t)
      else SVariable r -> GenState (SVariable r)
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (SVariable r -> GenState (SVariable r))
-> SVariable r -> GenState (SVariable r)
forall a b. (a -> b) -> a -> b
$ Name -> VS (r TypeData) -> SVariable r
forall (r :: * -> *).
VariableSym r =>
Name -> VS (r TypeData) -> SVariable r
var Name
s VS (r TypeData)
t

-- | If 'Unbundled' inputs, just return variable as-is.
-- If 'Bundled' inputs, throw an error, since procedural renderers
-- don't support 'Bundled' inputs yet.
inputVariableProc :: (VariableSym r) => Structure -> ConstantRepr -> SVariable r ->
  GenState (SVariable r)
inputVariableProc :: forall (r :: * -> *).
VariableSym r =>
Structure -> ConstantRepr -> SVariable r -> GenState (SVariable r)
inputVariableProc Structure
Unbundled ConstantRepr
_ SVariable r
v = SVariable r -> StateT DrasilState Identity (SVariable r)
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return SVariable r
v
inputVariableProc Structure
Bundled ConstantRepr
_ SVariable r
_ = Name -> StateT DrasilState Identity (SVariable r)
forall a. HasCallStack => Name -> a
error Name
"inputVariableProc: Procedural renderers do not support bundled inputs"

-- | If 'Unbundled' constants, just return variable as-is.
-- If 'Bundled' constants, throw an error, since procedural renderers
-- don't support 'Bundled' constants yet.
-- If constants stored 'WithInputs', call 'inputVariable'.
-- If constants are 'Inline'd, the generator should not be attempting to make a
-- variable for one of the constants.
constVariableProc :: (VariableSym r) => ConstantStructure -> ConstantRepr ->
  SVariable r -> GenState (SVariable r)
constVariableProc :: forall (r :: * -> *).
VariableSym r =>
ConstantStructure
-> ConstantRepr -> SVariable r -> GenState (SVariable r)
constVariableProc (Store Structure
Unbundled) ConstantRepr
_ SVariable r
v = SVariable r -> StateT DrasilState Identity (SVariable r)
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return SVariable r
v
constVariableProc (Store Structure
Bundled) ConstantRepr
_ SVariable r
_ = Name -> StateT DrasilState Identity (SVariable r)
forall a. HasCallStack => Name -> a
error Name
"constVariableProc: Procedural renderers do not support bundled constants"
constVariableProc ConstantStructure
WithInputs ConstantRepr
cr SVariable r
v = do
  DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  Structure
-> ConstantRepr
-> SVariable r
-> StateT DrasilState Identity (SVariable r)
forall (r :: * -> *).
VariableSym r =>
Structure -> ConstantRepr -> SVariable r -> GenState (SVariable r)
inputVariableProc (DrasilState
g DrasilState -> Getting Structure DrasilState Structure -> Structure
forall s a. s -> Getting a s a -> a
^. Getting Structure DrasilState Structure
forall a. HasChoices a => Lens' a Structure
Lens' DrasilState Structure
inStruct) ConstantRepr
cr SVariable r
v
constVariableProc ConstantStructure
Inline ConstantRepr
_ SVariable r
_ = Name -> StateT DrasilState Identity (SVariable r)
forall a. HasCallStack => Name -> a
error (Name -> StateT DrasilState Identity (SVariable r))
-> Name -> StateT DrasilState Identity (SVariable r)
forall a b. (a -> b) -> a -> b
$ Name
"mkVar called on a constant, but user " Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++
  Name
"chose to Inline constants. Generator has a bug."

-- | Generates a GOOL Value for a variable represented by a 'CodeVarChunk'.
mkValProc
  :: (NativeVector r, SharedStatement r smt, TypeElim r)
  => CodeVarChunk -> GenState (SValue r)
mkValProc :: forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
Input -> GenState (SValue r)
mkValProc Input
v = do
  CodeType
t <- Input -> StateT DrasilState Identity CodeType
forall c. HasSpace c => c -> StateT DrasilState Identity CodeType
codeType Input
v
  let toGOOLVal :: Maybe a -> GenState (SValue r)
toGOOLVal Maybe a
Nothing = UID -> Name -> VS (r TypeData) -> GenState (SValue r)
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
UID -> Name -> VS (r TypeData) -> GenState (SValue r)
valueProc (Input
v 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) (Input -> Name
forall c. CodeIdea c => c -> Name
codeName Input
v) (CodeType -> VS (r TypeData)
forall (r :: * -> *). TypeSym r => CodeType -> VS (r TypeData)
convType CodeType
t)
      toGOOLVal (Just a
_) = Name -> GenState (SValue r)
forall a. HasCallStack => Name -> a
error Name
"mkValProc: Procedural renderers do not support objects"
  Maybe CodeChunk -> GenState (SValue r)
forall {r :: * -> *} {smt} {a}.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
Maybe a -> GenState (SValue r)
toGOOLVal (Input
v Input
-> Getting (Maybe CodeChunk) Input (Maybe CodeChunk)
-> Maybe CodeChunk
forall s a. s -> Getting a s a -> a
^. Getting (Maybe CodeChunk) Input (Maybe CodeChunk)
Lens' Input (Maybe CodeChunk)
obv)

-- | Generates a GOOL Variable for a variable represented by a 'CodeVarChunk'.
mkVarProc :: (VariableSym r) => CodeVarChunk -> GenState (SVariable r)
mkVarProc :: forall (r :: * -> *).
VariableSym r =>
Input -> GenState (SVariable r)
mkVarProc Input
v = do
  CodeType
t <- Input -> StateT DrasilState Identity CodeType
forall c. HasSpace c => c -> StateT DrasilState Identity CodeType
codeType Input
v
  let toGOOLVar :: Maybe a -> GenState (SVariable r)
toGOOLVar Maybe a
Nothing = Name -> VS (r TypeData) -> GenState (SVariable r)
forall (r :: * -> *).
VariableSym r =>
Name -> VS (r TypeData) -> GenState (SVariable r)
variableProc (Input -> Name
forall c. CodeIdea c => c -> Name
codeName Input
v) (CodeType -> VS (r TypeData)
forall (r :: * -> *). TypeSym r => CodeType -> VS (r TypeData)
convType CodeType
t)
      toGOOLVar (Just a
_) = Name -> GenState (SVariable r)
forall a. HasCallStack => Name -> a
error Name
"mkVarProc: Procedural renderers do not support objects"
  Maybe CodeChunk -> GenState (SVariable r)
forall {r :: * -> *} {a}.
VariableSym r =>
Maybe a -> GenState (SVariable r)
toGOOLVar (Input
v Input
-> Getting (Maybe CodeChunk) Input (Maybe CodeChunk)
-> Maybe CodeChunk
forall s a. s -> Getting a s a -> a
^. Getting (Maybe CodeChunk) Input (Maybe CodeChunk)
Lens' Input (Maybe CodeChunk)
obv)

-- | Converts a 'Mod' to GOOL.
genModDefProc
  :: (ProcProg r vis smt md prg, NativeVector r)
  => Mod -> GenState (FS (r File))
genModDefProc :: forall (r :: * -> *) vis smt md prg.
(ProcProg r vis smt md prg, NativeVector r) =>
Mod -> GenState (FS (r File))
genModDefProc (Mod Name
n Name
desc [Name]
is [Class]
cs [Func]
fs) = case [Class]
cs of
  [] -> Name
-> Name
-> [Name]
-> [GenState (Maybe (MS (r md)))]
-> GenState (FS (r File))
forall (r :: * -> *) vis smt md prg.
ProcProg r vis smt md prg =>
Name
-> Name
-> [Name]
-> [GenState (Maybe (MS (r md)))]
-> GenState (FS (r File))
genModuleWithImportsProc Name
n Name
desc [Name]
is
          ((Func -> GenState (Maybe (MS (r md))))
-> [Func] -> [GenState (Maybe (MS (r md)))]
forall a b. (a -> b) -> [a] -> [b]
map ((MS (r md) -> Maybe (MS (r md)))
-> StateT DrasilState Identity (MS (r md))
-> GenState (Maybe (MS (r md)))
forall a b.
(a -> b)
-> StateT DrasilState Identity a -> StateT DrasilState Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MS (r md) -> Maybe (MS (r md))
forall a. a -> Maybe a
Just (StateT DrasilState Identity (MS (r md))
 -> GenState (Maybe (MS (r md))))
-> (Func -> StateT DrasilState Identity (MS (r md)))
-> Func
-> GenState (Maybe (MS (r md)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name
 -> VS (r TypeData)
 -> Name
 -> [ParameterChunk]
 -> Maybe Name
 -> [MS (r Block)]
 -> StateT DrasilState Identity (MS (r md)))
-> [StateVariable]
-> Func
-> StateT DrasilState Identity (MS (r md))
forall (r :: * -> *) vis smt md.
(SharedProg r vis smt md, NativeVector r) =>
(Name
 -> VS (r TypeData)
 -> Name
 -> [ParameterChunk]
 -> Maybe Name
 -> [MS (r Block)]
 -> GenState (MS (r md)))
-> [StateVariable] -> Func -> GenState (MS (r md))
genFuncProc Name
-> VS (r TypeData)
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MS (r Block)]
-> StateT DrasilState Identity (MS (r md))
forall (r :: * -> *) vis smt md.
SharedProg r vis smt md =>
Name
-> VS (r TypeData)
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MS (r Block)]
-> GenState (MS (r md))
publicFuncProc []) [Func]
fs)
  [Class]
_  -> Name -> GenState (FS (r File))
forall a. HasCallStack => Name -> a
error Name
"genModDefProc: Procedural renderers do not support classes"

-- | Generates a GOOL Parameter for a parameter represented by a 'ParameterChunk'.
mkParamProc :: (ParameterSym r) => ParameterChunk -> GenState (MS (r ParamData))
mkParamProc :: forall (r :: * -> *).
ParameterSym r =>
ParameterChunk -> GenState (MS (r ParamData))
mkParamProc ParameterChunk
p = do
  SVariable r
v <- Input -> GenState (SVariable r)
forall (r :: * -> *).
VariableSym r =>
Input -> GenState (SVariable r)
mkVarProc (ParameterChunk -> Input
forall c. (Quantity c, MayHaveUnit c, Concept c) => c -> Input
quantvar ParameterChunk
p)
  MS (r ParamData) -> GenState (MS (r ParamData))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (MS (r ParamData) -> GenState (MS (r ParamData)))
-> MS (r ParamData) -> GenState (MS (r ParamData))
forall a b. (a -> b) -> a -> b
$ PassBy -> SVariable r -> MS (r ParamData)
forall {r :: * -> *}.
ParameterSym r =>
PassBy -> SVariable r -> MS (r ParamData)
paramFunc (ParameterChunk -> PassBy
passBy ParameterChunk
p) SVariable r
v
  where paramFunc :: PassBy -> SVariable r -> MS (r ParamData)
paramFunc PassBy
Ref = SVariable r -> MS (r ParamData)
forall (r :: * -> *).
ParameterSym r =>
SVariable r -> MS (r ParamData)
pointerParam
        paramFunc PassBy
Val = SVariable r -> MS (r ParamData)
forall (r :: * -> *).
ParameterSym r =>
SVariable r -> MS (r ParamData)
param

-- | Generates a public function.
publicFuncProc
  :: (SharedProg r vis smt md)
  => Label
  -> VS (r TypeData)
  -> Description
  -> [ParameterChunk]
  -> Maybe Description
  -> [MS (r Block)]
  -> GenState (MS (r md))
publicFuncProc :: forall (r :: * -> *) vis smt md.
SharedProg r vis smt md =>
Name
-> VS (r TypeData)
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MS (r Block)]
-> GenState (MS (r md))
publicFuncProc Name
n VS (r TypeData)
t Name
desc [ParameterChunk]
ps Maybe Name
r [MS (r Block)]
b = do
  (DrasilState -> DrasilState) -> StateT DrasilState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\DrasilState
st -> DrasilState
st {currentScope = Local})
  ([MS (r ParamData)] -> MS (r Block) -> MS (r md))
-> Name
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MS (r Block)]
-> GenState (MS (r md))
forall (r :: * -> *) vis smt md.
SharedProg r vis smt md =>
([MS (r ParamData)] -> MS (r Block) -> MS (r md))
-> Name
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MS (r Block)]
-> GenState (MS (r md))
genMethodProc (Name
-> r vis
-> VS (r TypeData)
-> [MS (r ParamData)]
-> MS (r Block)
-> MS (r md)
forall (r :: * -> *) vis smt md.
MethodSym r vis smt md =>
Name
-> r vis
-> VS (r TypeData)
-> [MS (r ParamData)]
-> MS (r Block)
-> MS (r md)
function Name
n r vis
forall (r :: * -> *) vis. VisibilitySym r vis => r vis
public VS (r TypeData)
t) Name
n Name
desc [ParameterChunk]
ps Maybe Name
r [MS (r Block)]
b

-- | Generates a private function.
privateFuncProc
  :: (SharedProg r vis smt md)
  => Label
  -> VS (r TypeData)
  -> Description
  -> [ParameterChunk]
  -> Maybe Description
  -> [MS (r Block)]
  -> GenState (MS (r md))
privateFuncProc :: forall (r :: * -> *) vis smt md.
SharedProg r vis smt md =>
Name
-> VS (r TypeData)
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MS (r Block)]
-> GenState (MS (r md))
privateFuncProc Name
n VS (r TypeData)
t Name
desc [ParameterChunk]
ps Maybe Name
r [MS (r Block)]
b = do
  (DrasilState -> DrasilState) -> StateT DrasilState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\DrasilState
st -> DrasilState
st {currentScope = Local})
  ([MS (r ParamData)] -> MS (r Block) -> MS (r md))
-> Name
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MS (r Block)]
-> GenState (MS (r md))
forall (r :: * -> *) vis smt md.
SharedProg r vis smt md =>
([MS (r ParamData)] -> MS (r Block) -> MS (r md))
-> Name
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MS (r Block)]
-> GenState (MS (r md))
genMethodProc (Name
-> r vis
-> VS (r TypeData)
-> [MS (r ParamData)]
-> MS (r Block)
-> MS (r md)
forall (r :: * -> *) vis smt md.
MethodSym r vis smt md =>
Name
-> r vis
-> VS (r TypeData)
-> [MS (r ParamData)]
-> MS (r Block)
-> MS (r md)
function Name
n r vis
forall (r :: * -> *) vis. VisibilitySym r vis => r vis
private VS (r TypeData)
t) Name
n Name
desc [ParameterChunk]
ps Maybe Name
r [MS (r Block)]
b

-- | Generates a function or method using the passed GOOL constructor. Other
-- parameters are the method's name, description, list of parameters,
-- description of what is returned (if applicable), and body.
genMethodProc
  :: (SharedProg r vis smt md)
  => ([MS (r ParamData)] -> MS (r Body) -> MS (r md))
  -> Label
  -> Description
  -> [ParameterChunk]
  -> Maybe Description
  -> [MS (r Block)]
  -> GenState (MS (r md))
genMethodProc :: forall (r :: * -> *) vis smt md.
SharedProg r vis smt md =>
([MS (r ParamData)] -> MS (r Block) -> MS (r md))
-> Name
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MS (r Block)]
-> GenState (MS (r md))
genMethodProc [MS (r ParamData)] -> MS (r Block) -> MS (r md)
f Name
n Name
desc [ParameterChunk]
p Maybe Name
r [MS (r Block)]
b = do
  DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  [SVariable r]
vars <- (ParameterChunk -> StateT DrasilState Identity (SVariable r))
-> [ParameterChunk] -> StateT DrasilState Identity [SVariable r]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Input -> StateT DrasilState Identity (SVariable r)
forall (r :: * -> *).
VariableSym r =>
Input -> GenState (SVariable r)
mkVarProc (Input -> StateT DrasilState Identity (SVariable r))
-> (ParameterChunk -> Input)
-> ParameterChunk
-> StateT DrasilState Identity (SVariable r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParameterChunk -> Input
forall c. (Quantity c, MayHaveUnit c, Concept c) => c -> Input
quantvar) [ParameterChunk]
p
  [MS (r ParamData)]
ps <- (ParameterChunk -> StateT DrasilState Identity (MS (r ParamData)))
-> [ParameterChunk]
-> StateT DrasilState Identity [MS (r ParamData)]
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 ParameterChunk -> StateT DrasilState Identity (MS (r ParamData))
forall (r :: * -> *).
ParameterSym r =>
ParameterChunk -> GenState (MS (r ParamData))
mkParamProc [ParameterChunk]
p
  MS (r Block)
bod <- Name -> [SVariable r] -> [MS (r Block)] -> GenState (MS (r Block))
forall (r :: * -> *) smt.
(SharedStatement r smt, VariableElim r) =>
Name -> [SVariable r] -> [MS (r Block)] -> GenState (MS (r Block))
logBody Name
n [SVariable r]
vars [MS (r Block)]
b
  let fn :: MS (r md)
fn = [MS (r ParamData)] -> MS (r Block) -> MS (r md)
f [MS (r ParamData)]
ps MS (r Block)
bod
  [Name]
pComms <- (ParameterChunk -> GenState Name)
-> [ParameterChunk] -> StateT DrasilState Identity [Name]
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 ParameterChunk -> GenState Name
forall c. CodeIdea c => c -> GenState Name
getCommentBrief [ParameterChunk]
p
  MS (r md) -> GenState (MS (r md))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (MS (r md) -> GenState (MS (r md)))
-> MS (r md) -> GenState (MS (r md))
forall a b. (a -> b) -> a -> b
$ if Comments
CommentFunc Comments -> [Comments] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (DrasilState
g DrasilState
-> Getting [Comments] DrasilState [Comments] -> [Comments]
forall s a. s -> Getting a s a -> a
^. Getting [Comments] DrasilState [Comments]
forall a. HasChoices a => Lens' a [Comments]
Lens' DrasilState [Comments]
commented)
    then Name -> [Name] -> Maybe Name -> MS (r md) -> MS (r md)
forall (r :: * -> *) vis smt md.
MethodSym r vis smt md =>
Name -> [Name] -> Maybe Name -> MS (r md) -> MS (r md)
docFunc Name
desc [Name]
pComms Maybe Name
r MS (r md)
fn else MS (r md)
fn

-- | Converts a 'Func' (from the Mod AST) to GOOL.
-- The function generator to use is passed as a parameter. Automatically adds
-- variable declaration statements for any undeclared variables. For methods,
-- the list of StateVariables is needed so they can be included in the list of
-- declared variables.
genFuncProc
  :: (SharedProg r vis smt md, NativeVector r)
  => (Name -> VS (r TypeData) -> Description -> [ParameterChunk] -> Maybe Description -> [MS (r Block)] -> GenState (MS (r md)))
  -> [StateVariable]
  -> Func
  -> GenState (MS (r md))
genFuncProc :: forall (r :: * -> *) vis smt md.
(SharedProg r vis smt md, NativeVector r) =>
(Name
 -> VS (r TypeData)
 -> Name
 -> [ParameterChunk]
 -> Maybe Name
 -> [MS (r Block)]
 -> GenState (MS (r md)))
-> [StateVariable] -> Func -> GenState (MS (r md))
genFuncProc Name
-> VS (r TypeData)
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MS (r Block)]
-> GenState (MS (r md))
f [StateVariable]
svs (FDef (FuncDef Name
n Name
desc [ParameterChunk]
parms Space
o Maybe Name
rd [FuncStmt]
s)) = do
  DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  (DrasilState -> DrasilState) -> StateT DrasilState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\DrasilState
st -> DrasilState
st {currentScope = Local})
  [MS (r smt)]
stmts <- (FuncStmt -> StateT DrasilState Identity (MS (r smt)))
-> [FuncStmt] -> StateT DrasilState Identity [MS (r smt)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM FuncStmt -> StateT DrasilState Identity (MS (r smt))
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r,
 VariableElim r) =>
FuncStmt -> GenState (MS (r smt))
convStmtProc [FuncStmt]
s
  [SVariable r]
vars <- (Input -> StateT DrasilState Identity (SVariable r))
-> [Input] -> StateT DrasilState Identity [SVariable r]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Input -> StateT DrasilState Identity (SVariable r)
forall (r :: * -> *).
VariableSym r =>
Input -> GenState (SVariable r)
mkVarProc (ChunkDB -> [FuncStmt] -> [Input]
fstdecl (DrasilState
g DrasilState -> Getting ChunkDB DrasilState ChunkDB -> ChunkDB
forall s a. s -> Getting a s a -> a
^. Getting ChunkDB DrasilState ChunkDB
forall c. HasSystemMeta c => Lens' c ChunkDB
Lens' DrasilState ChunkDB
systemdb) [FuncStmt]
s
    [Input] -> [Input] -> [Input]
forall a. Eq a => [a] -> [a] -> [a]
\\ ((ParameterChunk -> Input) -> [ParameterChunk] -> [Input]
forall a b. (a -> b) -> [a] -> [b]
map ParameterChunk -> Input
forall c. (Quantity c, MayHaveUnit c, Concept c) => c -> Input
quantvar [ParameterChunk]
parms [Input] -> [Input] -> [Input]
forall a. [a] -> [a] -> [a]
++ (StateVariable -> Input) -> [StateVariable] -> [Input]
forall a b. (a -> b) -> [a] -> [b]
map StateVariable -> Input
stVar [StateVariable]
svs))
  CodeType
t <- Space -> StateT DrasilState Identity CodeType
spaceCodeType Space
o
  Name
-> VS (r TypeData)
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MS (r Block)]
-> GenState (MS (r md))
f Name
n (CodeType -> VS (r TypeData)
forall (r :: * -> *). TypeSym r => CodeType -> VS (r TypeData)
convType CodeType
t) Name
desc [ParameterChunk]
parms Maybe Name
rd [[MS (r smt)] -> MS (r Block)
forall (r :: * -> *) smt.
BlockSym r smt =>
[MS (r smt)] -> MS (r Block)
block ([MS (r smt)] -> MS (r Block)) -> [MS (r smt)] -> MS (r Block)
forall a b. (a -> b) -> a -> b
$ (SVariable r -> MS (r smt)) -> [SVariable r] -> [MS (r smt)]
forall a b. (a -> b) -> [a] -> [b]
map (SVariable r -> r ScopeData -> MS (r smt)
forall (r :: * -> *) smt.
DeclStatement r smt =>
SVariable r -> r ScopeData -> MS (r smt)
`varDec` r ScopeData
forall (r :: * -> *). ScopeSym r => r ScopeData
local) [SVariable r]
vars, [MS (r smt)] -> MS (r Block)
forall (r :: * -> *) smt.
BlockSym r smt =>
[MS (r smt)] -> MS (r Block)
block [MS (r smt)]
stmts]
genFuncProc Name
-> VS (r TypeData)
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MS (r Block)]
-> GenState (MS (r md))
_ [StateVariable]
_ (FDef (CtorDef {})) = Name -> GenState (MS (r md))
forall a. HasCallStack => Name -> a
error Name
"genFuncProc: Procedural renderers do not support constructors"
genFuncProc Name
-> VS (r TypeData)
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MS (r Block)]
-> GenState (MS (r md))
_ [StateVariable]
_ (FData (FuncData Name
n Name
desc DataDesc
ddef)) = Name -> Name -> DataDesc -> GenState (MS (r md))
forall (r :: * -> *) vis smt md.
(SharedProg r vis smt md, NativeVector r) =>
Name -> Name -> DataDesc -> GenState (MS (r md))
genDataFuncProc Name
n Name
desc DataDesc
ddef

-- | Converts a 'Mod'\'s functions to GOOL.
genModFuncsProc
  :: (SharedProg r vis smt md, NativeVector r)
  => Mod -> [GenState (MS (r md))]
genModFuncsProc :: forall (r :: * -> *) vis smt md.
(SharedProg r vis smt md, NativeVector r) =>
Mod -> [GenState (MS (r md))]
genModFuncsProc (Mod Name
_ Name
_ [Name]
_ [Class]
_ [Func]
fs) = (Func -> GenState (MS (r md))) -> [Func] -> [GenState (MS (r md))]
forall a b. (a -> b) -> [a] -> [b]
map ((Name
 -> VS (r TypeData)
 -> Name
 -> [ParameterChunk]
 -> Maybe Name
 -> [MS (r Block)]
 -> GenState (MS (r md)))
-> [StateVariable] -> Func -> GenState (MS (r md))
forall (r :: * -> *) vis smt md.
(SharedProg r vis smt md, NativeVector r) =>
(Name
 -> VS (r TypeData)
 -> Name
 -> [ParameterChunk]
 -> Maybe Name
 -> [MS (r Block)]
 -> GenState (MS (r md)))
-> [StateVariable] -> Func -> GenState (MS (r md))
genFuncProc Name
-> VS (r TypeData)
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MS (r Block)]
-> GenState (MS (r md))
forall (r :: * -> *) vis smt md.
SharedProg r vis smt md =>
Name
-> VS (r TypeData)
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MS (r Block)]
-> GenState (MS (r md))
publicFuncProc []) [Func]
fs

-- this is really ugly!!
-- | Read from a data description into an 'MS Block' of 'MS Statement's.
readDataProc
  :: (NativeVector r, SharedStatement r smt, TypeElim r)
  => DataDesc -> GenState [MS (r Block)]
readDataProc :: forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
DataDesc -> GenState [MS (r Block)]
readDataProc DataDesc
ddef = do
  DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  let localScope :: r ScopeData
localScope = ScopeType -> r ScopeData
forall (r :: * -> *). ScopeSym r => ScopeType -> r ScopeData
convScope (ScopeType -> r ScopeData) -> ScopeType -> r ScopeData
forall a b. (a -> b) -> a -> b
$ DrasilState -> ScopeType
currentScope DrasilState
g
  [[MS (r smt)]]
inD <- (Data -> StateT DrasilState Identity [MS (r smt)])
-> DataDesc -> StateT DrasilState Identity [[MS (r smt)]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Data -> r ScopeData -> StateT DrasilState Identity [MS (r smt)]
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt) =>
Data -> r ScopeData -> GenState [MS (r smt)]
`inData` r ScopeData
localScope) DataDesc
ddef
  SValue r
v_filename <- Input -> GenState (SValue r)
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
Input -> GenState (SValue r)
mkValProc (DefinedQuantityDict -> Input
forall c. (Quantity c, MayHaveUnit c, Concept c) => c -> Input
quantvar DefinedQuantityDict
inFileName)
  [MS (r Block)] -> GenState [MS (r Block)]
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return [[MS (r smt)] -> MS (r Block)
forall (r :: * -> *) smt.
BlockSym r smt =>
[MS (r smt)] -> MS (r Block)
block ([MS (r smt)] -> MS (r Block)) -> [MS (r smt)] -> MS (r Block)
forall a b. (a -> b) -> a -> b
$
    SVariable r -> r ScopeData -> MS (r smt)
forall (r :: * -> *) smt.
DeclStatement r smt =>
SVariable r -> r ScopeData -> MS (r smt)
varDec SVariable r
forall (r :: * -> *). VariableSym r => SVariable r
var_infile r ScopeData
localScope MS (r smt) -> [MS (r smt)] -> [MS (r smt)]
forall a. a -> [a] -> [a]
:
    (if (Data -> Bool) -> DataDesc -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Data
d -> Data -> Bool
isLine Data
d Bool -> Bool -> Bool
|| Data -> Bool
isLines Data
d) DataDesc
ddef then [SVariable r -> r ScopeData -> MS (r smt)
forall (r :: * -> *) smt.
DeclStatement r smt =>
SVariable r -> r ScopeData -> MS (r smt)
varDec SVariable r
forall (r :: * -> *). VariableSym r => SVariable r
var_line r ScopeData
localScope,
    Integer -> SVariable r -> r ScopeData -> MS (r smt)
forall (r :: * -> *) smt.
DeclStatement r smt =>
Integer -> SVariable r -> r ScopeData -> MS (r smt)
listDec Integer
0 SVariable r
forall (r :: * -> *). VariableSym r => SVariable r
var_linetokens r ScopeData
localScope] else []) [MS (r smt)] -> [MS (r smt)] -> [MS (r smt)]
forall a. [a] -> [a] -> [a]
++
    [Integer -> SVariable r -> r ScopeData -> MS (r smt)
forall (r :: * -> *) smt.
DeclStatement r smt =>
Integer -> SVariable r -> r ScopeData -> MS (r smt)
listDec Integer
0 SVariable r
forall (r :: * -> *). VariableSym r => SVariable r
var_lines r ScopeData
localScope | (Data -> Bool) -> DataDesc -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Data -> Bool
isLines DataDesc
ddef] [MS (r smt)] -> [MS (r smt)] -> [MS (r smt)]
forall a. [a] -> [a] -> [a]
++ SVariable r -> SValue r -> MS (r smt)
forall (r :: * -> *) smt.
IOStatement r smt =>
SVariable r -> SValue r -> MS (r smt)
openFileR SVariable r
forall (r :: * -> *). VariableSym r => SVariable r
var_infile
    SValue r
v_filename MS (r smt) -> [MS (r smt)] -> [MS (r smt)]
forall a. a -> [a] -> [a]
: [[MS (r smt)]] -> [MS (r smt)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[MS (r smt)]]
inD [MS (r smt)] -> [MS (r smt)] -> [MS (r smt)]
forall a. [a] -> [a] -> [a]
++ [SValue r -> MS (r smt)
forall (r :: * -> *) smt.
IOStatement r smt =>
SValue r -> MS (r smt)
closeFile SValue r
forall (r :: * -> *). VariableValue r => SValue r
v_infile]]
  where inData
          :: (NativeVector r, SharedStatement r smt)
          => Data -> r ScopeData -> GenState [MS (r smt)]
        inData :: forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt) =>
Data -> r ScopeData -> GenState [MS (r smt)]
inData (Singleton Input
v) r ScopeData
_ = do
            SVariable r
vv <- Input -> GenState (SVariable r)
forall (r :: * -> *).
VariableSym r =>
Input -> GenState (SVariable r)
mkVarProc Input
v
            [MS (r smt)] -> GenState [MS (r smt)]
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return [SValue r -> SVariable r -> MS (r smt)
forall (r :: * -> *) smt.
IOStatement r smt =>
SValue r -> SVariable r -> MS (r smt)
getFileInput SValue r
forall (r :: * -> *). VariableValue r => SValue r
v_infile SVariable r
vv]
        inData Data
JunkData r ScopeData
_ = [MS (r smt)] -> GenState [MS (r smt)]
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return [SValue r -> MS (r smt)
forall (r :: * -> *) smt.
IOStatement r smt =>
SValue r -> MS (r smt)
discardFileLine SValue r
forall (r :: * -> *). VariableValue r => SValue r
v_infile]
        inData (Line LinePattern
lp Char
d) r ScopeData
scp = do
          [MS (r smt)]
lnI <- Maybe Name -> LinePattern -> r ScopeData -> GenState [MS (r smt)]
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt) =>
Maybe Name -> LinePattern -> r ScopeData -> GenState [MS (r smt)]
lineData Maybe Name
forall a. Maybe a
Nothing LinePattern
lp r ScopeData
scp
          [MS (r smt)] -> GenState [MS (r smt)]
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([MS (r smt)] -> GenState [MS (r smt)])
-> [MS (r smt)] -> GenState [MS (r smt)]
forall a b. (a -> b) -> a -> b
$ [SValue r -> SVariable r -> MS (r smt)
forall (r :: * -> *) smt.
IOStatement r smt =>
SValue r -> SVariable r -> MS (r smt)
getFileInputLine SValue r
forall (r :: * -> *). VariableValue r => SValue r
v_infile SVariable r
forall (r :: * -> *). VariableSym r => SVariable r
var_line,
            Char -> SVariable r -> SValue r -> MS (r smt)
forall (r :: * -> *) smt.
StringStatement r smt =>
Char -> SVariable r -> SValue r -> MS (r smt)
stringSplit Char
d SVariable r
forall (r :: * -> *). VariableSym r => SVariable r
var_linetokens SValue r
forall (r :: * -> *). VariableValue r => SValue r
v_line] [MS (r smt)] -> [MS (r smt)] -> [MS (r smt)]
forall a. [a] -> [a] -> [a]
++ [MS (r smt)]
lnI
        inData (Lines LinePattern
lp Maybe Integer
ls Char
d) r ScopeData
scp = do
          [MS (r smt)]
lnV <- Maybe Name -> LinePattern -> r ScopeData -> GenState [MS (r smt)]
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt) =>
Maybe Name -> LinePattern -> r ScopeData -> GenState [MS (r smt)]
lineData (Name -> Maybe Name
forall a. a -> Maybe a
Just Name
"_temp") LinePattern
lp r ScopeData
scp
          let readLines :: Maybe Integer -> [MS (r smt)]
readLines Maybe Integer
Nothing = [SValue r -> SVariable r -> MS (r smt)
forall (r :: * -> *) smt.
IOStatement r smt =>
SValue r -> SVariable r -> MS (r smt)
getFileInputAll SValue r
forall (r :: * -> *). VariableValue r => SValue r
v_infile SVariable r
forall (r :: * -> *). VariableSym r => SVariable r
var_lines,
                SVariable r
-> SValue r -> SValue r -> SValue r -> MS (r Block) -> MS (r smt)
forall (r :: * -> *) smt.
ControlStatement r smt =>
SVariable r
-> SValue r -> SValue r -> SValue r -> MS (r Block) -> MS (r smt)
forRange SVariable r
forall (r :: * -> *). VariableSym r => SVariable r
var_i (Integer -> SValue r
forall (r :: * -> *). Literal r => Integer -> SValue r
litInt Integer
0) (SValue r -> SValue r
forall (r :: * -> *) smt. List r smt => SValue r -> SValue r
listSize SValue r
forall (r :: * -> *). VariableValue r => SValue r
v_lines) (Integer -> SValue r
forall (r :: * -> *). Literal r => Integer -> SValue r
litInt Integer
1)
                  ([MS (r smt)] -> MS (r Block)
forall (r :: * -> *) smt.
BodySym r smt =>
[MS (r smt)] -> MS (r Block)
bodyStatements ([MS (r smt)] -> MS (r Block)) -> [MS (r smt)] -> MS (r Block)
forall a b. (a -> b) -> a -> b
$ Char -> SVariable r -> SValue r -> MS (r smt)
forall (r :: * -> *) smt.
StringStatement r smt =>
Char -> SVariable r -> SValue r -> MS (r smt)
stringSplit Char
d SVariable r
forall (r :: * -> *). VariableSym r => SVariable r
var_linetokens (
                  SValue r -> SValue r -> SValue r
forall (r :: * -> *) smt.
List r smt =>
SValue r -> SValue r -> SValue r
listAccess SValue r
forall (r :: * -> *). VariableValue r => SValue r
v_lines SValue r
forall (r :: * -> *). VariableValue r => SValue r
v_i) MS (r smt) -> [MS (r smt)] -> [MS (r smt)]
forall a. a -> [a] -> [a]
: [MS (r smt)]
lnV)]
              readLines (Just Integer
numLines) = [SVariable r
-> SValue r -> SValue r -> SValue r -> MS (r Block) -> MS (r smt)
forall (r :: * -> *) smt.
ControlStatement r smt =>
SVariable r
-> SValue r -> SValue r -> SValue r -> MS (r Block) -> MS (r smt)
forRange SVariable r
forall (r :: * -> *). VariableSym r => SVariable r
var_i (Integer -> SValue r
forall (r :: * -> *). Literal r => Integer -> SValue r
litInt Integer
0)
                (Integer -> SValue r
forall (r :: * -> *). Literal r => Integer -> SValue r
litInt Integer
numLines) (Integer -> SValue r
forall (r :: * -> *). Literal r => Integer -> SValue r
litInt Integer
1)
                ([MS (r smt)] -> MS (r Block)
forall (r :: * -> *) smt.
BodySym r smt =>
[MS (r smt)] -> MS (r Block)
bodyStatements ([MS (r smt)] -> MS (r Block)) -> [MS (r smt)] -> MS (r Block)
forall a b. (a -> b) -> a -> b
$
                  [SValue r -> SVariable r -> MS (r smt)
forall (r :: * -> *) smt.
IOStatement r smt =>
SValue r -> SVariable r -> MS (r smt)
getFileInputLine SValue r
forall (r :: * -> *). VariableValue r => SValue r
v_infile SVariable r
forall (r :: * -> *). VariableSym r => SVariable r
var_line,
                   Char -> SVariable r -> SValue r -> MS (r smt)
forall (r :: * -> *) smt.
StringStatement r smt =>
Char -> SVariable r -> SValue r -> MS (r smt)
stringSplit Char
d SVariable r
forall (r :: * -> *). VariableSym r => SVariable r
var_linetokens SValue r
forall (r :: * -> *). VariableValue r => SValue r
v_line
                  ] [MS (r smt)] -> [MS (r smt)] -> [MS (r smt)]
forall a. [a] -> [a] -> [a]
++ [MS (r smt)]
lnV)]
          [MS (r smt)] -> GenState [MS (r smt)]
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([MS (r smt)] -> GenState [MS (r smt)])
-> [MS (r smt)] -> GenState [MS (r smt)]
forall a b. (a -> b) -> a -> b
$ Maybe Integer -> [MS (r smt)]
readLines Maybe Integer
ls
        ---------------
        lineData
          :: (NativeVector r, SharedStatement r smt) => Maybe String
          -> LinePattern -> r ScopeData -> GenState [MS (r smt)]
        lineData :: forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt) =>
Maybe Name -> LinePattern -> r ScopeData -> GenState [MS (r smt)]
lineData Maybe Name
s p :: LinePattern
p@(Straight [Input]
_) r ScopeData
_ = do
          [SVariable r]
vs <- Maybe Name -> LinePattern -> GenState [SVariable r]
forall (r :: * -> *).
VariableSym r =>
Maybe Name -> LinePattern -> GenState [SVariable r]
getEntryVarsProc Maybe Name
s LinePattern
p
          [MS (r smt)] -> GenState [MS (r smt)]
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return [[SVariable r] -> SValue r -> MS (r smt)
forall (r :: * -> *) smt.
StringStatement r smt =>
[SVariable r] -> SValue r -> MS (r smt)
stringListVals [SVariable r]
vs SValue r
forall (r :: * -> *). VariableValue r => SValue r
v_linetokens]
        lineData Maybe Name
s p :: LinePattern
p@(Repeat [Input]
ds) r ScopeData
scp = do
          [SVariable r]
vs <- Maybe Name -> LinePattern -> GenState [SVariable r]
forall (r :: * -> *).
VariableSym r =>
Maybe Name -> LinePattern -> GenState [SVariable r]
getEntryVarsProc Maybe Name
s LinePattern
p
          [StateT DrasilState Identity (MS (r smt))] -> GenState [MS (r smt)]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ([StateT DrasilState Identity (MS (r smt))]
 -> GenState [MS (r smt)])
-> [StateT DrasilState Identity (MS (r smt))]
-> GenState [MS (r smt)]
forall a b. (a -> b) -> a -> b
$ Maybe Name
-> [Input]
-> r ScopeData
-> [StateT DrasilState Identity (MS (r smt))]
forall (r :: * -> *) smt.
DeclStatement r smt =>
Maybe Name -> [Input] -> r ScopeData -> [GenState (MS (r smt))]
clearTemps Maybe Name
s [Input]
ds r ScopeData
scp [StateT DrasilState Identity (MS (r smt))]
-> [StateT DrasilState Identity (MS (r smt))]
-> [StateT DrasilState Identity (MS (r smt))]
forall a. [a] -> [a] -> [a]
++ MS (r smt) -> StateT DrasilState Identity (MS (r smt))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return
            ([SVariable r] -> SValue r -> MS (r smt)
forall (r :: * -> *) smt.
StringStatement r smt =>
[SVariable r] -> SValue r -> MS (r smt)
stringListLists [SVariable r]
vs SValue r
forall (r :: * -> *). VariableValue r => SValue r
v_linetokens) StateT DrasilState Identity (MS (r smt))
-> [StateT DrasilState Identity (MS (r smt))]
-> [StateT DrasilState Identity (MS (r smt))]
forall a. a -> [a] -> [a]
: Maybe Name -> [Input] -> [StateT DrasilState Identity (MS (r smt))]
forall (r :: * -> *) smt.
(List r smt, VariableValue r) =>
Maybe Name -> [Input] -> [GenState (MS (r smt))]
appendTemps Maybe Name
s [Input]
ds
        ---------------
        clearTemps
          :: (DeclStatement r smt)
          => Maybe String -> [DataItem] -> r ScopeData -> [GenState (MS (r smt))]
        clearTemps :: forall (r :: * -> *) smt.
DeclStatement r smt =>
Maybe Name -> [Input] -> r ScopeData -> [GenState (MS (r smt))]
clearTemps Maybe Name
Nothing    [Input]
_  r ScopeData
_   = []
        clearTemps (Just Name
sfx) [Input]
es r ScopeData
scp = (Input -> GenState (MS (r smt)))
-> [Input] -> [GenState (MS (r smt))]
forall a b. (a -> b) -> [a] -> [b]
map (\Input
v -> Name -> Input -> r ScopeData -> GenState (MS (r smt))
forall (r :: * -> *) smt.
DeclStatement r smt =>
Name -> Input -> r ScopeData -> GenState (MS (r smt))
clearTemp Name
sfx Input
v r ScopeData
scp) [Input]
es
        ---------------
        clearTemp
          :: (DeclStatement r smt)
          => String -> DataItem -> r ScopeData -> GenState (MS (r smt))
        clearTemp :: forall (r :: * -> *) smt.
DeclStatement r smt =>
Name -> Input -> r ScopeData -> GenState (MS (r smt))
clearTemp Name
sfx Input
v r ScopeData
scp = (CodeType -> MS (r smt))
-> StateT DrasilState Identity CodeType
-> StateT DrasilState Identity (MS (r smt))
forall a b.
(a -> b)
-> StateT DrasilState Identity a -> StateT DrasilState Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\CodeType
t -> SVariable r -> r ScopeData -> [SValue r] -> MS (r smt)
forall (r :: * -> *) smt.
DeclStatement r smt =>
SVariable r -> r ScopeData -> [SValue r] -> MS (r smt)
listDecDef (Name -> VS (r TypeData) -> SVariable r
forall (r :: * -> *).
VariableSym r =>
Name -> VS (r TypeData) -> SVariable r
var (Input -> Name
forall c. CodeIdea c => c -> Name
codeName Input
v Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Name
sfx)
          (VS (r TypeData) -> VS (r TypeData)
forall (r :: * -> *).
TypeSym r =>
VS (r TypeData) -> VS (r TypeData)
innerType (VS (r TypeData) -> VS (r TypeData))
-> VS (r TypeData) -> VS (r TypeData)
forall a b. (a -> b) -> a -> b
$ CodeType -> VS (r TypeData)
forall (r :: * -> *). TypeSym r => CodeType -> VS (r TypeData)
convType CodeType
t)) r ScopeData
scp []) (Input -> StateT DrasilState Identity CodeType
forall c. HasSpace c => c -> StateT DrasilState Identity CodeType
codeType Input
v)
        ---------------
        appendTemps
          :: (List r smt, VariableValue r)
          => Maybe String -> [DataItem] -> [GenState (MS (r smt))]
        appendTemps :: forall (r :: * -> *) smt.
(List r smt, VariableValue r) =>
Maybe Name -> [Input] -> [GenState (MS (r smt))]
appendTemps Maybe Name
Nothing [Input]
_ = []
        appendTemps (Just Name
sfx) [Input]
es = (Input -> GenState (MS (r smt)))
-> [Input] -> [GenState (MS (r smt))]
forall a b. (a -> b) -> [a] -> [b]
map (Name -> Input -> GenState (MS (r smt))
forall (r :: * -> *) smt.
(List r smt, VariableValue r) =>
Name -> Input -> GenState (MS (r smt))
appendTemp Name
sfx) [Input]
es
        ---------------
        appendTemp
          :: (List r smt, VariableValue r)
          => String -> DataItem -> GenState (MS (r smt))
        appendTemp :: forall (r :: * -> *) smt.
(List r smt, VariableValue r) =>
Name -> Input -> GenState (MS (r smt))
appendTemp Name
sfx Input
v = (CodeType -> MS (r smt))
-> StateT DrasilState Identity CodeType
-> StateT DrasilState Identity (MS (r smt))
forall a b.
(a -> b)
-> StateT DrasilState Identity a -> StateT DrasilState Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\CodeType
t -> SValue r -> SValue r -> MS (r smt)
forall (r :: * -> *) smt.
List r smt =>
SValue r -> SValue r -> MS (r smt)
listAppend
          (SVariable r -> SValue r
forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
valueOf (SVariable r -> SValue r) -> SVariable r -> SValue r
forall a b. (a -> b) -> a -> b
$ Name -> VS (r TypeData) -> SVariable r
forall (r :: * -> *).
VariableSym r =>
Name -> VS (r TypeData) -> SVariable r
var (Input -> Name
forall c. CodeIdea c => c -> Name
codeName Input
v) (CodeType -> VS (r TypeData)
forall (r :: * -> *). TypeSym r => CodeType -> VS (r TypeData)
convType CodeType
t))
          (SVariable r -> SValue r
forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
valueOf (SVariable r -> SValue r) -> SVariable r -> SValue r
forall a b. (a -> b) -> a -> b
$ Name -> VS (r TypeData) -> SVariable r
forall (r :: * -> *).
VariableSym r =>
Name -> VS (r TypeData) -> SVariable r
var (Input -> Name
forall c. CodeIdea c => c -> Name
codeName Input
v Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Name
sfx) (CodeType -> VS (r TypeData)
forall (r :: * -> *). TypeSym r => CodeType -> VS (r TypeData)
convType CodeType
t))) (Input -> StateT DrasilState Identity CodeType
forall c. HasSpace c => c -> StateT DrasilState Identity CodeType
codeType Input
v)

-- | Get entry variables.
getEntryVarsProc :: (VariableSym r) => Maybe String -> LinePattern ->
  GenState [SVariable r]
getEntryVarsProc :: forall (r :: * -> *).
VariableSym r =>
Maybe Name -> LinePattern -> GenState [SVariable r]
getEntryVarsProc Maybe Name
s LinePattern
lp = (Input -> StateT DrasilState Identity (SVariable r))
-> [Input] -> StateT DrasilState Identity [SVariable r]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((Input -> StateT DrasilState Identity (SVariable r))
-> (Name -> Input -> StateT DrasilState Identity (SVariable r))
-> Maybe Name
-> Input
-> StateT DrasilState Identity (SVariable r)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Input -> StateT DrasilState Identity (SVariable r)
forall (r :: * -> *).
VariableSym r =>
Input -> GenState (SVariable r)
mkVarProc (\Name
st Input
v -> Input -> StateT DrasilState Identity CodeType
forall c. HasSpace c => c -> StateT DrasilState Identity CodeType
codeType Input
v StateT DrasilState Identity CodeType
-> (CodeType -> StateT DrasilState Identity (SVariable r))
-> StateT DrasilState Identity (SVariable r)
forall a b.
StateT DrasilState Identity a
-> (a -> StateT DrasilState Identity b)
-> StateT DrasilState Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
  (Name
-> VS (r TypeData) -> StateT DrasilState Identity (SVariable r)
forall (r :: * -> *).
VariableSym r =>
Name -> VS (r TypeData) -> GenState (SVariable r)
variableProc (Input -> Name
forall c. CodeIdea c => c -> Name
codeName Input
v Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Name
st) (VS (r TypeData) -> StateT DrasilState Identity (SVariable r))
-> (CodeType -> VS (r TypeData))
-> CodeType
-> StateT DrasilState Identity (SVariable r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VS (r TypeData) -> VS (r TypeData)
forall (r :: * -> *).
TypeSym r =>
VS (r TypeData) -> VS (r TypeData)
innerType (VS (r TypeData) -> VS (r TypeData))
-> (CodeType -> VS (r TypeData)) -> CodeType -> VS (r TypeData)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CodeType -> VS (r TypeData)
forall (r :: * -> *). TypeSym r => CodeType -> VS (r TypeData)
convType))
    Maybe Name
s) (LinePattern -> [Input]
getPatternInputs LinePattern
lp)

-- | Converts an 'Expr' to a GOOL Value.
convExprProc
  :: (NativeVector r, SharedStatement r smt, TypeElim r)
  => CodeExpr -> GenState (SValue r)
convExprProc :: forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc (Lit (Dbl Double
d)) = do
  CodeType
sm <- Space -> StateT DrasilState Identity CodeType
spaceCodeType Space
Real
  let getLiteral :: CodeType -> SValue r
getLiteral CodeType
Double = Double -> SValue r
forall (r :: * -> *). Literal r => Double -> SValue r
litDouble Double
d
      getLiteral CodeType
Float = Float -> SValue r
forall (r :: * -> *). Literal r => Float -> SValue r
litFloat (Double -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
d)
      getLiteral CodeType
_ = Name -> SValue r
forall a. HasCallStack => Name -> a
error Name
"convExprProc: Real space matched to invalid CodeType; should be Double or Float"
  SValue r -> GenState (SValue r)
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (SValue r -> GenState (SValue r))
-> SValue r -> GenState (SValue r)
forall a b. (a -> b) -> a -> b
$ CodeType -> SValue r
forall {r :: * -> *}. Literal r => CodeType -> SValue r
getLiteral CodeType
sm
convExprProc (Lit (ExactDbl Integer
d)) = CodeExpr -> GenState (SValue r)
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc (CodeExpr -> GenState (SValue r))
-> CodeExpr -> GenState (SValue r)
forall a b. (a -> b) -> a -> b
$ Literal -> CodeExpr
Lit (Literal -> CodeExpr) -> (Double -> Literal) -> Double -> CodeExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Literal
Dbl (Double -> CodeExpr) -> Double -> CodeExpr
forall a b. (a -> b) -> a -> b
$ Integer -> Double
forall a. Num a => Integer -> a
fromInteger Integer
d
convExprProc (Lit (Int Integer
i))      = SValue r -> GenState (SValue r)
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (SValue r -> GenState (SValue r))
-> SValue r -> GenState (SValue r)
forall a b. (a -> b) -> a -> b
$ Integer -> SValue r
forall (r :: * -> *). Literal r => Integer -> SValue r
litInt Integer
i
convExprProc (Lit (Str Name
s))      = SValue r -> GenState (SValue r)
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (SValue r -> GenState (SValue r))
-> SValue r -> GenState (SValue r)
forall a b. (a -> b) -> a -> b
$ Name -> SValue r
forall (r :: * -> *). Literal r => Name -> SValue r
litString Name
s
convExprProc (Lit (Perc Integer
a Integer
b)) = do
  CodeType
sm <- Space -> StateT DrasilState Identity CodeType
spaceCodeType Space
Rational
  let getLiteral :: CodeType -> Double -> SValue r
getLiteral CodeType
Double = Double -> SValue r
forall (r :: * -> *). Literal r => Double -> SValue r
litDouble
      getLiteral CodeType
Float = Float -> SValue r
forall (r :: * -> *). Literal r => Float -> SValue r
litFloat (Float -> SValue r) -> (Double -> Float) -> Double -> SValue r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac
      getLiteral CodeType
_ = Name -> Double -> SValue r
forall a. HasCallStack => Name -> a
error Name
"convExprProc: Rational space matched to invalid CodeType; should be Double or Float"
  SValue r -> GenState (SValue r)
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (SValue r -> GenState (SValue r))
-> SValue r -> GenState (SValue r)
forall a b. (a -> b) -> a -> b
$ CodeType -> Double -> SValue r
forall {r :: * -> *}. Literal r => CodeType -> Double -> SValue r
getLiteral CodeType
sm (Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
a Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
10 Double -> Double -> Double
forall a. Floating a => a -> a -> a
** Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
b))
convExprProc (AssocA AssocArithOper
Add [CodeExpr]
l) = (SValue r -> SValue r -> SValue r) -> [SValue r] -> SValue r
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 SValue r -> SValue r -> SValue r
forall (r :: * -> *).
NumericExpression r =>
SValue r -> SValue r -> SValue r
(#+)  ([SValue r] -> SValue r)
-> StateT DrasilState Identity [SValue r] -> GenState (SValue r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CodeExpr -> GenState (SValue r))
-> [CodeExpr] -> StateT DrasilState Identity [SValue r]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM CodeExpr -> GenState (SValue r)
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc [CodeExpr]
l
convExprProc (AssocA AssocArithOper
Mul [CodeExpr]
l) = (SValue r -> SValue r -> SValue r) -> [SValue r] -> SValue r
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 SValue r -> SValue r -> SValue r
forall (r :: * -> *).
NumericExpression r =>
SValue r -> SValue r -> SValue r
(#*)  ([SValue r] -> SValue r)
-> StateT DrasilState Identity [SValue r] -> GenState (SValue r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CodeExpr -> GenState (SValue r))
-> [CodeExpr] -> StateT DrasilState Identity [SValue r]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM CodeExpr -> GenState (SValue r)
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc [CodeExpr]
l
convExprProc (AssocB AssocBoolOper
And [CodeExpr]
l) = (SValue r -> SValue r -> SValue r) -> [SValue r] -> SValue r
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 SValue r -> SValue r -> SValue r
forall (r :: * -> *).
BooleanExpression r =>
SValue r -> SValue r -> SValue r
(?&&) ([SValue r] -> SValue r)
-> StateT DrasilState Identity [SValue r] -> GenState (SValue r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CodeExpr -> GenState (SValue r))
-> [CodeExpr] -> StateT DrasilState Identity [SValue r]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM CodeExpr -> GenState (SValue r)
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc [CodeExpr]
l
convExprProc (AssocB AssocBoolOper
Or [CodeExpr]
l)  = (SValue r -> SValue r -> SValue r) -> [SValue r] -> SValue r
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 SValue r -> SValue r -> SValue r
forall (r :: * -> *).
BooleanExpression r =>
SValue r -> SValue r -> SValue r
(?||) ([SValue r] -> SValue r)
-> StateT DrasilState Identity [SValue r] -> GenState (SValue r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CodeExpr -> GenState (SValue r))
-> [CodeExpr] -> StateT DrasilState Identity [SValue r]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM CodeExpr -> GenState (SValue r)
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc [CodeExpr]
l
convExprProc (AssocC AssocConcatOper
SUnion [CodeExpr]
l)  = (SValue r -> SValue r -> SValue r) -> [SValue r] -> SValue r
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 SValue r -> SValue r -> SValue r
forall (r :: * -> *).
NumericExpression r =>
SValue r -> SValue r -> SValue r
(#+) ([SValue r] -> SValue r)
-> StateT DrasilState Identity [SValue r] -> GenState (SValue r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CodeExpr -> GenState (SValue r))
-> [CodeExpr] -> StateT DrasilState Identity [SValue r]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM CodeExpr -> GenState (SValue r)
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc [CodeExpr]
l
convExprProc (C UID
c) = do
  DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  let v :: Input
v = DefinedQuantityDict -> Input
forall c. (Quantity c, MayHaveUnit c, Concept c) => c -> Input
quantvar (DrasilState -> UID -> DefinedQuantityDict
lookupC DrasilState
g UID
c)
  Input -> GenState (SValue r)
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
Input -> GenState (SValue r)
mkValProc Input
v
convExprProc (FCall UID
c [CodeExpr]
x [(UID, CodeExpr)]
ns) = UID
-> [CodeExpr]
-> [(UID, CodeExpr)]
-> (Name
    -> Name
    -> VS (r TypeData)
    -> [SValue r]
    -> NamedArgs r
    -> GenState (SValue r))
-> (Name
    -> Name
    -> VS (r TypeData)
    -> [SValue r]
    -> NamedArgs r
    -> SValue r)
-> GenState (SValue r)
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
UID
-> [CodeExpr]
-> [(UID, CodeExpr)]
-> (Name
    -> Name
    -> VS (r TypeData)
    -> [SValue r]
    -> NamedArgs r
    -> GenState (SValue r))
-> (Name
    -> Name
    -> VS (r TypeData)
    -> [SValue r]
    -> NamedArgs r
    -> SValue r)
-> GenState (SValue r)
convCallProc UID
c [CodeExpr]
x [(UID, CodeExpr)]
ns Name
-> Name
-> VS (r TypeData)
-> [SValue r]
-> NamedArgs r
-> GenState (SValue r)
forall (r :: * -> *).
(Argument r, TypeElim r, ValueExpression r) =>
Name
-> Name
-> VS (r TypeData)
-> [SValue r]
-> NamedArgs r
-> GenState (SValue r)
fAppProc Name
-> Name -> VS (r TypeData) -> [SValue r] -> NamedArgs r -> SValue r
forall (r :: * -> *). ValueExpression r => Name -> MixedCall r
libFuncAppMixedArgs
convExprProc (New {}) = Name -> GenState (SValue r)
forall a. HasCallStack => Name -> a
error Name
"convExprProc: Procedural renderers do not support object creation"
convExprProc (Message {}) = Name -> GenState (SValue r)
forall a. HasCallStack => Name -> a
error Name
"convExprProc: Procedural renderers do not support methods"
convExprProc (Field UID
_ UID
_) = Name -> GenState (SValue r)
forall a. HasCallStack => Name -> a
error Name
"convExprProc: Procedural renderers do not support object field access"
convExprProc (UnaryOp UFunc
o CodeExpr
u)    = (SValue r -> SValue r)
-> GenState (SValue r) -> GenState (SValue r)
forall a b.
(a -> b)
-> StateT DrasilState Identity a -> StateT DrasilState Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (UFunc -> SValue r -> SValue r
forall (r :: * -> *).
(NumericExpression r, Reference r) =>
UFunc -> SValue r -> SValue r
unop UFunc
o) (CodeExpr -> GenState (SValue r)
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
u)
convExprProc (UnaryOpB UFuncB
o CodeExpr
u)   = (SValue r -> SValue r)
-> GenState (SValue r) -> GenState (SValue r)
forall a b.
(a -> b)
-> StateT DrasilState Identity a -> StateT DrasilState Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (UFuncB -> SValue r -> SValue r
forall (r :: * -> *).
BooleanExpression r =>
UFuncB -> SValue r -> SValue r
unopB UFuncB
o) (CodeExpr -> GenState (SValue r)
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
u)
convExprProc (UnaryOpVV UFuncVV
NegV CodeExpr
u) = (SValue r -> SValue r)
-> GenState (SValue r) -> GenState (SValue r)
forall a b.
(a -> b)
-> StateT DrasilState Identity a -> StateT DrasilState Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SValue r -> SValue r -> SValue r
forall (r :: * -> *).
NativeVector r =>
SValue r -> SValue r -> SValue r
vecScale (Double -> SValue r
forall (r :: * -> *). Literal r => Double -> SValue r
litDouble (-Double
1))) (CodeExpr -> GenState (SValue r)
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
u)
convExprProc (UnaryOpVN UFuncVN
Dim CodeExpr
u)  = (SValue r -> SValue r)
-> GenState (SValue r) -> GenState (SValue r)
forall a b.
(a -> b)
-> StateT DrasilState Identity a -> StateT DrasilState Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SValue r -> SValue r
forall (r :: * -> *) smt. List r smt => SValue r -> SValue r
listSize (CodeExpr -> GenState (SValue r)
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
u)
convExprProc (UnaryOpVN UFuncVN
Norm CodeExpr
u) = (SValue r -> SValue r)
-> GenState (SValue r) -> GenState (SValue r)
forall a b.
(a -> b)
-> StateT DrasilState Identity a -> StateT DrasilState Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SValue r -> SValue r
forall (r :: * -> *). NativeVector r => SValue r -> SValue r
vecMag (CodeExpr -> GenState (SValue r)
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
u)
convExprProc (ArithBinaryOp ArithBinOp
Frac (Lit (Int Integer
a)) (Lit (Int Integer
b))) = do -- hack to deal with integer division
  CodeType
sm <- Space -> StateT DrasilState Identity CodeType
spaceCodeType Space
Rational
  let getLiteral :: CodeType -> SValue r
getLiteral CodeType
Double = Double -> SValue r
forall (r :: * -> *). Literal r => Double -> SValue r
litDouble (Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
a) SValue r -> SValue r -> SValue r
forall (r :: * -> *).
NumericExpression r =>
SValue r -> SValue r -> SValue r
#/ Double -> SValue r
forall (r :: * -> *). Literal r => Double -> SValue r
litDouble (Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
b)
      getLiteral CodeType
Float = Float -> SValue r
forall (r :: * -> *). Literal r => Float -> SValue r
litFloat (Integer -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
a) SValue r -> SValue r -> SValue r
forall (r :: * -> *).
NumericExpression r =>
SValue r -> SValue r -> SValue r
#/ Float -> SValue r
forall (r :: * -> *). Literal r => Float -> SValue r
litFloat (Integer -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
b)
      getLiteral CodeType
_ = Name -> SValue r
forall a. HasCallStack => Name -> a
error Name
"convExprProc: Rational space matched to invalid CodeType; should be Double or Float"
  SValue r -> GenState (SValue r)
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (SValue r -> GenState (SValue r))
-> SValue r -> GenState (SValue r)
forall a b. (a -> b) -> a -> b
$ CodeType -> SValue r
forall {r :: * -> *}.
(NumericExpression r, Literal r) =>
CodeType -> SValue r
getLiteral CodeType
sm
convExprProc (ArithBinaryOp ArithBinOp
o CodeExpr
a CodeExpr
b) = (SValue r -> SValue r -> SValue r)
-> GenState (SValue r)
-> GenState (SValue r)
-> GenState (SValue r)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (ArithBinOp -> SValue r -> SValue r -> SValue r
forall (r :: * -> *).
NumericExpression r =>
ArithBinOp -> SValue r -> SValue r -> SValue r
arithBfunc ArithBinOp
o) (CodeExpr -> GenState (SValue r)
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
a) (CodeExpr -> GenState (SValue r)
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
b)
convExprProc (LABinaryOp LABinOp
o CodeExpr
a CodeExpr
b)    = (SValue r -> SValue r -> SValue r)
-> GenState (SValue r)
-> GenState (SValue r)
-> GenState (SValue r)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (LABinOp -> SValue r -> SValue r -> SValue r
forall (r :: * -> *) smt.
List r smt =>
LABinOp -> SValue r -> SValue r -> SValue r
laBfunc LABinOp
o) (CodeExpr -> GenState (SValue r)
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
a) (CodeExpr -> GenState (SValue r)
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
b)
convExprProc (EqBinaryOp EqBinOp
o CodeExpr
a CodeExpr
b)    = (SValue r -> SValue r -> SValue r)
-> GenState (SValue r)
-> GenState (SValue r)
-> GenState (SValue r)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (EqBinOp -> SValue r -> SValue r -> SValue r
forall (r :: * -> *).
Comparison r =>
EqBinOp -> SValue r -> SValue r -> SValue r
eqBfunc EqBinOp
o) (CodeExpr -> GenState (SValue r)
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
a) (CodeExpr -> GenState (SValue r)
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
b)
convExprProc (OrdBinaryOp OrdBinOp
o CodeExpr
a CodeExpr
b)   = (SValue r -> SValue r -> SValue r)
-> GenState (SValue r)
-> GenState (SValue r)
-> GenState (SValue r)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (OrdBinOp -> SValue r -> SValue r -> SValue r
forall (r :: * -> *).
Comparison r =>
OrdBinOp -> SValue r -> SValue r -> SValue r
ordBfunc OrdBinOp
o) (CodeExpr -> GenState (SValue r)
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
a) (CodeExpr -> GenState (SValue r)
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
b)
convExprProc (VVVBinaryOp VVVBinOp
VAdd CodeExpr
a CodeExpr
b)  = (SValue r -> SValue r -> SValue r)
-> GenState (SValue r)
-> GenState (SValue r)
-> GenState (SValue r)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 SValue r -> SValue r -> SValue r
forall (r :: * -> *).
NativeVector r =>
SValue r -> SValue r -> SValue r
vecAdd (CodeExpr -> GenState (SValue r)
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
a) (CodeExpr -> GenState (SValue r)
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
b)
convExprProc (VVVBinaryOp VVVBinOp
VSub CodeExpr
a CodeExpr
b) = (SValue r -> SValue r -> SValue r)
-> GenState (SValue r)
-> GenState (SValue r)
-> GenState (SValue r)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (\SValue r
x SValue r
y -> SValue r -> SValue r -> SValue r
forall (r :: * -> *).
NativeVector r =>
SValue r -> SValue r -> SValue r
vecAdd SValue r
x (SValue r -> SValue r -> SValue r
forall (r :: * -> *).
NativeVector r =>
SValue r -> SValue r -> SValue r
vecScale (Double -> SValue r
forall (r :: * -> *). Literal r => Double -> SValue r
litDouble (-Double
1)) SValue r
y)) (CodeExpr -> GenState (SValue r)
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
a) (CodeExpr -> GenState (SValue r)
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
b)
convExprProc (VVVBinaryOp VVVBinOp
Cross CodeExpr
_ CodeExpr
_) = Name -> GenState (SValue r)
forall a. HasCallStack => Name -> a
error Name
"convExprProc: Cross product not implemented"
convExprProc (VVNBinaryOp VVNBinOp
Dot CodeExpr
a CodeExpr
b)   = (SValue r -> SValue r -> SValue r)
-> GenState (SValue r)
-> GenState (SValue r)
-> GenState (SValue r)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 SValue r -> SValue r -> SValue r
forall (r :: * -> *).
NativeVector r =>
SValue r -> SValue r -> SValue r
vecDot (CodeExpr -> GenState (SValue r)
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
a) (CodeExpr -> GenState (SValue r)
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
b)
convExprProc (NVVBinaryOp NVVBinOp
Scale CodeExpr
a CodeExpr
b) = (SValue r -> SValue r -> SValue r)
-> GenState (SValue r)
-> GenState (SValue r)
-> GenState (SValue r)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 SValue r -> SValue r -> SValue r
forall (r :: * -> *).
NativeVector r =>
SValue r -> SValue r -> SValue r
vecScale (CodeExpr -> GenState (SValue r)
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
a) (CodeExpr -> GenState (SValue r)
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
b)
convExprProc (ESSBinaryOp ESSBinOp
o CodeExpr
a CodeExpr
b)   = (SValue r -> SValue r -> SValue r)
-> GenState (SValue r)
-> GenState (SValue r)
-> GenState (SValue r)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (ESSBinOp -> SValue r -> SValue r -> SValue r
forall (r :: * -> *).
Set r =>
ESSBinOp -> SValue r -> SValue r -> SValue r
elementSetSetBfunc ESSBinOp
o) (CodeExpr -> GenState (SValue r)
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
a) (CodeExpr -> GenState (SValue r)
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
b)
convExprProc (ESBBinaryOp ESBBinOp
o CodeExpr
a CodeExpr
b)   = (SValue r -> SValue r -> SValue r)
-> GenState (SValue r)
-> GenState (SValue r)
-> GenState (SValue r)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (ESBBinOp -> SValue r -> SValue r -> SValue r
forall (r :: * -> *).
Set r =>
ESBBinOp -> SValue r -> SValue r -> SValue r
elementSetBoolBfunc ESBBinOp
o) (CodeExpr -> GenState (SValue r)
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
a) (CodeExpr -> GenState (SValue r)
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
b)
convExprProc (Case Completeness
c [(CodeExpr, CodeExpr)]
l)            = [(CodeExpr, CodeExpr)] -> GenState (SValue r)
forall {r :: * -> *} {smt}.
(SharedStatement r smt, TypeElim r, NativeVector r) =>
[(CodeExpr, CodeExpr)] -> GenState (SValue r)
doit [(CodeExpr, CodeExpr)]
l -- FIXME this is sub-optimal
  where
    doit :: [(CodeExpr, CodeExpr)] -> GenState (SValue r)
doit [] = Name -> GenState (SValue r)
forall a. HasCallStack => Name -> a
error Name
"should never happen" -- TODO: change error message?
    doit [(CodeExpr
e,CodeExpr
_)] = CodeExpr -> GenState (SValue r)
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
e -- should always be the else clause
    doit ((CodeExpr
e,CodeExpr
cond):[(CodeExpr, CodeExpr)]
xs) = (SValue r -> SValue r -> SValue r -> SValue r)
-> GenState (SValue r)
-> GenState (SValue r)
-> GenState (SValue r)
-> GenState (SValue r)
forall (m :: * -> *) a1 a2 a3 r.
Monad m =>
(a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r
liftM3 SValue r -> SValue r -> SValue r -> SValue r
forall (r :: * -> *).
ValueExpression r =>
SValue r -> SValue r -> SValue r -> SValue r
inlineIf (CodeExpr -> GenState (SValue r)
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
cond) (CodeExpr -> GenState (SValue r)
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
e)
      (CodeExpr -> GenState (SValue r)
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc (Completeness -> [(CodeExpr, CodeExpr)] -> CodeExpr
Case Completeness
c [(CodeExpr, CodeExpr)]
xs))
convExprProc (Matrix [[CodeExpr]
l]) = do
  [SValue r]
ar <- (CodeExpr -> GenState (SValue r))
-> [CodeExpr] -> StateT DrasilState Identity [SValue r]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM CodeExpr -> GenState (SValue r)
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc [CodeExpr]
l
                                    -- hd will never fail here
  SValue r -> GenState (SValue r)
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (SValue r -> GenState (SValue r))
-> SValue r -> GenState (SValue r)
forall a b. (a -> b) -> a -> b
$ VS (r TypeData) -> [SValue r] -> SValue r
forall (r :: * -> *).
Literal r =>
VS (r TypeData) -> [SValue r] -> SValue r
litArray ((r Value -> r TypeData) -> SValue r -> VS (r TypeData)
forall a b.
(a -> b)
-> StateT ValueState Identity a -> StateT ValueState Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap r Value -> r TypeData
forall (r :: * -> *). ValueSym r => r Value -> r TypeData
valueType ([SValue r] -> SValue r
forall a. HasCallStack => [a] -> a
head [SValue r]
ar)) [SValue r]
ar
convExprProc Matrix{} = Name -> GenState (SValue r)
forall a. HasCallStack => Name -> a
error Name
"convExprProc: Matrix"
convExprProc (S.Set Space
s [CodeExpr]
l) = do
  [SValue r]
ar <- (CodeExpr -> GenState (SValue r))
-> [CodeExpr] -> StateT DrasilState Identity [SValue r]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM CodeExpr -> GenState (SValue r)
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc [CodeExpr]
l
  CodeType
sm <- Space -> StateT DrasilState Identity CodeType
spaceCodeType Space
s
  SValue r -> GenState (SValue r)
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (SValue r -> GenState (SValue r))
-> SValue r -> GenState (SValue r)
forall a b. (a -> b) -> a -> b
$ VS (r TypeData) -> [SValue r] -> SValue r
forall (r :: * -> *).
Literal r =>
VS (r TypeData) -> [SValue r] -> SValue r
litSet (CodeType -> VS (r TypeData)
forall (r :: * -> *). TypeSym r => CodeType -> VS (r TypeData)
convType CodeType
sm) [SValue r]
ar
convExprProc (Variable Name
s (S.Set Space
l [CodeExpr]
_)) = do
  CodeType
sm <- Space -> StateT DrasilState Identity CodeType
spaceCodeType Space
l
  let varSet :: SVariable r
varSet = Name -> VS (r TypeData) -> SVariable r
forall (r :: * -> *).
VariableSym r =>
Name -> VS (r TypeData) -> SVariable r
var Name
s (VS (r TypeData) -> VS (r TypeData)
forall (r :: * -> *).
TypeSym r =>
VS (r TypeData) -> VS (r TypeData)
setType (VS (r TypeData) -> VS (r TypeData))
-> VS (r TypeData) -> VS (r TypeData)
forall a b. (a -> b) -> a -> b
$ CodeType -> VS (r TypeData)
forall (r :: * -> *). TypeSym r => CodeType -> VS (r TypeData)
convType CodeType
sm)
  SValue r -> GenState (SValue r)
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (SValue r -> GenState (SValue r))
-> SValue r -> GenState (SValue r)
forall a b. (a -> b) -> a -> b
$ SVariable r -> SValue r
forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
valueOf SVariable r
varSet
convExprProc (Variable Name
_ CodeExpr
_) = Name -> GenState (SValue r)
forall a. HasCallStack => Name -> a
error Name
"convExpr: Variable"
convExprProc Operator{} = Name -> GenState (SValue r)
forall a. HasCallStack => Name -> a
error Name
"convExprProc: Operator"
convExprProc (RealI UID
c RealInterval CodeExpr CodeExpr
ri)  = do
  DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  CodeExpr -> GenState (SValue r)
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc (CodeExpr -> GenState (SValue r))
-> CodeExpr -> GenState (SValue r)
forall a b. (a -> b) -> a -> b
$ DefinedQuantityDict -> RealInterval CodeExpr CodeExpr -> CodeExpr
forall c.
(IsChunk c, HasSymbol c) =>
c -> RealInterval CodeExpr CodeExpr -> CodeExpr
renderRealInt (DrasilState -> UID -> DefinedQuantityDict
lookupC DrasilState
g UID
c) RealInterval CodeExpr CodeExpr
ri

-- | Generates a function call, based on the 'UID' of the chunk representing
-- the function, the list of argument 'Expr's, the list of named argument 'Expr's,
-- the function call generator to use, and the library version of the function
-- call generator (used if the function is in the library export map).
convCallProc
  :: (NativeVector r, SharedStatement r smt, TypeElim r)
  => UID
  -> [CodeExpr]
  -> [(UID, CodeExpr)]
  -> (Name -> Name -> VS (r TypeData) -> [SValue r] -> NamedArgs r -> GenState (SValue r))
  -> (Name -> Name -> VS (r TypeData) -> [SValue r] -> NamedArgs r -> SValue r)
  -> GenState (SValue r)
convCallProc :: forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
UID
-> [CodeExpr]
-> [(UID, CodeExpr)]
-> (Name
    -> Name
    -> VS (r TypeData)
    -> [SValue r]
    -> NamedArgs r
    -> GenState (SValue r))
-> (Name
    -> Name
    -> VS (r TypeData)
    -> [SValue r]
    -> NamedArgs r
    -> SValue r)
-> GenState (SValue r)
convCallProc UID
c [CodeExpr]
x [(UID, CodeExpr)]
ns Name
-> Name
-> VS (r TypeData)
-> [SValue r]
-> NamedArgs r
-> GenState (SValue r)
f Name
-> Name -> VS (r TypeData) -> [SValue r] -> NamedArgs r -> SValue r
libf = do
  DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  let mem :: Map Name Name
mem = DrasilState -> Map Name Name
eMap DrasilState
g
      lem :: Map Name Name
lem = DrasilState -> Map Name Name
libEMap DrasilState
g
      funcCd :: CodeFuncChunk
funcCd = DefinedQuantityDict -> CodeFuncChunk
forall c.
(Quantity c, MayHaveUnit c, Concept c) =>
c -> CodeFuncChunk
quantfunc (DrasilState -> UID -> DefinedQuantityDict
lookupC DrasilState
g UID
c)
      funcNm :: Name
funcNm = CodeFuncChunk -> Name
forall c. CodeIdea c => c -> Name
codeName CodeFuncChunk
funcCd
  CodeType
funcTp <- CodeFuncChunk -> StateT DrasilState Identity CodeType
forall c. HasSpace c => c -> StateT DrasilState Identity CodeType
codeType CodeFuncChunk
funcCd
  [SValue r]
args <- (CodeExpr -> GenState (SValue r))
-> [CodeExpr] -> StateT DrasilState Identity [SValue r]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM CodeExpr -> GenState (SValue r)
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc [CodeExpr]
x
  [SVariable r]
nms <- ((UID, CodeExpr) -> StateT DrasilState Identity (SVariable r))
-> [(UID, CodeExpr)] -> StateT DrasilState Identity [SVariable r]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Input -> StateT DrasilState Identity (SVariable r)
forall (r :: * -> *).
VariableSym r =>
Input -> GenState (SVariable r)
mkVarProc (Input -> StateT DrasilState Identity (SVariable r))
-> ((UID, CodeExpr) -> Input)
-> (UID, CodeExpr)
-> StateT DrasilState Identity (SVariable r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DefinedQuantityDict -> Input
forall c. (Quantity c, MayHaveUnit c, Concept c) => c -> Input
quantvar (DefinedQuantityDict -> Input)
-> ((UID, CodeExpr) -> DefinedQuantityDict)
-> (UID, CodeExpr)
-> Input
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DrasilState -> UID -> DefinedQuantityDict
lookupC DrasilState
g (UID -> DefinedQuantityDict)
-> ((UID, CodeExpr) -> UID)
-> (UID, CodeExpr)
-> DefinedQuantityDict
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UID, CodeExpr) -> UID
forall a b. (a, b) -> a
fst) [(UID, CodeExpr)]
ns
  [SValue r]
nargs <- ((UID, CodeExpr) -> GenState (SValue r))
-> [(UID, CodeExpr)] -> StateT DrasilState Identity [SValue r]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (CodeExpr -> GenState (SValue r)
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc (CodeExpr -> GenState (SValue r))
-> ((UID, CodeExpr) -> CodeExpr)
-> (UID, CodeExpr)
-> GenState (SValue r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UID, CodeExpr) -> CodeExpr
forall a b. (a, b) -> b
snd) [(UID, CodeExpr)]
ns
  GenState (SValue r)
-> (Name -> GenState (SValue r))
-> Maybe Name
-> GenState (SValue r)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (GenState (SValue r)
-> (Name -> GenState (SValue r))
-> Maybe Name
-> GenState (SValue r)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Name -> GenState (SValue r)
forall a. HasCallStack => Name -> a
error (Name -> GenState (SValue r)) -> Name -> GenState (SValue r)
forall a b. (a -> b) -> a -> b
$ Name
"Call to non-existent function " Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Name
funcNm)
      (\Name
m -> SValue r -> GenState (SValue r)
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (SValue r -> GenState (SValue r))
-> SValue r -> GenState (SValue r)
forall a b. (a -> b) -> a -> b
$ Name
-> Name -> VS (r TypeData) -> [SValue r] -> NamedArgs r -> SValue r
libf Name
m Name
funcNm (CodeType -> VS (r TypeData)
forall (r :: * -> *). TypeSym r => CodeType -> VS (r TypeData)
convType CodeType
funcTp) [SValue r]
args ([SVariable r] -> [SValue r] -> NamedArgs r
forall a b. [a] -> [b] -> [(a, b)]
zip [SVariable r]
nms [SValue r]
nargs))
      (Name -> Map Name Name -> Maybe Name
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
funcNm Map Name Name
lem))
    (\Name
m -> Name
-> Name
-> VS (r TypeData)
-> [SValue r]
-> NamedArgs r
-> GenState (SValue r)
f Name
m Name
funcNm (CodeType -> VS (r TypeData)
forall (r :: * -> *). TypeSym r => CodeType -> VS (r TypeData)
convType CodeType
funcTp) [SValue r]
args ([SVariable r] -> [SValue r] -> NamedArgs r
forall a b. [a] -> [b] -> [(a, b)]
zip [SVariable r]
nms [SValue r]
nargs))
    (Name -> Map Name Name -> Maybe Name
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
funcNm Map Name Name
mem)

-- | Converts a 'FuncStmt' to a GOOL Statement.
convStmtProc
  :: (NativeVector r, SharedStatement r smt, TypeElim r, VariableElim r)
  => FuncStmt -> GenState (MS (r smt))
convStmtProc :: forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r,
 VariableElim r) =>
FuncStmt -> GenState (MS (r smt))
convStmtProc (FAsg Input
v (Matrix [[CodeExpr]
es])) = do
  [SValue r]
els <- (CodeExpr -> StateT DrasilState Identity (SValue r))
-> [CodeExpr] -> StateT DrasilState Identity [SValue r]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM CodeExpr -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc [CodeExpr]
es
  SVariable r
v' <- Input -> GenState (SVariable r)
forall (r :: * -> *).
VariableSym r =>
Input -> GenState (SVariable r)
mkVarProc Input
v
  CodeType
t <- Input -> StateT DrasilState Identity CodeType
forall c. HasSpace c => c -> StateT DrasilState Identity CodeType
codeType Input
v
  let listFunc :: CodeType -> VS (r TypeData) -> [SValue r] -> SValue r
listFunc (C.List CodeType
_) = VS (r TypeData) -> [SValue r] -> SValue r
forall (r :: * -> *).
Literal r =>
VS (r TypeData) -> [SValue r] -> SValue r
litList
      listFunc (C.Array CodeType
_) = VS (r TypeData) -> [SValue r] -> SValue r
forall (r :: * -> *).
Literal r =>
VS (r TypeData) -> [SValue r] -> SValue r
litArray
      listFunc CodeType
_ = Name -> VS (r TypeData) -> [SValue r] -> SValue r
forall a. HasCallStack => Name -> a
error Name
"Type mismatch between variable and value in assignment FuncStmt"
  MS (r smt) -> GenState (MS (r smt))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (MS (r smt) -> GenState (MS (r smt)))
-> MS (r smt) -> GenState (MS (r smt))
forall a b. (a -> b) -> a -> b
$ SVariable r -> SValue r -> MS (r smt)
forall (r :: * -> *) smt.
AssignStatement r smt =>
SVariable r -> SValue r -> MS (r smt)
assign SVariable r
v' (CodeType -> VS (r TypeData) -> [SValue r] -> SValue r
forall {r :: * -> *}.
Literal r =>
CodeType -> VS (r TypeData) -> [SValue r] -> SValue r
listFunc CodeType
t (VS (r TypeData) -> VS (r TypeData)
forall (r :: * -> *).
TypeSym r =>
VS (r TypeData) -> VS (r TypeData)
innerType (VS (r TypeData) -> VS (r TypeData))
-> VS (r TypeData) -> VS (r TypeData)
forall a b. (a -> b) -> a -> b
$ (r Variable -> r TypeData) -> SVariable r -> VS (r TypeData)
forall a b.
(a -> b)
-> StateT ValueState Identity a -> StateT ValueState Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap r Variable -> r TypeData
forall (r :: * -> *). VariableElim r => r Variable -> r TypeData
variableType SVariable r
v')
    [SValue r]
els)
convStmtProc (FAsg Input
v CodeExpr
e) = do
  SValue r
e' <- CodeExpr -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
e
  SVariable r
v' <- Input -> GenState (SVariable r)
forall (r :: * -> *).
VariableSym r =>
Input -> GenState (SVariable r)
mkVarProc Input
v
  MS (r smt) -> GenState (MS (r smt))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (MS (r smt) -> GenState (MS (r smt)))
-> MS (r smt) -> GenState (MS (r smt))
forall a b. (a -> b) -> a -> b
$ SVariable r -> SValue r -> MS (r smt)
forall (r :: * -> *) smt.
AssignStatement r smt =>
SVariable r -> SValue r -> MS (r smt)
assign SVariable r
v' SValue r
e'
convStmtProc (FAsgIndex Input
v Integer
i CodeExpr
e) = do
  SValue r
e' <- CodeExpr -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
e
  SVariable r
v' <- Input -> GenState (SVariable r)
forall (r :: * -> *).
VariableSym r =>
Input -> GenState (SVariable r)
mkVarProc Input
v
  CodeType
t <- Input -> StateT DrasilState Identity CodeType
forall c. HasSpace c => c -> StateT DrasilState Identity CodeType
codeType Input
v
  let asgFunc :: CodeType -> MS (r smt)
asgFunc (C.List CodeType
_) = SValue r -> SValue r -> SValue r -> MS (r smt)
forall (r :: * -> *) smt.
List r smt =>
SValue r -> SValue r -> SValue r -> MS (r smt)
listSet (SVariable r -> SValue r
forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
valueOf SVariable r
v') (Integer -> SValue r
forall (r :: * -> *). Literal r => Integer -> SValue r
litInt Integer
i) SValue r
e'
      asgFunc (C.Array CodeType
_) = SVariable r -> SValue r -> MS (r smt)
forall (r :: * -> *) smt.
AssignStatement r smt =>
SVariable r -> SValue r -> MS (r smt)
assign (SValue r -> SValue r -> SVariable r
forall (r :: * -> *).
Array r =>
SValue r -> SValue r -> SVariable r
arrayElem (SVariable r -> SValue r
forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
valueOf SVariable r
v') (Integer -> SValue r
forall (r :: * -> *). Literal r => Integer -> SValue r
litInt Integer
i)) SValue r
e'
      asgFunc CodeType
_ = Name -> MS (r smt)
forall a. HasCallStack => Name -> a
error Name
"FAsgIndex used with non-indexed value"
  MS (r smt) -> GenState (MS (r smt))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (MS (r smt) -> GenState (MS (r smt)))
-> MS (r smt) -> GenState (MS (r smt))
forall a b. (a -> b) -> a -> b
$ CodeType -> MS (r smt)
asgFunc CodeType
t
convStmtProc (FFor Input
v CodeExpr
start CodeExpr
end CodeExpr
step [FuncStmt]
st) = do
  [MS (r smt)]
stmts <- (FuncStmt -> GenState (MS (r smt)))
-> [FuncStmt] -> StateT DrasilState Identity [MS (r smt)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM FuncStmt -> GenState (MS (r smt))
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r,
 VariableElim r) =>
FuncStmt -> GenState (MS (r smt))
convStmtProc [FuncStmt]
st
  SVariable r
vari <- Input -> GenState (SVariable r)
forall (r :: * -> *).
VariableSym r =>
Input -> GenState (SVariable r)
mkVarProc Input
v
  SValue r
start' <- CodeExpr -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
start
  SValue r
end' <- CodeExpr -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
end
  SValue r
step' <- CodeExpr -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
step
  MS (r smt) -> GenState (MS (r smt))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (MS (r smt) -> GenState (MS (r smt)))
-> MS (r smt) -> GenState (MS (r smt))
forall a b. (a -> b) -> a -> b
$ SVariable r
-> SValue r -> SValue r -> SValue r -> MS (r Block) -> MS (r smt)
forall (r :: * -> *) smt.
ControlStatement r smt =>
SVariable r
-> SValue r -> SValue r -> SValue r -> MS (r Block) -> MS (r smt)
forRange SVariable r
vari SValue r
start' SValue r
end' SValue r
step' ([MS (r smt)] -> MS (r Block)
forall (r :: * -> *) smt.
BodySym r smt =>
[MS (r smt)] -> MS (r Block)
bodyStatements [MS (r smt)]
stmts)
convStmtProc (FForEach Input
v CodeExpr
e [FuncStmt]
st) = do
  [MS (r smt)]
stmts <- (FuncStmt -> GenState (MS (r smt)))
-> [FuncStmt] -> StateT DrasilState Identity [MS (r smt)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM FuncStmt -> GenState (MS (r smt))
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r,
 VariableElim r) =>
FuncStmt -> GenState (MS (r smt))
convStmtProc [FuncStmt]
st
  SVariable r
vari <- Input -> GenState (SVariable r)
forall (r :: * -> *).
VariableSym r =>
Input -> GenState (SVariable r)
mkVarProc Input
v
  SValue r
e' <- CodeExpr -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
e
  MS (r smt) -> GenState (MS (r smt))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (MS (r smt) -> GenState (MS (r smt)))
-> MS (r smt) -> GenState (MS (r smt))
forall a b. (a -> b) -> a -> b
$ SVariable r -> SValue r -> MS (r Block) -> MS (r smt)
forall (r :: * -> *) smt.
ControlStatement r smt =>
SVariable r -> SValue r -> MS (r Block) -> MS (r smt)
forEach SVariable r
vari SValue r
e' ([MS (r smt)] -> MS (r Block)
forall (r :: * -> *) smt.
BodySym r smt =>
[MS (r smt)] -> MS (r Block)
bodyStatements [MS (r smt)]
stmts)
convStmtProc (FWhile CodeExpr
e [FuncStmt]
st) = do
  [MS (r smt)]
stmts <- (FuncStmt -> GenState (MS (r smt)))
-> [FuncStmt] -> StateT DrasilState Identity [MS (r smt)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM FuncStmt -> GenState (MS (r smt))
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r,
 VariableElim r) =>
FuncStmt -> GenState (MS (r smt))
convStmtProc [FuncStmt]
st
  SValue r
e' <- CodeExpr -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
e
  MS (r smt) -> GenState (MS (r smt))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (MS (r smt) -> GenState (MS (r smt)))
-> MS (r smt) -> GenState (MS (r smt))
forall a b. (a -> b) -> a -> b
$ SValue r -> MS (r Block) -> MS (r smt)
forall (r :: * -> *) smt.
ControlStatement r smt =>
SValue r -> MS (r Block) -> MS (r smt)
while SValue r
e' ([MS (r smt)] -> MS (r Block)
forall (r :: * -> *) smt.
BodySym r smt =>
[MS (r smt)] -> MS (r Block)
bodyStatements [MS (r smt)]
stmts)
convStmtProc (FCond CodeExpr
e [FuncStmt]
tSt []) = do
  [MS (r smt)]
stmts <- (FuncStmt -> GenState (MS (r smt)))
-> [FuncStmt] -> StateT DrasilState Identity [MS (r smt)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM FuncStmt -> GenState (MS (r smt))
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r,
 VariableElim r) =>
FuncStmt -> GenState (MS (r smt))
convStmtProc [FuncStmt]
tSt
  SValue r
e' <- CodeExpr -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
e
  MS (r smt) -> GenState (MS (r smt))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (MS (r smt) -> GenState (MS (r smt)))
-> MS (r smt) -> GenState (MS (r smt))
forall a b. (a -> b) -> a -> b
$ [(SValue r, MS (r Block))] -> MS (r smt)
forall (r :: * -> *) smt.
ControlStatement r smt =>
[(SValue r, MS (r Block))] -> MS (r smt)
ifNoElse [(SValue r
e', [MS (r smt)] -> MS (r Block)
forall (r :: * -> *) smt.
BodySym r smt =>
[MS (r smt)] -> MS (r Block)
bodyStatements [MS (r smt)]
stmts)]
convStmtProc (FCond CodeExpr
e [FuncStmt]
tSt [FuncStmt]
eSt) = do
  [MS (r smt)]
stmt1 <- (FuncStmt -> GenState (MS (r smt)))
-> [FuncStmt] -> StateT DrasilState Identity [MS (r smt)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM FuncStmt -> GenState (MS (r smt))
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r,
 VariableElim r) =>
FuncStmt -> GenState (MS (r smt))
convStmtProc [FuncStmt]
tSt
  [MS (r smt)]
stmt2 <- (FuncStmt -> GenState (MS (r smt)))
-> [FuncStmt] -> StateT DrasilState Identity [MS (r smt)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM FuncStmt -> GenState (MS (r smt))
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r,
 VariableElim r) =>
FuncStmt -> GenState (MS (r smt))
convStmtProc [FuncStmt]
eSt
  SValue r
e' <- CodeExpr -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
e
  MS (r smt) -> GenState (MS (r smt))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (MS (r smt) -> GenState (MS (r smt)))
-> MS (r smt) -> GenState (MS (r smt))
forall a b. (a -> b) -> a -> b
$ [(SValue r, MS (r Block))] -> MS (r Block) -> MS (r smt)
forall (r :: * -> *) smt.
ControlStatement r smt =>
[(SValue r, MS (r Block))] -> MS (r Block) -> MS (r smt)
ifCond [(SValue r
e', [MS (r smt)] -> MS (r Block)
forall (r :: * -> *) smt.
BodySym r smt =>
[MS (r smt)] -> MS (r Block)
bodyStatements [MS (r smt)]
stmt1)] ([MS (r smt)] -> MS (r Block)
forall (r :: * -> *) smt.
BodySym r smt =>
[MS (r smt)] -> MS (r Block)
bodyStatements [MS (r smt)]
stmt2)
convStmtProc (FRet CodeExpr
e) = do
  SValue r
e' <- CodeExpr -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
e
  MS (r smt) -> GenState (MS (r smt))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (MS (r smt) -> GenState (MS (r smt)))
-> MS (r smt) -> GenState (MS (r smt))
forall a b. (a -> b) -> a -> b
$ SValue r -> MS (r smt)
forall (r :: * -> *) smt.
ControlStatement r smt =>
SValue r -> MS (r smt)
returnStmt SValue r
e'
convStmtProc (FThrow Name
s) = MS (r smt) -> GenState (MS (r smt))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (MS (r smt) -> GenState (MS (r smt)))
-> MS (r smt) -> GenState (MS (r smt))
forall a b. (a -> b) -> a -> b
$ Name -> MS (r smt)
forall (r :: * -> *) smt.
ControlStatement r smt =>
Name -> MS (r smt)
throw Name
s
convStmtProc (FTry [FuncStmt]
t [FuncStmt]
c) = do
  [MS (r smt)]
stmt1 <- (FuncStmt -> GenState (MS (r smt)))
-> [FuncStmt] -> StateT DrasilState Identity [MS (r smt)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM FuncStmt -> GenState (MS (r smt))
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r,
 VariableElim r) =>
FuncStmt -> GenState (MS (r smt))
convStmtProc [FuncStmt]
t
  [MS (r smt)]
stmt2 <- (FuncStmt -> GenState (MS (r smt)))
-> [FuncStmt] -> StateT DrasilState Identity [MS (r smt)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM FuncStmt -> GenState (MS (r smt))
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r,
 VariableElim r) =>
FuncStmt -> GenState (MS (r smt))
convStmtProc [FuncStmt]
c
  MS (r smt) -> GenState (MS (r smt))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (MS (r smt) -> GenState (MS (r smt)))
-> MS (r smt) -> GenState (MS (r smt))
forall a b. (a -> b) -> a -> b
$ MS (r Block) -> MS (r Block) -> MS (r smt)
forall (r :: * -> *) smt.
ControlStatement r smt =>
MS (r Block) -> MS (r Block) -> MS (r smt)
tryCatch ([MS (r smt)] -> MS (r Block)
forall (r :: * -> *) smt.
BodySym r smt =>
[MS (r smt)] -> MS (r Block)
bodyStatements [MS (r smt)]
stmt1) ([MS (r smt)] -> MS (r Block)
forall (r :: * -> *) smt.
BodySym r smt =>
[MS (r smt)] -> MS (r Block)
bodyStatements [MS (r smt)]
stmt2)
convStmtProc FuncStmt
FContinue = MS (r smt) -> GenState (MS (r smt))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return MS (r smt)
forall (r :: * -> *) smt. ControlStatement r smt => MS (r smt)
continue
convStmtProc (FDecDef Input
v (Matrix [[]])) = do
  DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  let scp :: r ScopeData
scp = ScopeType -> r ScopeData
forall (r :: * -> *). ScopeSym r => ScopeType -> r ScopeData
convScope (ScopeType -> r ScopeData) -> ScopeType -> r ScopeData
forall a b. (a -> b) -> a -> b
$ DrasilState -> ScopeType
currentScope DrasilState
g
  SVariable r
vari <- Input -> GenState (SVariable r)
forall (r :: * -> *).
VariableSym r =>
Input -> GenState (SVariable r)
mkVarProc Input
v
  let convDec :: CodeType -> r ScopeData -> MS (r smt)
convDec (C.List CodeType
_) = Integer -> SVariable r -> r ScopeData -> MS (r smt)
forall (r :: * -> *) smt.
DeclStatement r smt =>
Integer -> SVariable r -> r ScopeData -> MS (r smt)
listDec Integer
0 SVariable r
vari
      convDec (C.Array CodeType
_) = Integer -> SValue r -> SVariable r -> r ScopeData -> MS (r smt)
forall (r :: * -> *) smt.
DeclStatement r smt =>
Integer -> SValue r -> SVariable r -> r ScopeData -> MS (r smt)
arrayDec Integer
0 SValue r
forall a. HasCallStack => a
undefined SVariable r
vari
      convDec CodeType
_ = SVariable r -> r ScopeData -> MS (r smt)
forall (r :: * -> *) smt.
DeclStatement r smt =>
SVariable r -> r ScopeData -> MS (r smt)
varDec SVariable r
vari
  (CodeType -> MS (r smt))
-> StateT DrasilState Identity CodeType -> GenState (MS (r smt))
forall a b.
(a -> b)
-> StateT DrasilState Identity a -> StateT DrasilState Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (CodeType -> r ScopeData -> MS (r smt)
`convDec` r ScopeData
scp) (Input -> StateT DrasilState Identity CodeType
forall c. HasSpace c => c -> StateT DrasilState Identity CodeType
codeType Input
v)
convStmtProc (FDecDef Input
v CodeExpr
e) = do
  DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  let scp :: r ScopeData
scp = ScopeType -> r ScopeData
forall (r :: * -> *). ScopeSym r => ScopeType -> r ScopeData
convScope (ScopeType -> r ScopeData) -> ScopeType -> r ScopeData
forall a b. (a -> b) -> a -> b
$ DrasilState -> ScopeType
currentScope DrasilState
g
  SVariable r
v' <- Input -> GenState (SVariable r)
forall (r :: * -> *).
VariableSym r =>
Input -> GenState (SVariable r)
mkVarProc Input
v
  CodeType
t <- Input -> StateT DrasilState Identity CodeType
forall c. HasSpace c => c -> StateT DrasilState Identity CodeType
codeType Input
v
  let convDecDef :: CodeExpr -> GenState (MS (r smt))
convDecDef (Matrix [[CodeExpr]
lst]) = do
        let contDecDef :: CodeType -> SVariable r -> r ScopeData -> [SValue r] -> MS (r smt)
contDecDef (C.List CodeType
_) = SVariable r -> r ScopeData -> [SValue r] -> MS (r smt)
forall (r :: * -> *) smt.
DeclStatement r smt =>
SVariable r -> r ScopeData -> [SValue r] -> MS (r smt)
listDecDef
            contDecDef (C.Array CodeType
_) = SVariable r -> r ScopeData -> [SValue r] -> MS (r smt)
forall (r :: * -> *) smt.
DeclStatement r smt =>
SVariable r -> r ScopeData -> [SValue r] -> MS (r smt)
arrayDecDef
            contDecDef CodeType
_ = Name -> SVariable r -> r ScopeData -> [SValue r] -> MS (r smt)
forall a. HasCallStack => Name -> a
error Name
"Type mismatch between variable and value in declare-define FuncStmt"
        [SValue r]
e' <- (CodeExpr -> StateT DrasilState Identity (SValue r))
-> [CodeExpr] -> StateT DrasilState Identity [SValue r]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM CodeExpr -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc [CodeExpr]
lst
        MS (r smt) -> GenState (MS (r smt))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (MS (r smt) -> GenState (MS (r smt)))
-> MS (r smt) -> GenState (MS (r smt))
forall a b. (a -> b) -> a -> b
$ CodeType -> SVariable r -> r ScopeData -> [SValue r] -> MS (r smt)
forall {r :: * -> *} {smt}.
DeclStatement r smt =>
CodeType -> SVariable r -> r ScopeData -> [SValue r] -> MS (r smt)
contDecDef CodeType
t SVariable r
v' r ScopeData
scp [SValue r]
e'
      convDecDef CodeExpr
_ = do
        SValue r
e' <- CodeExpr -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
e
        MS (r smt) -> GenState (MS (r smt))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (MS (r smt) -> GenState (MS (r smt)))
-> MS (r smt) -> GenState (MS (r smt))
forall a b. (a -> b) -> a -> b
$ SVariable r -> r ScopeData -> SValue r -> MS (r smt)
forall (r :: * -> *) smt.
DeclStatement r smt =>
SVariable r -> r ScopeData -> SValue r -> MS (r smt)
varDecDef SVariable r
v' r ScopeData
scp SValue r
e'
  CodeExpr -> GenState (MS (r smt))
convDecDef CodeExpr
e
convStmtProc (FFuncDef CodeFuncChunk
f [ParameterChunk]
ps [FuncStmt]
sts) = do
  DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  let scp :: r ScopeData
scp = ScopeType -> r ScopeData
forall (r :: * -> *). ScopeSym r => ScopeType -> r ScopeData
convScope (ScopeType -> r ScopeData) -> ScopeType -> r ScopeData
forall a b. (a -> b) -> a -> b
$ DrasilState -> ScopeType
currentScope DrasilState
g
  SVariable r
f' <- Input -> GenState (SVariable r)
forall (r :: * -> *).
VariableSym r =>
Input -> GenState (SVariable r)
mkVarProc (CodeFuncChunk -> Input
forall c. (Quantity c, MayHaveUnit c, Concept c) => c -> Input
quantvar CodeFuncChunk
f)
  [SVariable r]
pms <- (ParameterChunk -> GenState (SVariable r))
-> [ParameterChunk] -> StateT DrasilState Identity [SVariable r]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Input -> GenState (SVariable r)
forall (r :: * -> *).
VariableSym r =>
Input -> GenState (SVariable r)
mkVarProc (Input -> GenState (SVariable r))
-> (ParameterChunk -> Input)
-> ParameterChunk
-> GenState (SVariable r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParameterChunk -> Input
forall c. (Quantity c, MayHaveUnit c, Concept c) => c -> Input
quantvar) [ParameterChunk]
ps
  [MS (r smt)]
b <- (FuncStmt -> GenState (MS (r smt)))
-> [FuncStmt] -> StateT DrasilState Identity [MS (r smt)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM FuncStmt -> GenState (MS (r smt))
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r,
 VariableElim r) =>
FuncStmt -> GenState (MS (r smt))
convStmtProc [FuncStmt]
sts
  MS (r smt) -> GenState (MS (r smt))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (MS (r smt) -> GenState (MS (r smt)))
-> MS (r smt) -> GenState (MS (r smt))
forall a b. (a -> b) -> a -> b
$ SVariable r
-> r ScopeData -> [SVariable r] -> MS (r Block) -> MS (r smt)
forall (r :: * -> *) smt.
DeclStatement r smt =>
SVariable r
-> r ScopeData -> [SVariable r] -> MS (r Block) -> MS (r smt)
funcDecDef SVariable r
f' r ScopeData
scp [SVariable r]
pms ([MS (r smt)] -> MS (r Block)
forall (r :: * -> *) smt.
BodySym r smt =>
[MS (r smt)] -> MS (r Block)
bodyStatements [MS (r smt)]
b)
convStmtProc (FVal CodeExpr
e) = do
  SValue r
e' <- CodeExpr -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
e
  MS (r smt) -> GenState (MS (r smt))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (MS (r smt) -> GenState (MS (r smt)))
-> MS (r smt) -> GenState (MS (r smt))
forall a b. (a -> b) -> a -> b
$ SValue r -> MS (r smt)
forall (r :: * -> *) smt.
StatementSym r smt =>
SValue r -> MS (r smt)
valStmt SValue r
e'
convStmtProc (FMulti [FuncStmt]
ss) = do
  [MS (r smt)]
stmts <- (FuncStmt -> GenState (MS (r smt)))
-> [FuncStmt] -> StateT DrasilState Identity [MS (r smt)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM FuncStmt -> GenState (MS (r smt))
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r,
 VariableElim r) =>
FuncStmt -> GenState (MS (r smt))
convStmtProc [FuncStmt]
ss
  MS (r smt) -> GenState (MS (r smt))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (MS (r smt) -> GenState (MS (r smt)))
-> MS (r smt) -> GenState (MS (r smt))
forall a b. (a -> b) -> a -> b
$ [MS (r smt)] -> MS (r smt)
forall (r :: * -> *) smt.
StatementSym r smt =>
[MS (r smt)] -> MS (r smt)
multi [MS (r smt)]
stmts
convStmtProc (FAppend CodeExpr
a CodeExpr
b) = do
  SValue r
a' <- CodeExpr -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
a
  SValue r
b' <- CodeExpr -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
b
  MS (r smt) -> GenState (MS (r smt))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (MS (r smt) -> GenState (MS (r smt)))
-> MS (r smt) -> GenState (MS (r smt))
forall a b. (a -> b) -> a -> b
$ SValue r -> SValue r -> MS (r smt)
forall (r :: * -> *) smt.
List r smt =>
SValue r -> SValue r -> MS (r smt)
listAppend SValue r
a' SValue r
b'

-- | Generates a function that reads a file whose format is based on the passed
-- 'DataDesc'.
genDataFuncProc
  :: (SharedProg r vis smt md, NativeVector r)
  => Name -> Description -> DataDesc -> GenState (MS (r md))
genDataFuncProc :: forall (r :: * -> *) vis smt md.
(SharedProg r vis smt md, NativeVector r) =>
Name -> Name -> DataDesc -> GenState (MS (r md))
genDataFuncProc Name
nameTitle Name
desc DataDesc
ddef = do
  let parms :: [Input]
parms = DataDesc -> [Input]
getInputs DataDesc
ddef
  [MS (r Block)]
bod <- DataDesc -> GenState [MS (r Block)]
forall (r :: * -> *) smt.
(NativeVector r, SharedStatement r smt, TypeElim r) =>
DataDesc -> GenState [MS (r Block)]
readDataProc DataDesc
ddef
  Name
-> VS (r TypeData)
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MS (r Block)]
-> GenState (MS (r md))
forall (r :: * -> *) vis smt md.
SharedProg r vis smt md =>
Name
-> VS (r TypeData)
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MS (r Block)]
-> GenState (MS (r md))
publicFuncProc Name
nameTitle VS (r TypeData)
forall (r :: * -> *). TypeSym r => VS (r TypeData)
void Name
desc ((Input -> ParameterChunk) -> [Input] -> [ParameterChunk]
forall a b. (a -> b) -> [a] -> [b]
map Input -> ParameterChunk
forall c. CodeIdea c => c -> ParameterChunk
pcAuto ([Input] -> [ParameterChunk]) -> [Input] -> [ParameterChunk]
forall a b. (a -> b) -> a -> b
$ DefinedQuantityDict -> Input
forall c. (Quantity c, MayHaveUnit c, Concept c) => c -> Input
quantvar DefinedQuantityDict
inFileName Input -> [Input] -> [Input]
forall a. a -> [a] -> [a]
: [Input]
parms)
    Maybe Name
forall a. Maybe a
Nothing [MS (r Block)]
bod

-- | Generates a public function, defined by its inputs and outputs.
publicInOutFuncProc
  :: (SharedProg r vis smt md)
  => Label
  -> Description
  -> [CodeVarChunk]
  -> [CodeVarChunk]
  -> [MS (r Block)]
  -> GenState (MS (r md))
publicInOutFuncProc :: forall (r :: * -> *) vis smt md.
SharedProg r vis smt md =>
Name
-> Name
-> [Input]
-> [Input]
-> [MS (r Block)]
-> GenState (MS (r md))
publicInOutFuncProc Name
n = ([SVariable r]
 -> [SVariable r] -> [SVariable r] -> MS (r Block) -> MS (r md))
-> (Name
    -> [(Name, SVariable r)]
    -> [(Name, SVariable r)]
    -> [(Name, SVariable r)]
    -> MS (r Block)
    -> MS (r md))
-> Name
-> Name
-> [Input]
-> [Input]
-> [MS (r Block)]
-> GenState (MS (r md))
forall (r :: * -> *) smt md.
(SharedStatement r smt, VariableElim r) =>
([SVariable r]
 -> [SVariable r] -> [SVariable r] -> MS (r Block) -> MS (r md))
-> (Name
    -> [(Name, SVariable r)]
    -> [(Name, SVariable r)]
    -> [(Name, SVariable r)]
    -> MS (r Block)
    -> MS (r md))
-> Name
-> Name
-> [Input]
-> [Input]
-> [MS (r Block)]
-> GenState (MS (r md))
genInOutFuncProc (Name
-> r vis
-> [SVariable r]
-> [SVariable r]
-> [SVariable r]
-> MS (r Block)
-> MS (r md)
forall (r :: * -> *) vis smt md.
MethodSym r vis smt md =>
Name -> r vis -> InOutFunc r md
inOutFunc Name
n r vis
forall (r :: * -> *) vis. VisibilitySym r vis => r vis
public) (Name
-> r vis
-> Name
-> [(Name, SVariable r)]
-> [(Name, SVariable r)]
-> [(Name, SVariable r)]
-> MS (r Block)
-> MS (r md)
forall (r :: * -> *) vis smt md.
MethodSym r vis smt md =>
Name -> r vis -> DocInOutFunc r md
docInOutFunc Name
n r vis
forall (r :: * -> *) vis. VisibilitySym r vis => r vis
public) Name
n

-- | Generates a private function, defined by its inputs and outputs.
privateInOutFuncProc
  :: (SharedProg r vis smt md)
  => Label
  -> Description
  -> [CodeVarChunk]
  -> [CodeVarChunk]
  -> [MS (r Block)]
  -> GenState (MS (r md))
privateInOutFuncProc :: forall (r :: * -> *) vis smt md.
SharedProg r vis smt md =>
Name
-> Name
-> [Input]
-> [Input]
-> [MS (r Block)]
-> GenState (MS (r md))
privateInOutFuncProc Name
n = ([SVariable r]
 -> [SVariable r] -> [SVariable r] -> MS (r Block) -> MS (r md))
-> (Name
    -> [(Name, SVariable r)]
    -> [(Name, SVariable r)]
    -> [(Name, SVariable r)]
    -> MS (r Block)
    -> MS (r md))
-> Name
-> Name
-> [Input]
-> [Input]
-> [MS (r Block)]
-> GenState (MS (r md))
forall (r :: * -> *) smt md.
(SharedStatement r smt, VariableElim r) =>
([SVariable r]
 -> [SVariable r] -> [SVariable r] -> MS (r Block) -> MS (r md))
-> (Name
    -> [(Name, SVariable r)]
    -> [(Name, SVariable r)]
    -> [(Name, SVariable r)]
    -> MS (r Block)
    -> MS (r md))
-> Name
-> Name
-> [Input]
-> [Input]
-> [MS (r Block)]
-> GenState (MS (r md))
genInOutFuncProc (Name
-> r vis
-> [SVariable r]
-> [SVariable r]
-> [SVariable r]
-> MS (r Block)
-> MS (r md)
forall (r :: * -> *) vis smt md.
MethodSym r vis smt md =>
Name -> r vis -> InOutFunc r md
inOutFunc Name
n r vis
forall (r :: * -> *) vis. VisibilitySym r vis => r vis
private) (Name
-> r vis
-> Name
-> [(Name, SVariable r)]
-> [(Name, SVariable r)]
-> [(Name, SVariable r)]
-> MS (r Block)
-> MS (r md)
forall (r :: * -> *) vis smt md.
MethodSym r vis smt md =>
Name -> r vis -> DocInOutFunc r md
docInOutFunc Name
n r vis
forall (r :: * -> *) vis. VisibilitySym r vis => r vis
private) Name
n

-- | Generates a function or method defined by its inputs and outputs.
-- Parameters are: the GOOL constructor to use, the equivalent GOOL constructor
-- for a documented function/method, the visibility, attachment, name, description,
-- list of inputs, list of outputs, and body.
genInOutFuncProc
  :: (SharedStatement r smt, VariableElim r)
  => ([SVariable r] -> [SVariable r] -> [SVariable r] -> MS (r Body) -> MS (r md))
  -> (String -> [(String, SVariable r)] -> [(String, SVariable r)] -> [(String, SVariable r)] -> MS (r Body) -> MS (r md))
  -> Label
  -> Description
  -> [CodeVarChunk]
  -> [CodeVarChunk]
  -> [MS (r Block)]
  -> GenState (MS (r md))
genInOutFuncProc :: forall (r :: * -> *) smt md.
(SharedStatement r smt, VariableElim r) =>
([SVariable r]
 -> [SVariable r] -> [SVariable r] -> MS (r Block) -> MS (r md))
-> (Name
    -> [(Name, SVariable r)]
    -> [(Name, SVariable r)]
    -> [(Name, SVariable r)]
    -> MS (r Block)
    -> MS (r md))
-> Name
-> Name
-> [Input]
-> [Input]
-> [MS (r Block)]
-> GenState (MS (r md))
genInOutFuncProc [SVariable r]
-> [SVariable r] -> [SVariable r] -> MS (r Block) -> MS (r md)
f Name
-> [(Name, SVariable r)]
-> [(Name, SVariable r)]
-> [(Name, SVariable r)]
-> MS (r Block)
-> MS (r md)
docf Name
n Name
desc [Input]
ins' [Input]
outs' [MS (r Block)]
b = do
  DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  (DrasilState -> DrasilState) -> StateT DrasilState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\DrasilState
st -> DrasilState
st {currentScope = Local})
  let ins :: [Input]
ins = [Input]
ins' [Input] -> [Input] -> [Input]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Input]
outs'
      outs :: [Input]
outs = [Input]
outs' [Input] -> [Input] -> [Input]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Input]
ins'
      both :: [Input]
both = [Input]
ins' [Input] -> [Input] -> [Input]
forall a. Eq a => [a] -> [a] -> [a]
`intersect` [Input]
outs'
  [SVariable r]
inVs <- (Input -> StateT DrasilState Identity (SVariable r))
-> [Input] -> StateT DrasilState Identity [SVariable r]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Input -> StateT DrasilState Identity (SVariable r)
forall (r :: * -> *).
VariableSym r =>
Input -> GenState (SVariable r)
mkVarProc [Input]
ins
  [SVariable r]
outVs <- (Input -> StateT DrasilState Identity (SVariable r))
-> [Input] -> StateT DrasilState Identity [SVariable r]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Input -> StateT DrasilState Identity (SVariable r)
forall (r :: * -> *).
VariableSym r =>
Input -> GenState (SVariable r)
mkVarProc [Input]
outs
  [SVariable r]
bothVs <- (Input -> StateT DrasilState Identity (SVariable r))
-> [Input] -> StateT DrasilState Identity [SVariable r]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Input -> StateT DrasilState Identity (SVariable r)
forall (r :: * -> *).
VariableSym r =>
Input -> GenState (SVariable r)
mkVarProc [Input]
both
  MS (r Block)
bod <- Name -> [SVariable r] -> [MS (r Block)] -> GenState (MS (r Block))
forall (r :: * -> *) smt.
(SharedStatement r smt, VariableElim r) =>
Name -> [SVariable r] -> [MS (r Block)] -> GenState (MS (r Block))
logBody Name
n ([SVariable r]
bothVs [SVariable r] -> [SVariable r] -> [SVariable r]
forall a. [a] -> [a] -> [a]
++ [SVariable r]
inVs) [MS (r Block)]
b
  [Name]
pComms <- (Input -> GenState Name)
-> [Input] -> StateT DrasilState Identity [Name]
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 Name
forall c. CodeIdea c => c -> GenState Name
getCommentBrief [Input]
ins
  [Name]
oComms <- (Input -> GenState Name)
-> [Input] -> StateT DrasilState Identity [Name]
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 Name
forall c. CodeIdea c => c -> GenState Name
getCommentBrief [Input]
outs
  [Name]
bComms <- (Input -> GenState Name)
-> [Input] -> StateT DrasilState Identity [Name]
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 Name
forall c. CodeIdea c => c -> GenState Name
getCommentBrief [Input]
both
  MS (r md) -> GenState (MS (r md))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (MS (r md) -> GenState (MS (r md)))
-> MS (r md) -> GenState (MS (r md))
forall a b. (a -> b) -> a -> b
$ if Comments
CommentFunc Comments -> [Comments] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` DrasilState
g DrasilState
-> Getting [Comments] DrasilState [Comments] -> [Comments]
forall s a. s -> Getting a s a -> a
^. Getting [Comments] DrasilState [Comments]
forall a. HasChoices a => Lens' a [Comments]
Lens' DrasilState [Comments]
commented
    then Name
-> [(Name, SVariable r)]
-> [(Name, SVariable r)]
-> [(Name, SVariable r)]
-> MS (r Block)
-> MS (r md)
docf Name
desc ([Name] -> [SVariable r] -> [(Name, SVariable r)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Name]
pComms [SVariable r]
inVs) ([Name] -> [SVariable r] -> [(Name, SVariable r)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Name]
oComms [SVariable r]
outVs) ([Name] -> [SVariable r] -> [(Name, SVariable r)]
forall a b. [a] -> [b] -> [(a, b)]
zip
    [Name]
bComms [SVariable r]
bothVs) MS (r Block)
bod else [SVariable r]
-> [SVariable r] -> [SVariable r] -> MS (r Block) -> MS (r md)
f [SVariable r]
inVs [SVariable r]
outVs [SVariable r]
bothVs MS (r Block)
bod

-- Used for readData and readDataProc
l_line, l_lines, l_linetokens, l_infile, l_i :: Label
var_line, var_lines, var_linetokens, var_infile, var_i ::
  (VariableSym r) => SVariable r
v_line, v_lines, v_linetokens, v_infile, v_i ::
  (VariableValue r) => SValue r
l_line :: Name
l_line = Name
"line"
var_line :: forall (r :: * -> *). VariableSym r => SVariable r
var_line = Name -> VS (r TypeData) -> SVariable r
forall (r :: * -> *).
VariableSym r =>
Name -> VS (r TypeData) -> SVariable r
var Name
l_line VS (r TypeData)
forall (r :: * -> *). TypeSym r => VS (r TypeData)
string
v_line :: forall (r :: * -> *). VariableValue r => SValue r
v_line = SVariable r -> SValue r
forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
valueOf SVariable r
forall (r :: * -> *). VariableSym r => SVariable r
var_line
l_lines :: Name
l_lines = Name
"lines"
var_lines :: forall (r :: * -> *). VariableSym r => SVariable r
var_lines = Name -> VS (r TypeData) -> SVariable r
forall (r :: * -> *).
VariableSym r =>
Name -> VS (r TypeData) -> SVariable r
var Name
l_lines (VS (r TypeData) -> VS (r TypeData)
forall (r :: * -> *).
TypeSym r =>
VS (r TypeData) -> VS (r TypeData)
listType VS (r TypeData)
forall (r :: * -> *). TypeSym r => VS (r TypeData)
string)
v_lines :: forall (r :: * -> *). VariableValue r => SValue r
v_lines = SVariable r -> SValue r
forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
valueOf SVariable r
forall (r :: * -> *). VariableSym r => SVariable r
var_lines
l_linetokens :: Name
l_linetokens = Name
"linetokens"
var_linetokens :: forall (r :: * -> *). VariableSym r => SVariable r
var_linetokens = Name -> VS (r TypeData) -> SVariable r
forall (r :: * -> *).
VariableSym r =>
Name -> VS (r TypeData) -> SVariable r
var Name
l_linetokens (VS (r TypeData) -> VS (r TypeData)
forall (r :: * -> *).
TypeSym r =>
VS (r TypeData) -> VS (r TypeData)
listType VS (r TypeData)
forall (r :: * -> *). TypeSym r => VS (r TypeData)
string)
v_linetokens :: forall (r :: * -> *). VariableValue r => SValue r
v_linetokens = SVariable r -> SValue r
forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
valueOf SVariable r
forall (r :: * -> *). VariableSym r => SVariable r
var_linetokens
l_infile :: Name
l_infile = Name
"infile"
var_infile :: forall (r :: * -> *). VariableSym r => SVariable r
var_infile = Name -> VS (r TypeData) -> SVariable r
forall (r :: * -> *).
VariableSym r =>
Name -> VS (r TypeData) -> SVariable r
var Name
l_infile VS (r TypeData)
forall (r :: * -> *). TypeSym r => VS (r TypeData)
infile
v_infile :: forall (r :: * -> *). VariableValue r => SValue r
v_infile = SVariable r -> SValue r
forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
valueOf SVariable r
forall (r :: * -> *). VariableSym r => SVariable r
var_infile
l_i :: Name
l_i = Name
"i"
var_i :: forall (r :: * -> *). VariableSym r => SVariable r
var_i = Name -> VS (r TypeData) -> SVariable r
forall (r :: * -> *).
VariableSym r =>
Name -> VS (r TypeData) -> SVariable r
var Name
l_i VS (r TypeData)
forall (r :: * -> *). TypeSym r => VS (r TypeData)
int
v_i :: forall (r :: * -> *). VariableValue r => SValue r
v_i = SVariable r -> SValue r
forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
valueOf SVariable r
forall (r :: * -> *). VariableSym r => SVariable r
var_i