{-# OPTIONS_GHC -Wno-redundant-constraints #-}
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, SVariable, SValue, Class, CSStateVar, NamedArgs,
  Initializers, 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(..), ListStatement(..),
  MultiStatement(..), ValueStatement(..), AssignStatement(..), DeclStatement(..),
  FileHandling(..), ReadFile(..), StringStatement(..), ControlStatement(..),
  ifNoElse, VisibilitySym(..), ParameterSym(..), MethodSym(..), OOMethodSym(..),
  pubDVar, privDVar, nonInitConstructor, convType, convTypeOO, VisibilityTag(..),
  CodeType(..), onStateValue, TypeData, ParamData, TypeElim, OODeclStatement,
  OOVariableValue, MathConstant, Argument, PrintFile, BodySym, InternalValueExp)
import qualified Drasil.GOOL as OO (CodeType(List, Array), Set(..), Literal)
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
  g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  (g ^. spaceMatches) 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
  ::
    ( Argument r
    , OO.Literal r
    , MathConstant r
    , VariableValue r
    , BooleanExpression r
    , Comparison r
    , NumericExpression r
    , SelfSym r
    , InternalValueExp r
    , OOValueExpression r
    , List r
    , Reference r
    , OO.Set r
    , TypeElim r
    , VariableElim r
    )
  => UID -> Name -> VS (r TypeData) -> GenState (SValue r)
value :: forall (r :: * -> *).
(Argument r, Literal r, MathConstant r, VariableValue r,
 BooleanExpression r, Comparison r, NumericExpression r, SelfSym r,
 InternalValueExp r, OOValueExpression r, List r, Reference r,
 Set r, TypeElim r, VariableElim r) =>
UID -> Name -> VS (r TypeData) -> GenState (SValue r)
value UID
u Name
s VS (r TypeData)
t = do
  g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  let cs = DrasilState
g
      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 = do
        cd <- UID -> ConstantMap -> Maybe CodeDefinition
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup UID
u ConstantMap
mm
        maybeInline (g ^. conStruct) cd
      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 = 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 = UID -> MatchedConceptMap -> Maybe CodeConcept
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup UID
u MatchedConceptMap
cm
  val <- maybe (valueOf <$> variable s t) (convExpr . (^. codeExpr)) constDef
  return $ maybe val conceptToGOOL 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
  g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  let cs = DrasilState
g
      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 s `elem` map codeName (cs ^. inputs)
    then inputVariable (g ^. inStruct) Var (var s t)
    else if s `elem` map codeName (cs ^. constDefns)
      then constVariable (g ^. conStruct) (g ^. conRepr)
              ((defFunc $ g ^. conRepr) s t)
      else return $ var s 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
  g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  inClsName <- genICName InputParameters
  ip <- mkVar (quantvar inParams)
  return $ if currentClass g == inClsName then instanceVarSelf v else valueOf ip $-> v
inputVariable Structure
Bundled ConstantRepr
Const SVariable r
v = do
  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)
  classVariable ip 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
  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)
  return $ valueOf cs $-> v
constVariable (Store Structure
Bundled) ConstantRepr
Const SVariable r
v = do
  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)
  classVariable cs v
constVariable ConstantStructure
WithInputs ConstantRepr
cr SVariable r
v = do
  g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  inputVariable (g ^. inStruct) cr 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
  g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  let 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
  return $ do
    v' <- v
    let nm = r Variable -> Name
forall (r :: * -> *). VariableElim r => r Variable -> Name
variableName r Variable
v'
    maybe (error $ "Variable " ++ nm ++ " missing from export map")
      checkCurrent (Map.lookup nm (eMap g)) (onStateValue variableType c) v

-- | Generates a GOOL Value for a variable represented by a 'CodeVarChunk'.
mkVal
  ::
    ( Argument r
    , OO.Literal r
    , MathConstant r
    , VariableValue r
    , BooleanExpression r
    , Comparison r
    , NumericExpression r
    , SelfSym r
    , InternalValueExp r
    , OOValueExpression r
    , List r
    , Reference r
    , OO.Set r
    , TypeElim r
    , VariableElim r
    )
  => CodeVarChunk -> GenState (SValue r)
mkVal :: forall (r :: * -> *).
(Argument r, Literal r, MathConstant r, VariableValue r,
 BooleanExpression r, Comparison r, NumericExpression r, SelfSym r,
 InternalValueExp r, OOValueExpression r, List r, Reference r,
 Set r, TypeElim r, VariableElim r) =>
Input -> GenState (SValue r)
mkVal Input
v = do
  t <- Input -> StateT DrasilState Identity CodeType
forall c. HasSpace c => c -> StateT DrasilState Identity CodeType
codeType Input
v
  let toGOOLVal Maybe CodeChunk
Nothing = UID -> Name -> VS (r TypeData) -> GenState (SValue r)
forall (r :: * -> *).
(Argument r, Literal r, MathConstant r, VariableValue r,
 BooleanExpression r, Comparison r, NumericExpression r, SelfSym r,
 InternalValueExp r, OOValueExpression r, List r, Reference r,
 Set r, TypeElim r, VariableElim r) =>
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 CodeChunk
o) = do
        ot <- CodeChunk -> StateT DrasilState Identity CodeType
forall c. HasSpace c => c -> StateT DrasilState Identity CodeType
codeType CodeChunk
o
        return $ valueOf $ instanceVarAccess (valueOf $ var (codeName o) (convTypeOO ot))
          (var (codeName v) (convTypeOO t))
  toGOOLVal (v ^. 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
  t <- Input -> StateT DrasilState Identity CodeType
forall c. HasSpace c => c -> StateT DrasilState Identity CodeType
codeType Input
v
  let toGOOLVar Maybe CodeChunk
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 CodeChunk
o) = do
        ot <- CodeChunk -> StateT DrasilState Identity CodeType
forall c. HasSpace c => c -> StateT DrasilState Identity CodeType
codeType CodeChunk
o
        return $ instanceVarAccess (valueOf $ var (codeName o) (convTypeOO ot))
          (var (codeName v) (convTypeOO t))
  toGOOLVar (v ^. obv)

-- | Generates a GOOL Parameter for a parameter represented by a 'ParameterChunk'.
mkParam
  :: (VariableValue r, SelfSym r, ParameterSym r, VariableElim r)
  => ParameterChunk -> GenState (MS (r ParamData))
mkParam :: forall (r :: * -> *).
(VariableValue r, SelfSym r, ParameterSym r, VariableElim r) =>
ParameterChunk -> GenState (MS (r ParamData))
mkParam ParameterChunk
p = do
  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)
  return $ paramFunc (passBy p) 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 stmt mthd stvr attch prg file mod bod block)
  => Label
  -> VS (r TypeData)
  -> Description
  -> [ParameterChunk]
  -> Maybe Description
  -> [MS (r block)]
  -> GenState (MS (r mthd))
publicFunc :: forall (r :: * -> *) vis stmt mthd stvr attch prg file mod bod
       block.
OOProg r vis stmt mthd stvr attch prg file mod bod block =>
Name
-> VS (r TypeData)
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MS (r block)]
-> GenState (MS (r mthd))
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 bod) -> MS (r mthd))
-> Name
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MS (r block)]
-> GenState (MS (r mthd))
forall (r :: * -> *) vis stmt mthd stvr attch prg file mod bod
       block.
OOProg r vis stmt mthd stvr attch prg file mod bod block =>
([MS (r ParamData)] -> MS (r bod) -> MS (r mthd))
-> Name
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MS (r block)]
-> GenState (MS (r mthd))
genMethod (Name
-> r vis
-> VS (r TypeData)
-> [MS (r ParamData)]
-> MS (r bod)
-> MS (r mthd)
forall (r :: * -> *) vis mthd bod.
MethodSym r vis mthd bod =>
Name
-> r vis
-> VS (r TypeData)
-> [MS (r ParamData)]
-> MS (r bod)
-> MS (r mthd)
function Name
n r vis
forall {k} (r :: k -> *) (vis :: k). 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 stmt mthd stvr attch prg file mod bod block)
  => Label
  -> VS (r TypeData)
  -> Description
  -> [ParameterChunk]
  -> Maybe Description
  -> [MS (r block)]
  -> GenState (MS (r mthd))
publicMethod :: forall (r :: * -> *) vis stmt mthd stvr attch prg file mod bod
       block.
OOProg r vis stmt mthd stvr attch prg file mod bod block =>
Name
-> VS (r TypeData)
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MS (r block)]
-> GenState (MS (r mthd))
publicMethod Name
n VS (r TypeData)
t = do
  ([MS (r ParamData)] -> MS (r bod) -> MS (r mthd))
-> Name
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MS (r block)]
-> GenState (MS (r mthd))
forall (r :: * -> *) vis stmt mthd stvr attch prg file mod bod
       block.
OOProg r vis stmt mthd stvr attch prg file mod bod block =>
([MS (r ParamData)] -> MS (r bod) -> MS (r mthd))
-> Name
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MS (r block)]
-> GenState (MS (r mthd))
genMethod (Name
-> r vis
-> r attch
-> VS (r TypeData)
-> [MS (r ParamData)]
-> MS (r bod)
-> MS (r mthd)
forall (r :: * -> *) vis mthd attch bod.
OOMethodSym r vis mthd attch bod =>
Name
-> r vis
-> r attch
-> VS (r TypeData)
-> [MS (r ParamData)]
-> MS (r bod)
-> MS (r mthd)
method Name
n r vis
forall {k} (r :: k -> *) (vis :: k). VisibilitySym r vis => r vis
public r attch
forall {k} (r :: k -> *) (attch :: k).
AttachmentSym r attch =>
r attch
instanceLevel VS (r TypeData)
t) Name
n

-- | Generates a private method.
privateMethod
  :: (OOProg r vis stmt mthd stvr attch prg file mod bod block)
  => Label
  -> VS (r TypeData)
  -> Description
  -> [ParameterChunk]
  -> Maybe Description
  -> [MS (r block)]
  -> GenState (MS (r mthd))
privateMethod :: forall (r :: * -> *) vis stmt mthd stvr attch prg file mod bod
       block.
OOProg r vis stmt mthd stvr attch prg file mod bod block =>
Name
-> VS (r TypeData)
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MS (r block)]
-> GenState (MS (r mthd))
privateMethod Name
n VS (r TypeData)
t = do
  ([MS (r ParamData)] -> MS (r bod) -> MS (r mthd))
-> Name
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MS (r block)]
-> GenState (MS (r mthd))
forall (r :: * -> *) vis stmt mthd stvr attch prg file mod bod
       block.
OOProg r vis stmt mthd stvr attch prg file mod bod block =>
([MS (r ParamData)] -> MS (r bod) -> MS (r mthd))
-> Name
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MS (r block)]
-> GenState (MS (r mthd))
genMethod (Name
-> r vis
-> r attch
-> VS (r TypeData)
-> [MS (r ParamData)]
-> MS (r bod)
-> MS (r mthd)
forall (r :: * -> *) vis mthd attch bod.
OOMethodSym r vis mthd attch bod =>
Name
-> r vis
-> r attch
-> VS (r TypeData)
-> [MS (r ParamData)]
-> MS (r bod)
-> MS (r mthd)
method Name
n r vis
forall {k} (r :: k -> *) (vis :: k). VisibilitySym r vis => r vis
private r attch
forall {k} (r :: k -> *) (attch :: k).
AttachmentSym r attch =>
r attch
instanceLevel VS (r TypeData)
t) Name
n

-- | Generates a public function, defined by its inputs and outputs.
publicInOutFunc
  :: (OOProg r vis stmt mthd stvr attch prg file mod bod block)
  => Label
  -> Description
  -> [CodeVarChunk]
  -> [CodeVarChunk]
  -> [MS (r block)]
  -> GenState (MS (r mthd))
publicInOutFunc :: forall (r :: * -> *) vis stmt mthd stvr attch prg file mod bod
       block.
OOProg r vis stmt mthd stvr attch prg file mod bod block =>
Name
-> Name
-> [Input]
-> [Input]
-> [MS (r block)]
-> GenState (MS (r mthd))
publicInOutFunc Name
n = ([SVariable r]
 -> [SVariable r] -> [SVariable r] -> MS (r bod) -> MS (r mthd))
-> (Name
    -> [(Name, SVariable r)]
    -> [(Name, SVariable r)]
    -> [(Name, SVariable r)]
    -> MS (r bod)
    -> MS (r mthd))
-> Name
-> Name
-> [Input]
-> [Input]
-> [MS (r block)]
-> GenState (MS (r mthd))
forall (r :: * -> *) stmt bod block mthd.
(Literal r, VariableValue r, SelfSym r, MultiStatement r stmt,
 DeclStatement r stmt bod, FileHandling r stmt, PrintFile r stmt,
 BlockSym r block stmt, BodySym r bod block, VariableElim r) =>
([SVariable r]
 -> [SVariable r] -> [SVariable r] -> MS (r bod) -> MS (r mthd))
-> (Name
    -> [(Name, SVariable r)]
    -> [(Name, SVariable r)]
    -> [(Name, SVariable r)]
    -> MS (r bod)
    -> MS (r mthd))
-> Name
-> Name
-> [Input]
-> [Input]
-> [MS (r block)]
-> GenState (MS (r mthd))
genInOutFunc (Name
-> r vis
-> [SVariable r]
-> [SVariable r]
-> [SVariable r]
-> MS (r bod)
-> MS (r mthd)
forall (r :: * -> *) vis mthd bod.
MethodSym r vis mthd bod =>
Name -> r vis -> InOutFunc r mthd bod
inOutFunc Name
n r vis
forall {k} (r :: k -> *) (vis :: k). VisibilitySym r vis => r vis
public) (Name
-> r vis
-> Name
-> [(Name, SVariable r)]
-> [(Name, SVariable r)]
-> [(Name, SVariable r)]
-> MS (r bod)
-> MS (r mthd)
forall (r :: * -> *) vis mthd bod.
MethodSym r vis mthd bod =>
Name -> r vis -> DocInOutFunc r mthd bod
docInOutFunc Name
n r vis
forall {k} (r :: k -> *) (vis :: k). VisibilitySym r vis => r vis
public) Name
n

-- | Generates a private method, defined by its inputs and outputs.
privateInOutMethod
  :: (OOProg r vis stmt mthd stvr attch prg file mod bod block)
  => Label
  -> Description
  -> [CodeVarChunk]
  -> [CodeVarChunk]
  -> [MS (r block)]
  -> GenState (MS (r mthd))
privateInOutMethod :: forall (r :: * -> *) vis stmt mthd stvr attch prg file mod bod
       block.
OOProg r vis stmt mthd stvr attch prg file mod bod block =>
Name
-> Name
-> [Input]
-> [Input]
-> [MS (r block)]
-> GenState (MS (r mthd))
privateInOutMethod Name
n = ([SVariable r]
 -> [SVariable r] -> [SVariable r] -> MS (r bod) -> MS (r mthd))
-> (Name
    -> [(Name, SVariable r)]
    -> [(Name, SVariable r)]
    -> [(Name, SVariable r)]
    -> MS (r bod)
    -> MS (r mthd))
-> Name
-> Name
-> [Input]
-> [Input]
-> [MS (r block)]
-> GenState (MS (r mthd))
forall (r :: * -> *) stmt bod block mthd.
(Literal r, VariableValue r, SelfSym r, MultiStatement r stmt,
 DeclStatement r stmt bod, FileHandling r stmt, PrintFile r stmt,
 BlockSym r block stmt, BodySym r bod block, VariableElim r) =>
([SVariable r]
 -> [SVariable r] -> [SVariable r] -> MS (r bod) -> MS (r mthd))
-> (Name
    -> [(Name, SVariable r)]
    -> [(Name, SVariable r)]
    -> [(Name, SVariable r)]
    -> MS (r bod)
    -> MS (r mthd))
-> Name
-> Name
-> [Input]
-> [Input]
-> [MS (r block)]
-> GenState (MS (r mthd))
genInOutFunc (Name
-> r vis
-> r attch
-> [SVariable r]
-> [SVariable r]
-> [SVariable r]
-> MS (r bod)
-> MS (r mthd)
forall (r :: * -> *) vis mthd attch bod.
OOMethodSym r vis mthd attch bod =>
Name -> r vis -> r attch -> InOutFunc r mthd bod
inOutMethod Name
n r vis
forall {k} (r :: k -> *) (vis :: k). VisibilitySym r vis => r vis
private r attch
forall {k} (r :: k -> *) (attch :: k).
AttachmentSym r attch =>
r attch
instanceLevel)
  (Name
-> r vis
-> r attch
-> Name
-> [(Name, SVariable r)]
-> [(Name, SVariable r)]
-> [(Name, SVariable r)]
-> MS (r bod)
-> MS (r mthd)
forall (r :: * -> *) vis mthd attch bod.
OOMethodSym r vis mthd attch bod =>
Name -> r vis -> r attch -> DocInOutFunc r mthd bod
docInOutMethod Name
n r vis
forall {k} (r :: k -> *) (vis :: k). VisibilitySym r vis => r vis
private r attch
forall {k} (r :: k -> *) (attch :: k).
AttachmentSym r attch =>
r attch
instanceLevel) Name
n

-- | Generates a constructor.
genConstructor
  :: (OOProg r vis stmt mthd stvr attch prg file mod bod block)
  => Label
  -> Description
  -> [ParameterChunk]
  -> [MS (r block)]
  -> GenState (MS (r mthd))
genConstructor :: forall (r :: * -> *) vis stmt mthd stvr attch prg file mod bod
       block.
OOProg r vis stmt mthd stvr attch prg file mod bod block =>
Name
-> Name
-> [ParameterChunk]
-> [MS (r block)]
-> GenState (MS (r mthd))
genConstructor Name
n Name
desc [ParameterChunk]
p = do
  ([MS (r ParamData)] -> MS (r bod) -> MS (r mthd))
-> Name
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MS (r block)]
-> GenState (MS (r mthd))
forall (r :: * -> *) vis stmt mthd stvr attch prg file mod bod
       block.
OOProg r vis stmt mthd stvr attch prg file mod bod block =>
([MS (r ParamData)] -> MS (r bod) -> MS (r mthd))
-> Name
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MS (r block)]
-> GenState (MS (r mthd))
genMethod [MS (r ParamData)] -> MS (r bod) -> MS (r mthd)
forall (r :: * -> *) vis mthd attch bod.
OOMethodSym r vis mthd attch bod =>
[MS (r ParamData)] -> MS (r bod) -> MS (r mthd)
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 stmt mthd stvr attch prg file mod bod block)
  => Label
  -> Description
  -> [ParameterChunk]
  -> Initializers r
  -> [MS (r block)]
  -> GenState (MS (r mthd))
genInitConstructor :: forall (r :: * -> *) vis stmt mthd stvr attch prg file mod bod
       block.
OOProg r vis stmt mthd stvr attch prg file mod bod block =>
Name
-> Name
-> [ParameterChunk]
-> Initializers r
-> [MS (r block)]
-> GenState (MS (r mthd))
genInitConstructor Name
n Name
desc [ParameterChunk]
p Initializers r
is = ([MS (r ParamData)] -> MS (r bod) -> MS (r mthd))
-> Name
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MS (r block)]
-> GenState (MS (r mthd))
forall (r :: * -> *) vis stmt mthd stvr attch prg file mod bod
       block.
OOProg r vis stmt mthd stvr attch prg file mod bod block =>
([MS (r ParamData)] -> MS (r bod) -> MS (r mthd))
-> Name
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MS (r block)]
-> GenState (MS (r mthd))
genMethod ([MS (r ParamData)] -> Initializers r -> MS (r bod) -> MS (r mthd)
forall (r :: * -> *) vis mthd attch bod.
OOMethodSym r vis mthd attch bod =>
[MS (r ParamData)] -> Initializers r -> MS (r bod) -> MS (r mthd)
`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 stmt mthd stvr attch prg file mod bod block)
  => ([MS (r ParamData)] -> MS (r bod) -> MS (r mthd))
  -> Label
  -> Description
  -> [ParameterChunk]
  -> Maybe Description
  -> [MS (r block)]
  -> GenState (MS (r mthd))
genMethod :: forall (r :: * -> *) vis stmt mthd stvr attch prg file mod bod
       block.
OOProg r vis stmt mthd stvr attch prg file mod bod block =>
([MS (r ParamData)] -> MS (r bod) -> MS (r mthd))
-> Name
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MS (r block)]
-> GenState (MS (r mthd))
genMethod [MS (r ParamData)] -> MS (r bod) -> MS (r mthd)
f Name
n Name
desc [ParameterChunk]
p Maybe Name
r [MS (r block)]
b = do
  g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  vars <- mapM (mkVar . quantvar) p
  ps <- mapM mkParam p
  bod <- logBody n vars b
  let fn = [MS (r ParamData)] -> MS (r bod) -> MS (r mthd)
f [MS (r ParamData)]
ps MS (r bod)
bod
  pComms <- mapM getCommentBrief p
  return $ if CommentFunc `elem` g ^. commented
    then docFunc desc pComms r fn else 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
  ::
    ( OO.Literal r
    , VariableValue r
    , SelfSym r
    , MultiStatement r stmt
    , DeclStatement r stmt bod
    , FileHandling r stmt
    , PrintFile r stmt
    , BlockSym r block stmt
    , BodySym r bod block
    , VariableElim r
    )
  => ([SVariable r] -> [SVariable r] -> [SVariable r] -> MS (r bod) -> MS (r mthd))
  -> (String -> [(String, SVariable r)] -> [(String, SVariable r)] -> [(String, SVariable r)] -> MS (r bod) -> MS (r mthd))
  -> Label
  -> Description
  -> [CodeVarChunk]
  -> [CodeVarChunk]
  -> [MS (r block)]
  -> GenState (MS (r mthd))
genInOutFunc :: forall (r :: * -> *) stmt bod block mthd.
(Literal r, VariableValue r, SelfSym r, MultiStatement r stmt,
 DeclStatement r stmt bod, FileHandling r stmt, PrintFile r stmt,
 BlockSym r block stmt, BodySym r bod block, VariableElim r) =>
([SVariable r]
 -> [SVariable r] -> [SVariable r] -> MS (r bod) -> MS (r mthd))
-> (Name
    -> [(Name, SVariable r)]
    -> [(Name, SVariable r)]
    -> [(Name, SVariable r)]
    -> MS (r bod)
    -> MS (r mthd))
-> Name
-> Name
-> [Input]
-> [Input]
-> [MS (r block)]
-> GenState (MS (r mthd))
genInOutFunc [SVariable r]
-> [SVariable r] -> [SVariable r] -> MS (r bod) -> MS (r mthd)
f Name
-> [(Name, SVariable r)]
-> [(Name, SVariable r)]
-> [(Name, SVariable r)]
-> MS (r bod)
-> MS (r mthd)
docf Name
n Name
desc [Input]
ins' [Input]
outs' [MS (r block)]
b = do
  g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  modify (\DrasilState
st -> DrasilState
st {currentScope = Local})
  let ins = [Input]
ins' [Input] -> [Input] -> [Input]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Input]
outs'
      outs = [Input]
outs' [Input] -> [Input] -> [Input]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Input]
ins'
      both = [Input]
ins' [Input] -> [Input] -> [Input]
forall a. Eq a => [a] -> [a] -> [a]
`intersect` [Input]
outs'
  inVs <- mapM mkVar ins
  outVs <- mapM mkVar outs
  bothVs <- mapM mkVar both
  bod <- logBody n (bothVs ++ inVs) b
  pComms <- mapM getCommentBrief ins
  oComms <- mapM getCommentBrief outs
  bComms <- mapM getCommentBrief both
  return $ if CommentFunc `elem` g ^. commented
    then docf desc (zip pComms inVs) (zip oComms outVs) (zip
    bComms bothVs) bod else f inVs outVs bothVs bod

-- | Converts an 'Expr' to a GOOL Value.
convExpr
  ::
    ( Argument r
    , MathConstant r
    , VariableValue r
    , OO.Literal r
    , BooleanExpression r
    , Comparison r
    , NumericExpression r
    , SelfSym r
    , InternalValueExp r
    , OOValueExpression r
    , List r
    , Reference r
    , OO.Set r
    , TypeElim r
    , VariableElim r
    )
  => CodeExpr -> GenState (SValue r)
convExpr :: forall (r :: * -> *).
(Argument r, MathConstant r, VariableValue r, Literal r,
 BooleanExpression r, Comparison r, NumericExpression r, SelfSym r,
 InternalValueExp r, OOValueExpression r, List r, Reference r,
 Set r, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr (Lit (Dbl Double
d)) = do
  sm <- Space -> StateT DrasilState Identity CodeType
spaceCodeType Space
Real
  let 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"
  return $ getLiteral sm
convExpr (Lit (ExactDbl Integer
d)) = CodeExpr -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *).
(Argument r, MathConstant r, VariableValue r, Literal r,
 BooleanExpression r, Comparison r, NumericExpression r, SelfSym r,
 InternalValueExp r, OOValueExpression r, List r, Reference r,
 Set r, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr (CodeExpr -> StateT DrasilState Identity (SValue r))
-> CodeExpr -> StateT DrasilState Identity (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 -> StateT DrasilState Identity (SValue r)
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (SValue r -> StateT DrasilState Identity (SValue r))
-> SValue r -> StateT DrasilState Identity (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 -> StateT DrasilState Identity (SValue r)
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (SValue r -> StateT DrasilState Identity (SValue r))
-> SValue r -> StateT DrasilState Identity (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
  sm <- Space -> StateT DrasilState Identity CodeType
spaceCodeType Space
Rational
  let 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"
  return $ getLiteral sm (fromIntegral a / (10 ** fromIntegral 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]
-> StateT DrasilState Identity (SValue r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (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 :: * -> *).
(Argument r, MathConstant r, VariableValue r, Literal r,
 BooleanExpression r, Comparison r, NumericExpression r, SelfSym r,
 InternalValueExp r, OOValueExpression r, List r, Reference r,
 Set r, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr [CodeExpr]
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]
-> StateT DrasilState Identity (SValue r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (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 :: * -> *).
(Argument r, MathConstant r, VariableValue r, Literal r,
 BooleanExpression r, Comparison r, NumericExpression r, SelfSym r,
 InternalValueExp r, OOValueExpression r, List r, Reference r,
 Set r, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr [CodeExpr]
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]
-> StateT DrasilState Identity (SValue r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (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 :: * -> *).
(Argument r, MathConstant r, VariableValue r, Literal r,
 BooleanExpression r, Comparison r, NumericExpression r, SelfSym r,
 InternalValueExp r, OOValueExpression r, List r, Reference r,
 Set r, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr [CodeExpr]
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]
-> StateT DrasilState Identity (SValue r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (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 :: * -> *).
(Argument r, MathConstant r, VariableValue r, Literal r,
 BooleanExpression r, Comparison r, NumericExpression r, SelfSym r,
 InternalValueExp r, OOValueExpression r, List r, Reference r,
 Set r, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr [CodeExpr]
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]
-> StateT DrasilState Identity (SValue r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (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 :: * -> *).
(Argument r, MathConstant r, VariableValue r, Literal r,
 BooleanExpression r, Comparison r, NumericExpression r, SelfSym r,
 InternalValueExp r, OOValueExpression r, List r, Reference r,
 Set r, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr [CodeExpr]
l
convExpr (C UID
c)   = do
  g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  let v = DefinedQuantityDict -> Input
forall c. (Quantity c, MayHaveUnit c, Concept c) => c -> Input
quantvar (DrasilState -> UID -> DefinedQuantityDict
lookupC DrasilState
g UID
c)
  mkVal v
convExpr (FCall UID
c [CodeExpr]
x [(UID, CodeExpr)]
ns) = UID
-> [CodeExpr]
-> [(UID, CodeExpr)]
-> (Name
    -> Name
    -> VS (r TypeData)
    -> [SValue r]
    -> NamedArgs r
    -> StateT DrasilState Identity (SValue r))
-> (Name
    -> Name
    -> VS (r TypeData)
    -> [SValue r]
    -> NamedArgs r
    -> SValue r)
-> StateT DrasilState Identity (SValue r)
forall (r :: * -> *).
(Argument r, MathConstant r, VariableValue r, Literal r,
 BooleanExpression r, Comparison r, NumericExpression r, SelfSym r,
 InternalValueExp r, OOValueExpression r, List r, Reference r,
 Set r, TypeElim r, VariableElim r) =>
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
-> StateT DrasilState Identity (SValue r)
forall (r :: * -> *).
(Argument r, VariableValue r, SelfSym r, InternalValueExp r,
 ValueExpression r, 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
    -> StateT DrasilState Identity (SValue r))
-> (Name
    -> Name
    -> VS (r TypeData)
    -> [SValue r]
    -> NamedArgs r
    -> SValue r)
-> StateT DrasilState Identity (SValue r)
forall (r :: * -> *).
(Argument r, MathConstant r, VariableValue r, Literal r,
 BooleanExpression r, Comparison r, NumericExpression r, SelfSym r,
 InternalValueExp r, OOValueExpression r, List r, Reference r,
 Set r, TypeElim r, VariableElim r) =>
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
-> StateT DrasilState Identity (SValue r)
forall (r :: * -> *).
(Argument r, OOValueExpression r, 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
  g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  let objCd = DefinedQuantityDict -> Input
forall c. (Quantity c, MayHaveUnit c, Concept c) => c -> Input
quantvar (DrasilState -> UID -> DefinedQuantityDict
lookupC DrasilState
g UID
a)
  o <- mkVal objCd
  convCall m x ns
    (\Name
_ Name
n VS (r TypeData)
t [SValue r]
ps NamedArgs r
nas -> SValue r -> StateT DrasilState Identity (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
  g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  let ob  = DefinedQuantityDict -> Input
forall c. (Quantity c, MayHaveUnit c, Concept c) => c -> Input
quantvar (DrasilState -> UID -> DefinedQuantityDict
lookupC DrasilState
g UID
o)
      fld = DefinedQuantityDict -> Input
forall c. (Quantity c, MayHaveUnit c, Concept c) => c -> Input
quantvar (DrasilState -> UID -> DefinedQuantityDict
lookupC DrasilState
g UID
f)
  v <- mkVar (ccObjVar ob fld)
  return $ valueOf v
convExpr (UnaryOp UFunc
o CodeExpr
u)    = (SValue r -> SValue r)
-> StateT DrasilState Identity (SValue r)
-> StateT DrasilState Identity (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 -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *).
(Argument r, MathConstant r, VariableValue r, Literal r,
 BooleanExpression r, Comparison r, NumericExpression r, SelfSym r,
 InternalValueExp r, OOValueExpression r, List r, Reference r,
 Set r, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr CodeExpr
u)
convExpr (UnaryOpB UFuncB
o CodeExpr
u)   = (SValue r -> SValue r)
-> StateT DrasilState Identity (SValue r)
-> StateT DrasilState Identity (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 -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *).
(Argument r, MathConstant r, VariableValue r, Literal r,
 BooleanExpression r, Comparison r, NumericExpression r, SelfSym r,
 InternalValueExp r, OOValueExpression r, List r, Reference r,
 Set r, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr CodeExpr
u)
convExpr (UnaryOpVV UFuncVV
o CodeExpr
u)  = (SValue r -> SValue r)
-> StateT DrasilState Identity (SValue r)
-> StateT DrasilState Identity (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 -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *).
(Argument r, MathConstant r, VariableValue r, Literal r,
 BooleanExpression r, Comparison r, NumericExpression r, SelfSym r,
 InternalValueExp r, OOValueExpression r, List r, Reference r,
 Set r, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr CodeExpr
u)
convExpr (UnaryOpVN UFuncVN
o CodeExpr
u)  = (SValue r -> SValue r)
-> StateT DrasilState Identity (SValue r)
-> StateT DrasilState Identity (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 :: * -> *). List r => UFuncVN -> SValue r -> SValue r
unopVN UFuncVN
o) (CodeExpr -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *).
(Argument r, MathConstant r, VariableValue r, Literal r,
 BooleanExpression r, Comparison r, NumericExpression r, SelfSym r,
 InternalValueExp r, OOValueExpression r, List r, Reference r,
 Set r, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr CodeExpr
u)
convExpr (ArithBinaryOp ArithBinOp
Frac (Lit (Int Integer
a)) (Lit (Int Integer
b))) = do -- hack to deal with integer division
  sm <- Space -> StateT DrasilState Identity CodeType
spaceCodeType Space
Rational
  let 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"
  return $ getLiteral sm
convExpr (ArithBinaryOp ArithBinOp
o CodeExpr
a CodeExpr
b) = (SValue r -> SValue r -> SValue r)
-> StateT DrasilState Identity (SValue r)
-> StateT DrasilState Identity (SValue r)
-> StateT DrasilState Identity (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 -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *).
(Argument r, MathConstant r, VariableValue r, Literal r,
 BooleanExpression r, Comparison r, NumericExpression r, SelfSym r,
 InternalValueExp r, OOValueExpression r, List r, Reference r,
 Set r, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr CodeExpr
a) (CodeExpr -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *).
(Argument r, MathConstant r, VariableValue r, Literal r,
 BooleanExpression r, Comparison r, NumericExpression r, SelfSym r,
 InternalValueExp r, OOValueExpression r, List r, Reference r,
 Set r, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr CodeExpr
b)
convExpr (LABinaryOp LABinOp
o CodeExpr
a CodeExpr
b)    = (SValue r -> SValue r -> SValue r)
-> StateT DrasilState Identity (SValue r)
-> StateT DrasilState Identity (SValue r)
-> StateT DrasilState Identity (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 :: * -> *).
List r =>
LABinOp -> SValue r -> SValue r -> SValue r
laBfunc LABinOp
o) (CodeExpr -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *).
(Argument r, MathConstant r, VariableValue r, Literal r,
 BooleanExpression r, Comparison r, NumericExpression r, SelfSym r,
 InternalValueExp r, OOValueExpression r, List r, Reference r,
 Set r, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr CodeExpr
a) (CodeExpr -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *).
(Argument r, MathConstant r, VariableValue r, Literal r,
 BooleanExpression r, Comparison r, NumericExpression r, SelfSym r,
 InternalValueExp r, OOValueExpression r, List r, Reference r,
 Set r, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr CodeExpr
b)
convExpr (EqBinaryOp EqBinOp
o CodeExpr
a CodeExpr
b)    = (SValue r -> SValue r -> SValue r)
-> StateT DrasilState Identity (SValue r)
-> StateT DrasilState Identity (SValue r)
-> StateT DrasilState Identity (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 -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *).
(Argument r, MathConstant r, VariableValue r, Literal r,
 BooleanExpression r, Comparison r, NumericExpression r, SelfSym r,
 InternalValueExp r, OOValueExpression r, List r, Reference r,
 Set r, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr CodeExpr
a) (CodeExpr -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *).
(Argument r, MathConstant r, VariableValue r, Literal r,
 BooleanExpression r, Comparison r, NumericExpression r, SelfSym r,
 InternalValueExp r, OOValueExpression r, List r, Reference r,
 Set r, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr CodeExpr
b)
convExpr (OrdBinaryOp OrdBinOp
o CodeExpr
a CodeExpr
b)   = (SValue r -> SValue r -> SValue r)
-> StateT DrasilState Identity (SValue r)
-> StateT DrasilState Identity (SValue r)
-> StateT DrasilState Identity (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 -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *).
(Argument r, MathConstant r, VariableValue r, Literal r,
 BooleanExpression r, Comparison r, NumericExpression r, SelfSym r,
 InternalValueExp r, OOValueExpression r, List r, Reference r,
 Set r, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr CodeExpr
a) (CodeExpr -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *).
(Argument r, MathConstant r, VariableValue r, Literal r,
 BooleanExpression r, Comparison r, NumericExpression r, SelfSym r,
 InternalValueExp r, OOValueExpression r, List r, Reference r,
 Set r, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr CodeExpr
b)
convExpr (VVVBinaryOp VVVBinOp
o CodeExpr
a CodeExpr
b)   = (SValue r -> SValue r -> SValue r)
-> StateT DrasilState Identity (SValue r)
-> StateT DrasilState Identity (SValue r)
-> StateT DrasilState Identity (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 -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *).
(Argument r, MathConstant r, VariableValue r, Literal r,
 BooleanExpression r, Comparison r, NumericExpression r, SelfSym r,
 InternalValueExp r, OOValueExpression r, List r, Reference r,
 Set r, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr CodeExpr
a) (CodeExpr -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *).
(Argument r, MathConstant r, VariableValue r, Literal r,
 BooleanExpression r, Comparison r, NumericExpression r, SelfSym r,
 InternalValueExp r, OOValueExpression r, List r, Reference r,
 Set r, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr CodeExpr
b)
convExpr (VVNBinaryOp VVNBinOp
o CodeExpr
a CodeExpr
b)   = (SValue r -> SValue r -> SValue r)
-> StateT DrasilState Identity (SValue r)
-> StateT DrasilState Identity (SValue r)
-> StateT DrasilState Identity (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 -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *).
(Argument r, MathConstant r, VariableValue r, Literal r,
 BooleanExpression r, Comparison r, NumericExpression r, SelfSym r,
 InternalValueExp r, OOValueExpression r, List r, Reference r,
 Set r, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr CodeExpr
a) (CodeExpr -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *).
(Argument r, MathConstant r, VariableValue r, Literal r,
 BooleanExpression r, Comparison r, NumericExpression r, SelfSym r,
 InternalValueExp r, OOValueExpression r, List r, Reference r,
 Set r, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr CodeExpr
b)
convExpr (NVVBinaryOp NVVBinOp
o CodeExpr
a CodeExpr
b)   = (SValue r -> SValue r -> SValue r)
-> StateT DrasilState Identity (SValue r)
-> StateT DrasilState Identity (SValue r)
-> StateT DrasilState Identity (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 -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *).
(Argument r, MathConstant r, VariableValue r, Literal r,
 BooleanExpression r, Comparison r, NumericExpression r, SelfSym r,
 InternalValueExp r, OOValueExpression r, List r, Reference r,
 Set r, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr CodeExpr
a) (CodeExpr -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *).
(Argument r, MathConstant r, VariableValue r, Literal r,
 BooleanExpression r, Comparison r, NumericExpression r, SelfSym r,
 InternalValueExp r, OOValueExpression r, List r, Reference r,
 Set r, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr CodeExpr
b)
convExpr (ESSBinaryOp ESSBinOp
o CodeExpr
a CodeExpr
b)   = (SValue r -> SValue r -> SValue r)
-> StateT DrasilState Identity (SValue r)
-> StateT DrasilState Identity (SValue r)
-> StateT DrasilState Identity (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 -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *).
(Argument r, MathConstant r, VariableValue r, Literal r,
 BooleanExpression r, Comparison r, NumericExpression r, SelfSym r,
 InternalValueExp r, OOValueExpression r, List r, Reference r,
 Set r, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr CodeExpr
a) (CodeExpr -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *).
(Argument r, MathConstant r, VariableValue r, Literal r,
 BooleanExpression r, Comparison r, NumericExpression r, SelfSym r,
 InternalValueExp r, OOValueExpression r, List r, Reference r,
 Set r, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr CodeExpr
b)
convExpr (ESBBinaryOp ESBBinOp
o CodeExpr
a CodeExpr
b)   = (SValue r -> SValue r -> SValue r)
-> StateT DrasilState Identity (SValue r)
-> StateT DrasilState Identity (SValue r)
-> StateT DrasilState Identity (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 -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *).
(Argument r, MathConstant r, VariableValue r, Literal r,
 BooleanExpression r, Comparison r, NumericExpression r, SelfSym r,
 InternalValueExp r, OOValueExpression r, List r, Reference r,
 Set r, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr CodeExpr
a) (CodeExpr -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *).
(Argument r, MathConstant r, VariableValue r, Literal r,
 BooleanExpression r, Comparison r, NumericExpression r, SelfSym r,
 InternalValueExp r, OOValueExpression r, List r, Reference r,
 Set r, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr CodeExpr
b)
convExpr (Case Completeness
c [(CodeExpr, CodeExpr)]
l)            = [(CodeExpr, CodeExpr)] -> StateT DrasilState Identity (SValue r)
doit [(CodeExpr, CodeExpr)]
l -- FIXME this is sub-optimal
  where
    doit :: [(CodeExpr, CodeExpr)] -> StateT DrasilState Identity (SValue r)
doit [] = Name -> StateT DrasilState Identity (SValue r)
forall a. HasCallStack => Name -> a
error Name
"should never happen" -- TODO: change error message?
    doit [(CodeExpr
e,CodeExpr
_)] = CodeExpr -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *).
(Argument r, MathConstant r, VariableValue r, Literal r,
 BooleanExpression r, Comparison r, NumericExpression r, SelfSym r,
 InternalValueExp r, OOValueExpression r, List r, Reference r,
 Set r, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr CodeExpr
e -- should always be the else clause
    doit ((CodeExpr
e,CodeExpr
cond):[(CodeExpr, CodeExpr)]
xs) = (SValue r -> SValue r -> SValue r -> SValue r)
-> StateT DrasilState Identity (SValue r)
-> StateT DrasilState Identity (SValue r)
-> StateT DrasilState Identity (SValue r)
-> StateT DrasilState Identity (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 -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *).
(Argument r, MathConstant r, VariableValue r, Literal r,
 BooleanExpression r, Comparison r, NumericExpression r, SelfSym r,
 InternalValueExp r, OOValueExpression r, List r, Reference r,
 Set r, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr CodeExpr
cond) (CodeExpr -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *).
(Argument r, MathConstant r, VariableValue r, Literal r,
 BooleanExpression r, Comparison r, NumericExpression r, SelfSym r,
 InternalValueExp r, OOValueExpression r, List r, Reference r,
 Set r, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr CodeExpr
e)
      (CodeExpr -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *).
(Argument r, MathConstant r, VariableValue r, Literal r,
 BooleanExpression r, Comparison r, NumericExpression r, SelfSym r,
 InternalValueExp r, OOValueExpression r, List r, Reference r,
 Set r, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr (Completeness -> [(CodeExpr, CodeExpr)] -> CodeExpr
Case Completeness
c [(CodeExpr, CodeExpr)]
xs))
convExpr (Matrix [[CodeExpr]
l]) = do
  ar <- (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 :: * -> *).
(Argument r, MathConstant r, VariableValue r, Literal r,
 BooleanExpression r, Comparison r, NumericExpression r, SelfSym r,
 InternalValueExp r, OOValueExpression r, List r, Reference r,
 Set r, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr [CodeExpr]
l
                                    -- hd will never fail here
  return $ litArray (fmap valueType (head ar)) ar
convExpr Matrix{} = Name -> StateT DrasilState Identity (SValue r)
forall a. HasCallStack => Name -> a
error Name
"convExpr: Matrix"
convExpr (S.Set Space
s [CodeExpr]
l) = do
  ar <- (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 :: * -> *).
(Argument r, MathConstant r, VariableValue r, Literal r,
 BooleanExpression r, Comparison r, NumericExpression r, SelfSym r,
 InternalValueExp r, OOValueExpression r, List r, Reference r,
 Set r, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr [CodeExpr]
l
  sm <- spaceCodeType s
  return $ litSet (convTypeOO sm) ar
convExpr(Variable Name
s (S.Set Space
l [CodeExpr]
_)) = do
  sm <- Space -> StateT DrasilState Identity CodeType
spaceCodeType Space
l
  let 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)
  return $ valueOf varSet
convExpr(Variable Name
_ CodeExpr
_) = Name -> StateT DrasilState Identity (SValue r)
forall a. HasCallStack => Name -> a
error Name
"convExpr: Variable"
convExpr Operator{} = Name -> StateT DrasilState Identity (SValue r)
forall a. HasCallStack => Name -> a
error Name
"convExpr: Operator"
convExpr (RealI UID
c RealInterval CodeExpr CodeExpr
ri)  = do
  g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  convExpr $ renderRealInt (lookupC g c) 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
  ::
    ( Argument r
    , MathConstant r
    , VariableValue r
    , OO.Literal r
    , BooleanExpression r
    , Comparison r
    , NumericExpression r
    , SelfSym r
    , InternalValueExp r
    , OOValueExpression r
    , List r
    , Reference r
    , OO.Set r
    , 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 :: * -> *).
(Argument r, MathConstant r, VariableValue r, Literal r,
 BooleanExpression r, Comparison r, NumericExpression r, SelfSym r,
 InternalValueExp r, OOValueExpression r, List r, Reference r,
 Set r, TypeElim r, VariableElim r) =>
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
  g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  let mem = DrasilState -> Map Name Name
eMap DrasilState
g
      lem = DrasilState -> Map Name Name
libEMap DrasilState
g
      funcCd = DefinedQuantityDict -> CodeFuncChunk
forall c.
(Quantity c, MayHaveUnit c, Concept c) =>
c -> CodeFuncChunk
quantfunc (DrasilState -> UID -> DefinedQuantityDict
lookupC DrasilState
g UID
c)
      funcNm = CodeFuncChunk -> Name
forall c. CodeIdea c => c -> Name
codeName CodeFuncChunk
funcCd
  funcTp <- codeType funcCd
  args <- mapM convExpr x
  nms <- mapM (mkVar . quantvar . lookupC g . fst) ns
  nargs <- mapM (convExpr . snd) ns
  maybe (maybe (error $ "Call to non-existent function " ++ 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))
      (Map.lookup funcNm 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))
    (Map.lookup funcNm 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) => UFuncVN -> (SValue r -> SValue r)
unopVN :: forall (r :: * -> *). List r => UFuncVN -> SValue r -> SValue r
unopVN UFuncVN
Dim = SValue r -> SValue r
forall (r :: * -> *). List r => 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) => LABinOp -> (SValue r -> SValue r -> SValue r)
laBfunc :: forall (r :: * -> *).
List r =>
LABinOp -> SValue r -> SValue r -> SValue r
laBfunc LABinOp
Index = SValue r -> SValue r -> SValue r
forall (r :: * -> *). List r => SValue r -> SValue r -> SValue r
listAccess
laBfunc LABinOp
IndexOf = SValue r -> SValue r -> SValue r
forall (r :: * -> *). List r => 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 :: (OO.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
OO.setAdd
elementSetSetBfunc ESSBinOp
SRemove = SValue r -> SValue r -> SValue r
forall (r :: * -> *). Set r => SValue r -> SValue r -> SValue r
OO.setRemove

-- Maps a 'ESSBinOp' to it's corresponding GOOL binary function.
elementSetBoolBfunc :: (OO.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
OO.contains

-- medium hacks --

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

-- | Converts a 'Mod'\'s functions to GOOL.
genModFuncs
  :: (OOProg r vis stmt mthd stvr attch prg file mod bod block)
  => Mod -> [GenState (MS (r mthd))]
genModFuncs :: forall (r :: * -> *) vis stmt mthd stvr attch prg file mod bod
       block.
OOProg r vis stmt mthd stvr attch prg file mod bod block =>
Mod -> [GenState (MS (r mthd))]
genModFuncs (Mod Name
_ Name
_ [Name]
_ [Class]
_ [Func]
fs) = (Func -> GenState (MS (r mthd)))
-> [Func] -> [GenState (MS (r mthd))]
forall a b. (a -> b) -> [a] -> [b]
map ((Name
 -> VS (r TypeData)
 -> Name
 -> [ParameterChunk]
 -> Maybe Name
 -> [MS (r block)]
 -> GenState (MS (r mthd)))
-> [StateVariable] -> Func -> GenState (MS (r mthd))
forall (r :: * -> *) vis stmt mthd stvr attch prg file mod bod
       block.
OOProg r vis stmt mthd stvr attch prg file mod bod block =>
(Name
 -> VS (r TypeData)
 -> Name
 -> [ParameterChunk]
 -> Maybe Name
 -> [MS (r block)]
 -> GenState (MS (r mthd)))
-> [StateVariable] -> Func -> GenState (MS (r mthd))
genFunc Name
-> VS (r TypeData)
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MS (r block)]
-> GenState (MS (r mthd))
forall (r :: * -> *) vis stmt mthd stvr attch prg file mod bod
       block.
OOProg r vis stmt mthd stvr attch prg file mod bod block =>
Name
-> VS (r TypeData)
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MS (r block)]
-> GenState (MS (r mthd))
publicFunc []) [Func]
fs

-- | Converts a 'Mod'\'s classes to GOOL.
genModClasses
  :: (OOProg r vis stmt mthd stvr attch prg file mod bod block)
  => Mod -> [GenState (CS (r Class))]
genModClasses :: forall (r :: * -> *) vis stmt mthd stvr attch prg file mod bod
       block.
OOProg r vis stmt mthd stvr attch prg file mod bod block =>
Mod -> [GenState (CS (r Class))]
genModClasses (Mod Name
_ Name
_ [Name]
_ [Class]
cs [Func]
_) = (Class -> GenState (CS (r Class)))
-> [Class] -> [GenState (CS (r Class))]
forall a b. (a -> b) -> [a] -> [b]
map ((Name
 -> Maybe Name
 -> Name
 -> [CSStateVar r stvr]
 -> GenState [MS (r mthd)]
 -> GenState [MS (r mthd)]
 -> GenState (CS (r Class)))
-> Class -> GenState (CS (r Class))
forall (r :: * -> *) vis stmt mthd stvr attch prg file mod bod
       block.
OOProg r vis stmt mthd stvr attch prg file mod bod block =>
(Name
 -> Maybe Name
 -> Name
 -> [CSStateVar r stvr]
 -> GenState [MS (r mthd)]
 -> GenState [MS (r mthd)]
 -> GenState (CS (r Class)))
-> Class -> GenState (CS (r Class))
genClass Name
-> Maybe Name
-> Name
-> [CSStateVar r stvr]
-> GenState [MS (r mthd)]
-> GenState [MS (r mthd)]
-> GenState (CS (r Class))
forall (r :: * -> *) vis mthd stvr attch.
ClassSym r vis mthd stvr attch =>
Name
-> Maybe Name
-> Name
-> [CSStateVar r stvr]
-> GenState [MS (r mthd)]
-> GenState [MS (r mthd)]
-> GenState (CS (r Class))
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 stmt mthd stvr attch prg file mod bod block)
  => (Name -> Maybe Name -> Description -> [CSStateVar r stvr] -> GenState [MS (r mthd)] -> GenState [MS (r mthd)] -> GenState (CS (r Class)))
  -> M.Class
  -> GenState (CS (r Class))
genClass :: forall (r :: * -> *) vis stmt mthd stvr attch prg file mod bod
       block.
OOProg r vis stmt mthd stvr attch prg file mod bod block =>
(Name
 -> Maybe Name
 -> Name
 -> [CSStateVar r stvr]
 -> GenState [MS (r mthd)]
 -> GenState [MS (r mthd)]
 -> GenState (CS (r Class)))
-> Class -> GenState (CS (r Class))
genClass Name
-> Maybe Name
-> Name
-> [CSStateVar r stvr]
-> GenState [MS (r mthd)]
-> GenState [MS (r mthd)]
-> GenState (CS (r Class))
f (M.ClassDef Name
n Maybe Name
i Name
desc [StateVariable]
svs [Func]
cs [Func]
ms) = let svar :: VisibilityTag -> SVariable r -> CSStateVar r stvr
svar VisibilityTag
Pub = SVariable r -> CSStateVar r stvr
forall (r :: * -> *) vis stvr attch.
StateVarSym r vis stvr attch =>
SVariable r -> CSStateVar r stvr
pubDVar
                                                 svar VisibilityTag
Priv = SVariable r -> CSStateVar r stvr
forall (r :: * -> *) vis stvr attch.
StateVarSym r vis stvr attch =>
SVariable r -> CSStateVar r stvr
privDVar
  in do
  (DrasilState -> DrasilState) -> StateT DrasilState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\DrasilState
st -> DrasilState
st {currentScope = Local})
  svrs <- (StateVariable -> StateT DrasilState Identity (CSStateVar r stvr))
-> [StateVariable]
-> StateT DrasilState Identity [CSStateVar r stvr]
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 stvr)
-> StateT DrasilState Identity CodeType
-> StateT DrasilState Identity (CSStateVar r stvr)
forall a b.
(a -> b)
-> StateT DrasilState Identity a -> StateT DrasilState Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (VisibilityTag -> SVariable r -> CSStateVar r stvr
forall {r :: * -> *} {vis} {stvr} {attch}.
StateVarSym r vis stvr attch =>
VisibilityTag -> SVariable r -> CSStateVar r stvr
svar VisibilityTag
s (SVariable r -> CSStateVar r stvr)
-> (CodeType -> SVariable r) -> CodeType -> CSStateVar r stvr
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
  f n i desc svrs (mapM (genFunc publicMethod svs) cs)
                  (mapM (genFunc publicMethod svs) 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 stmt mthd stvr attch prg file mod bod block)
  => (Name -> VS (r TypeData) -> Description -> [ParameterChunk] -> Maybe Description -> [MS (r block)] -> GenState (MS (r mthd)))
  -> [StateVariable]
  -> Func
  -> GenState (MS (r mthd))
genFunc :: forall (r :: * -> *) vis stmt mthd stvr attch prg file mod bod
       block.
OOProg r vis stmt mthd stvr attch prg file mod bod block =>
(Name
 -> VS (r TypeData)
 -> Name
 -> [ParameterChunk]
 -> Maybe Name
 -> [MS (r block)]
 -> GenState (MS (r mthd)))
-> [StateVariable] -> Func -> GenState (MS (r mthd))
genFunc Name
-> VS (r TypeData)
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MS (r block)]
-> GenState (MS (r mthd))
f [StateVariable]
svs (FDef (FuncDef Name
n Name
desc [ParameterChunk]
parms Space
o Maybe Name
rd [FuncStmt]
s)) = do
  g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  modify (\DrasilState
st -> DrasilState
st {currentScope = Local})
  stmts <- mapM convStmt s
  vars <- mapM mkVar (fstdecl (g ^. systemdb) s
    \\ (map quantvar parms ++ map stVar svs))
  t <- spaceCodeType o
  f n (convTypeOO t) desc parms rd [block $ map (`varDec` local) vars, block stmts]
genFunc Name
-> VS (r TypeData)
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MS (r block)]
-> GenState (MS (r mthd))
_ [StateVariable]
svs (FDef (CtorDef Name
n Name
desc [ParameterChunk]
parms [Initializer]
i [FuncStmt]
s)) = do
  g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  modify (\DrasilState
st -> DrasilState
st {currentScope = Local})
  inits <- mapM (convExpr . snd) i
  initvars <- 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)) . fst) i
  stmts <- mapM convStmt s
  vars <- mapM mkVar (fstdecl (g ^. systemdb) s
    \\ (map quantvar parms ++ map stVar svs))
  genInitConstructor n desc parms (zip initvars inits)
    [block $ map (`varDec` local) vars, block stmts]
genFunc Name
-> VS (r TypeData)
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MS (r block)]
-> GenState (MS (r mthd))
_ [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 mthd))
forall (r :: * -> *) vis stmt mthd stvr attch prg file mod bod
       block.
OOProg r vis stmt mthd stvr attch prg file mod bod block =>
Name -> Name -> DataDesc -> GenState (MS (r mthd))
genDataFunc Name
n Name
desc DataDesc
ddef

-- | Converts a 'FuncStmt' to a GOOL Statement.
convStmt
  ::
    ( BlockSym r block stmt
    , BodySym r bod block
    , Argument r
    , MathConstant r
    , VariableValue r
    , OO.Literal r
    , BooleanExpression r
    , Comparison r
    , NumericExpression r
    , SelfSym r
    , InternalValueExp r
    , OOValueExpression r
    , Array r
    , List r
    , ListStatement r stmt
    , Reference r
    , OO.Set r
    , MultiStatement r stmt
    , ValueStatement r stmt
    , AssignStatement r stmt
    , ControlStatement r stmt bod
    , DeclStatement r stmt bod
    , TypeElim r
    , VariableElim r
    )
  => FuncStmt -> GenState (MS (r stmt))
convStmt :: forall (r :: * -> *) block stmt bod.
(BlockSym r block stmt, BodySym r bod block, Argument r,
 MathConstant r, VariableValue r, Literal r, BooleanExpression r,
 Comparison r, NumericExpression r, SelfSym r, InternalValueExp r,
 OOValueExpression r, Array r, List r, ListStatement r stmt,
 Reference r, Set r, MultiStatement r stmt, ValueStatement r stmt,
 AssignStatement r stmt, ControlStatement r stmt bod,
 DeclStatement r stmt bod, TypeElim r, VariableElim r) =>
FuncStmt -> GenState (MS (r stmt))
convStmt (FAsg Input
v (Matrix [[CodeExpr]
es])) = do
  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 :: * -> *).
(Argument r, MathConstant r, VariableValue r, Literal r,
 BooleanExpression r, Comparison r, NumericExpression r, SelfSym r,
 InternalValueExp r, OOValueExpression r, List r, Reference r,
 Set r, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr [CodeExpr]
es
  v' <- mkVar v
  t <- codeType v
  let listFunc (OO.List CodeType
_) = VS (r TypeData) -> [SValue r] -> SValue r
forall (r :: * -> *).
Literal r =>
VS (r TypeData) -> [SValue r] -> SValue r
litList
      listFunc (OO.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"
  return $ assign v' (listFunc t (innerType $ fmap variableType v') els)
convStmt (FAsg Input
v CodeExpr
e) = do
  e' <- CodeExpr -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *).
(Argument r, MathConstant r, VariableValue r, Literal r,
 BooleanExpression r, Comparison r, NumericExpression r, SelfSym r,
 InternalValueExp r, OOValueExpression r, List r, Reference r,
 Set r, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr CodeExpr
e
  v' <- mkVar v
  return $ assign v' e'
convStmt (FAsgIndex Input
v Integer
i CodeExpr
e) = do
  e' <- CodeExpr -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *).
(Argument r, MathConstant r, VariableValue r, Literal r,
 BooleanExpression r, Comparison r, NumericExpression r, SelfSym r,
 InternalValueExp r, OOValueExpression r, List r, Reference r,
 Set r, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr CodeExpr
e
  v' <- mkVar v
  t <- codeType v
  let asgFunc (OO.List CodeType
_) = SValue r -> SValue r -> SValue r -> MS (r stmt)
forall (r :: * -> *) stmt.
ListStatement r stmt =>
SValue r -> SValue r -> SValue r -> MS (r stmt)
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 (OO.Array CodeType
_) = SVariable r -> SValue r -> MS (r stmt)
forall (r :: * -> *) stmt.
AssignStatement r stmt =>
SVariable r -> SValue r -> MS (r stmt)
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 stmt)
forall a. HasCallStack => Name -> a
error Name
"FAsgIndex used with non-indexed value"
  return $ asgFunc t
convStmt (FFor Input
v CodeExpr
start CodeExpr
end CodeExpr
step [FuncStmt]
st) = do
  stmts <- (FuncStmt -> StateT DrasilState Identity (MS (r stmt)))
-> [FuncStmt] -> StateT DrasilState Identity [MS (r stmt)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM FuncStmt -> StateT DrasilState Identity (MS (r stmt))
forall (r :: * -> *) block stmt bod.
(BlockSym r block stmt, BodySym r bod block, Argument r,
 MathConstant r, VariableValue r, Literal r, BooleanExpression r,
 Comparison r, NumericExpression r, SelfSym r, InternalValueExp r,
 OOValueExpression r, Array r, List r, ListStatement r stmt,
 Reference r, Set r, MultiStatement r stmt, ValueStatement r stmt,
 AssignStatement r stmt, ControlStatement r stmt bod,
 DeclStatement r stmt bod, TypeElim r, VariableElim r) =>
FuncStmt -> GenState (MS (r stmt))
convStmt [FuncStmt]
st
  vari <- mkVar v
  start' <- convExpr start
  end' <- convExpr end
  step' <- convExpr step
  return $ forRange vari start' end' step' (bodyStatements stmts)
convStmt (FForEach Input
v CodeExpr
e [FuncStmt]
st) = do
  stmts <- (FuncStmt -> StateT DrasilState Identity (MS (r stmt)))
-> [FuncStmt] -> StateT DrasilState Identity [MS (r stmt)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM FuncStmt -> StateT DrasilState Identity (MS (r stmt))
forall (r :: * -> *) block stmt bod.
(BlockSym r block stmt, BodySym r bod block, Argument r,
 MathConstant r, VariableValue r, Literal r, BooleanExpression r,
 Comparison r, NumericExpression r, SelfSym r, InternalValueExp r,
 OOValueExpression r, Array r, List r, ListStatement r stmt,
 Reference r, Set r, MultiStatement r stmt, ValueStatement r stmt,
 AssignStatement r stmt, ControlStatement r stmt bod,
 DeclStatement r stmt bod, TypeElim r, VariableElim r) =>
FuncStmt -> GenState (MS (r stmt))
convStmt [FuncStmt]
st
  vari <- mkVar v
  e' <- convExpr e
  return $ forEach vari e' (bodyStatements stmts)
convStmt (FWhile CodeExpr
e [FuncStmt]
st) = do
  stmts <- (FuncStmt -> StateT DrasilState Identity (MS (r stmt)))
-> [FuncStmt] -> StateT DrasilState Identity [MS (r stmt)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM FuncStmt -> StateT DrasilState Identity (MS (r stmt))
forall (r :: * -> *) block stmt bod.
(BlockSym r block stmt, BodySym r bod block, Argument r,
 MathConstant r, VariableValue r, Literal r, BooleanExpression r,
 Comparison r, NumericExpression r, SelfSym r, InternalValueExp r,
 OOValueExpression r, Array r, List r, ListStatement r stmt,
 Reference r, Set r, MultiStatement r stmt, ValueStatement r stmt,
 AssignStatement r stmt, ControlStatement r stmt bod,
 DeclStatement r stmt bod, TypeElim r, VariableElim r) =>
FuncStmt -> GenState (MS (r stmt))
convStmt [FuncStmt]
st
  e' <- convExpr e
  return $ while e' (bodyStatements stmts)
convStmt (FCond CodeExpr
e [FuncStmt]
tSt []) = do
  stmts <- (FuncStmt -> StateT DrasilState Identity (MS (r stmt)))
-> [FuncStmt] -> StateT DrasilState Identity [MS (r stmt)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM FuncStmt -> StateT DrasilState Identity (MS (r stmt))
forall (r :: * -> *) block stmt bod.
(BlockSym r block stmt, BodySym r bod block, Argument r,
 MathConstant r, VariableValue r, Literal r, BooleanExpression r,
 Comparison r, NumericExpression r, SelfSym r, InternalValueExp r,
 OOValueExpression r, Array r, List r, ListStatement r stmt,
 Reference r, Set r, MultiStatement r stmt, ValueStatement r stmt,
 AssignStatement r stmt, ControlStatement r stmt bod,
 DeclStatement r stmt bod, TypeElim r, VariableElim r) =>
FuncStmt -> GenState (MS (r stmt))
convStmt [FuncStmt]
tSt
  e' <- convExpr e
  return $ ifNoElse [(e', bodyStatements stmts)]
convStmt (FCond CodeExpr
e [FuncStmt]
tSt [FuncStmt]
eSt) = do
  stmt1 <- (FuncStmt -> StateT DrasilState Identity (MS (r stmt)))
-> [FuncStmt] -> StateT DrasilState Identity [MS (r stmt)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM FuncStmt -> StateT DrasilState Identity (MS (r stmt))
forall (r :: * -> *) block stmt bod.
(BlockSym r block stmt, BodySym r bod block, Argument r,
 MathConstant r, VariableValue r, Literal r, BooleanExpression r,
 Comparison r, NumericExpression r, SelfSym r, InternalValueExp r,
 OOValueExpression r, Array r, List r, ListStatement r stmt,
 Reference r, Set r, MultiStatement r stmt, ValueStatement r stmt,
 AssignStatement r stmt, ControlStatement r stmt bod,
 DeclStatement r stmt bod, TypeElim r, VariableElim r) =>
FuncStmt -> GenState (MS (r stmt))
convStmt [FuncStmt]
tSt
  stmt2 <- mapM convStmt eSt
  e' <- convExpr e
  return $ ifCond [(e', bodyStatements stmt1)] (bodyStatements stmt2)
convStmt (FRet CodeExpr
e) = do
  e' <- CodeExpr -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *).
(Argument r, MathConstant r, VariableValue r, Literal r,
 BooleanExpression r, Comparison r, NumericExpression r, SelfSym r,
 InternalValueExp r, OOValueExpression r, List r, Reference r,
 Set r, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr CodeExpr
e
  return $ returnStmt e'
convStmt (FThrow Name
s) = MS (r stmt) -> StateT DrasilState Identity (MS (r stmt))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (MS (r stmt) -> StateT DrasilState Identity (MS (r stmt)))
-> MS (r stmt) -> StateT DrasilState Identity (MS (r stmt))
forall a b. (a -> b) -> a -> b
$ Name -> MS (r stmt)
forall (r :: * -> *) stmt bod.
ControlStatement r stmt bod =>
Name -> MS (r stmt)
throw Name
s
convStmt (FTry [FuncStmt]
t [FuncStmt]
c) = do
  stmt1 <- (FuncStmt -> StateT DrasilState Identity (MS (r stmt)))
-> [FuncStmt] -> StateT DrasilState Identity [MS (r stmt)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM FuncStmt -> StateT DrasilState Identity (MS (r stmt))
forall (r :: * -> *) block stmt bod.
(BlockSym r block stmt, BodySym r bod block, Argument r,
 MathConstant r, VariableValue r, Literal r, BooleanExpression r,
 Comparison r, NumericExpression r, SelfSym r, InternalValueExp r,
 OOValueExpression r, Array r, List r, ListStatement r stmt,
 Reference r, Set r, MultiStatement r stmt, ValueStatement r stmt,
 AssignStatement r stmt, ControlStatement r stmt bod,
 DeclStatement r stmt bod, TypeElim r, VariableElim r) =>
FuncStmt -> GenState (MS (r stmt))
convStmt [FuncStmt]
t
  stmt2 <- mapM convStmt c
  return $ tryCatch (bodyStatements stmt1) (bodyStatements stmt2)
convStmt FuncStmt
FContinue = MS (r stmt) -> StateT DrasilState Identity (MS (r stmt))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return MS (r stmt)
forall (r :: * -> *) stmt bod.
ControlStatement r stmt bod =>
MS (r stmt)
continue
convStmt (FDecDef Input
v (Matrix [[]])) = do
  g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  let scp = ScopeType -> r ScopeData
forall (r :: * -> *). ScopeSym r => ScopeType -> r ScopeData
convScope (ScopeType -> r ScopeData) -> ScopeType -> r ScopeData
forall a b. (a -> b) -> a -> b
$ DrasilState -> ScopeType
currentScope DrasilState
g
  vari <- mkVar v
  let convDec (OO.List CodeType
_) = Integer -> SVariable r -> r ScopeData -> MS (r stmt)
forall (r :: * -> *) stmt bod.
DeclStatement r stmt bod =>
Integer -> SVariable r -> r ScopeData -> MS (r stmt)
listDec Integer
0 SVariable r
vari
      convDec (OO.Array CodeType
_) = Integer -> SValue r -> SVariable r -> r ScopeData -> MS (r stmt)
forall (r :: * -> *) stmt bod.
DeclStatement r stmt bod =>
Integer -> SValue r -> SVariable r -> r ScopeData -> MS (r stmt)
arrayDec Integer
0 SValue r
forall a. HasCallStack => a
undefined SVariable r
vari
      convDec CodeType
_ = SVariable r -> r ScopeData -> MS (r stmt)
forall (r :: * -> *) stmt bod.
DeclStatement r stmt bod =>
SVariable r -> r ScopeData -> MS (r stmt)
varDec SVariable r
vari
  fmap (`convDec` scp) (codeType v)
convStmt (FDecDef Input
v CodeExpr
e) = do
  g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  let scp = ScopeType -> r ScopeData
forall (r :: * -> *). ScopeSym r => ScopeType -> r ScopeData
convScope (ScopeType -> r ScopeData) -> ScopeType -> r ScopeData
forall a b. (a -> b) -> a -> b
$ DrasilState -> ScopeType
currentScope DrasilState
g
  v' <- mkVar v
  t <- codeType v
  let convDecDef (Matrix [[CodeExpr]
lst]) = do
        let contDecDef :: CodeType -> SVariable r -> r ScopeData -> [SValue r] -> MS (r stmt)
contDecDef (OO.List CodeType
_) = SVariable r -> r ScopeData -> [SValue r] -> MS (r stmt)
forall (r :: * -> *) stmt bod.
DeclStatement r stmt bod =>
SVariable r -> r ScopeData -> [SValue r] -> MS (r stmt)
listDecDef
            contDecDef (OO.Array CodeType
_) = SVariable r -> r ScopeData -> [SValue r] -> MS (r stmt)
forall (r :: * -> *) stmt bod.
DeclStatement r stmt bod =>
SVariable r -> r ScopeData -> [SValue r] -> MS (r stmt)
arrayDecDef
            contDecDef CodeType
_ = Name -> SVariable r -> r ScopeData -> [SValue r] -> MS (r stmt)
forall a. HasCallStack => Name -> a
error Name
"Type mismatch between variable and value in declare-define FuncStmt"
        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 :: * -> *).
(Argument r, MathConstant r, VariableValue r, Literal r,
 BooleanExpression r, Comparison r, NumericExpression r, SelfSym r,
 InternalValueExp r, OOValueExpression r, List r, Reference r,
 Set r, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr [CodeExpr]
lst
        return $ contDecDef t v' scp e'
      convDecDef CodeExpr
_ = do
        e' <- CodeExpr -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *).
(Argument r, MathConstant r, VariableValue r, Literal r,
 BooleanExpression r, Comparison r, NumericExpression r, SelfSym r,
 InternalValueExp r, OOValueExpression r, List r, Reference r,
 Set r, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr CodeExpr
e
        return $ varDecDef v' scp e'
  convDecDef e
convStmt (FFuncDef CodeFuncChunk
f [ParameterChunk]
ps [FuncStmt]
sts) = do
  g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  let scp = ScopeType -> r ScopeData
forall (r :: * -> *). ScopeSym r => ScopeType -> r ScopeData
convScope (ScopeType -> r ScopeData) -> ScopeType -> r ScopeData
forall a b. (a -> b) -> a -> b
$ DrasilState -> ScopeType
currentScope DrasilState
g
  f' <- mkVar (quantvar f)
  pms <- mapM (mkVar . quantvar) ps
  b <- mapM convStmt sts
  return $ funcDecDef f' scp pms (bodyStatements b)
convStmt (FVal CodeExpr
e) = do
  e' <- CodeExpr -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *).
(Argument r, MathConstant r, VariableValue r, Literal r,
 BooleanExpression r, Comparison r, NumericExpression r, SelfSym r,
 InternalValueExp r, OOValueExpression r, List r, Reference r,
 Set r, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr CodeExpr
e
  return $ valStmt e'
convStmt (FMulti [FuncStmt]
ss) = do
  stmts <- (FuncStmt -> StateT DrasilState Identity (MS (r stmt)))
-> [FuncStmt] -> StateT DrasilState Identity [MS (r stmt)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM FuncStmt -> StateT DrasilState Identity (MS (r stmt))
forall (r :: * -> *) block stmt bod.
(BlockSym r block stmt, BodySym r bod block, Argument r,
 MathConstant r, VariableValue r, Literal r, BooleanExpression r,
 Comparison r, NumericExpression r, SelfSym r, InternalValueExp r,
 OOValueExpression r, Array r, List r, ListStatement r stmt,
 Reference r, Set r, MultiStatement r stmt, ValueStatement r stmt,
 AssignStatement r stmt, ControlStatement r stmt bod,
 DeclStatement r stmt bod, TypeElim r, VariableElim r) =>
FuncStmt -> GenState (MS (r stmt))
convStmt [FuncStmt]
ss
  return $ multi stmts
convStmt (FAppend CodeExpr
a CodeExpr
b) = do
  a' <- CodeExpr -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *).
(Argument r, MathConstant r, VariableValue r, Literal r,
 BooleanExpression r, Comparison r, NumericExpression r, SelfSym r,
 InternalValueExp r, OOValueExpression r, List r, Reference r,
 Set r, TypeElim r, VariableElim r) =>
CodeExpr -> GenState (SValue r)
convExpr CodeExpr
a
  b' <- convExpr b
  return $ listAppend a' b'

-- | Generates a function that reads a file whose format is based on the passed
-- 'DataDesc'.
genDataFunc
  :: (OOProg r vis stmt mthd stvr attch prg file mod bod block)
  => Name -> Description -> DataDesc -> GenState (MS (r mthd))
genDataFunc :: forall (r :: * -> *) vis stmt mthd stvr attch prg file mod bod
       block.
OOProg r vis stmt mthd stvr attch prg file mod bod block =>
Name -> Name -> DataDesc -> GenState (MS (r mthd))
genDataFunc Name
nameTitle Name
desc DataDesc
ddef = do
  let parms :: [Input]
parms = DataDesc -> [Input]
getInputs DataDesc
ddef
  bod <- DataDesc -> GenState [MS (r block)]
forall (r :: * -> *) block stmt bod.
(BlockSym r block stmt, BodySym r bod block, Argument r, Literal r,
 MathConstant r, OOVariableValue r, BooleanExpression r,
 Comparison r, NumericExpression r, SelfSym r, InternalValueExp r,
 OOValueExpression r, List r, ListStatement r stmt, Reference r,
 Set r, OODeclStatement r stmt bod, ControlStatement r stmt bod,
 StringStatement r stmt, FileHandling r stmt, ReadFile r stmt,
 TypeElim r, VariableElim r) =>
DataDesc -> GenState [MS (r block)]
readData DataDesc
ddef
  publicFunc nameTitle void desc (map pcAuto $ quantvar inFileName : parms)
    Nothing bod

-- this is really ugly!!
-- | Read from a data description into an 'MS block' of 'MS Statement's.
readData
  ::
    ( BlockSym r block stmt
    , BodySym r bod block
    , Argument r
    , OO.Literal r
    , MathConstant r
    , OOVariableValue r
    , BooleanExpression r
    , Comparison r
    , NumericExpression r
    , SelfSym r
    , InternalValueExp r
    , OOValueExpression r
    , List r
    , ListStatement r stmt
    , Reference r
    , OO.Set r
    , OODeclStatement r stmt bod
    , ControlStatement r stmt bod
    , StringStatement r stmt
    , FileHandling r stmt
    , ReadFile r stmt
    , TypeElim r
    , VariableElim r
    )
  => DataDesc -> GenState [MS (r block)]
readData :: forall (r :: * -> *) block stmt bod.
(BlockSym r block stmt, BodySym r bod block, Argument r, Literal r,
 MathConstant r, OOVariableValue r, BooleanExpression r,
 Comparison r, NumericExpression r, SelfSym r, InternalValueExp r,
 OOValueExpression r, List r, ListStatement r stmt, Reference r,
 Set r, OODeclStatement r stmt bod, ControlStatement r stmt bod,
 StringStatement r stmt, FileHandling r stmt, ReadFile r stmt,
 TypeElim r, VariableElim r) =>
DataDesc -> GenState [MS (r block)]
readData DataDesc
ddef = do
  g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  let 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
  inD <- mapM (`inData` localScope) ddef
  v_filename <- mkVal (quantvar inFileName)
  return [block $
    varDec var_infile localScope :
    (if any (\Data
d -> Data -> Bool
isLine Data
d Bool -> Bool -> Bool
|| Data -> Bool
isLines Data
d) ddef then [varDec var_line localScope,
    listDec 0 var_linetokens localScope ] else []) ++
    [listDec 0 var_lines localScope | any isLines ddef] ++ openFileR var_infile
    v_filename : concat inD ++ [closeFile v_infile]]
  where inData
          ::
            ( BlockSym r block stmt
            , BodySym r bod block
            , OO.Literal r
            , OOVariableValue r
            , List r
            , ListStatement r stmt
            , OODeclStatement r stmt bod
            , ControlStatement r stmt bod
            , StringStatement r stmt
            , ReadFile r stmt
            , VariableElim r
            )
          => Data -> r ScopeData -> GenState [MS (r stmt)]
        inData :: forall (r :: * -> *) block stmt bod.
(BlockSym r block stmt, BodySym r bod block, Literal r,
 OOVariableValue r, List r, ListStatement r stmt,
 OODeclStatement r stmt bod, ControlStatement r stmt bod,
 StringStatement r stmt, ReadFile r stmt, VariableElim r) =>
Data -> r ScopeData -> GenState [MS (r stmt)]
inData (Singleton Input
v) r ScopeData
_ = do
            vv <- Input -> GenState (SVariable r)
forall (r :: * -> *).
(SelfSym r, VariableElim r, VariableValue r) =>
Input -> GenState (SVariable r)
mkVar Input
v
            return [getFileInput v_infile vv]
        inData Data
JunkData r ScopeData
_ = [MS (r stmt)] -> StateT DrasilState Identity [MS (r stmt)]
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return [SValue r -> MS (r stmt)
forall (r :: * -> *) stmt.
ReadFile r stmt =>
SValue r -> MS (r stmt)
discardFileLine SValue r
forall (r :: * -> *). VariableValue r => SValue r
v_infile]
        inData (Line LinePattern
lp Char
d) r ScopeData
scp = do
          lnI <- Maybe Name
-> LinePattern
-> r ScopeData
-> StateT DrasilState Identity [MS (r stmt)]
forall (r :: * -> *) stmt bod.
(OOVariableValue r, ListStatement r stmt,
 OODeclStatement r stmt bod, StringStatement r stmt,
 VariableElim r) =>
Maybe Name -> LinePattern -> r ScopeData -> GenState [MS (r stmt)]
lineData Maybe Name
forall a. Maybe a
Nothing LinePattern
lp r ScopeData
scp
          return $ [getFileInputLine v_infile var_line,
            stringSplit d var_linetokens v_line] ++ lnI
        inData (Lines LinePattern
lp Maybe Integer
ls Char
d) r ScopeData
scp = do
          lnV <- Maybe Name
-> LinePattern
-> r ScopeData
-> StateT DrasilState Identity [MS (r stmt)]
forall (r :: * -> *) stmt bod.
(OOVariableValue r, ListStatement r stmt,
 OODeclStatement r stmt bod, StringStatement r stmt,
 VariableElim r) =>
Maybe Name -> LinePattern -> r ScopeData -> GenState [MS (r stmt)]
lineData (Name -> Maybe Name
forall a. a -> Maybe a
Just Name
"_temp") LinePattern
lp r ScopeData
scp
          let readLines Maybe Integer
Nothing = [SValue r -> SVariable r -> MS (r stmt)
forall (r :: * -> *) stmt.
ReadFile r stmt =>
SValue r -> SVariable r -> MS (r stmt)
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 bod) -> MS (r stmt)
forall (r :: * -> *) stmt bod.
ControlStatement r stmt bod =>
SVariable r
-> SValue r -> SValue r -> SValue r -> MS (r bod) -> MS (r stmt)
forRange SVariable r
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 :: * -> *). List r => 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 stmt)] -> MS (r bod)
forall {k} (r :: k -> *) (block :: k) (stmt :: k) (bod :: k).
(BlockSym r block stmt, BodySym r bod block) =>
[MS (r stmt)] -> MS (r bod)
bodyStatements ([MS (r stmt)] -> MS (r bod)) -> [MS (r stmt)] -> MS (r bod)
forall a b. (a -> b) -> a -> b
$ Char -> SVariable r -> SValue r -> MS (r stmt)
forall (r :: * -> *) stmt.
StringStatement r stmt =>
Char -> SVariable r -> SValue r -> MS (r stmt)
stringSplit Char
d SVariable r
forall (r :: * -> *). VariableSym r => SVariable r
var_linetokens (
                  SValue r -> SValue r -> SValue r
forall (r :: * -> *). List r => 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 stmt) -> [MS (r stmt)] -> [MS (r stmt)]
forall a. a -> [a] -> [a]
: [MS (r stmt)]
lnV)]
              readLines (Just Integer
numLines) = [SVariable r
-> SValue r -> SValue r -> SValue r -> MS (r bod) -> MS (r stmt)
forall (r :: * -> *) stmt bod.
ControlStatement r stmt bod =>
SVariable r
-> SValue r -> SValue r -> SValue r -> MS (r bod) -> MS (r stmt)
forRange SVariable r
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 stmt)] -> MS (r bod)
forall {k} (r :: k -> *) (block :: k) (stmt :: k) (bod :: k).
(BlockSym r block stmt, BodySym r bod block) =>
[MS (r stmt)] -> MS (r bod)
bodyStatements ([MS (r stmt)] -> MS (r bod)) -> [MS (r stmt)] -> MS (r bod)
forall a b. (a -> b) -> a -> b
$
                  [SValue r -> SVariable r -> MS (r stmt)
forall (r :: * -> *) stmt.
ReadFile r stmt =>
SValue r -> SVariable r -> MS (r stmt)
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 stmt)
forall (r :: * -> *) stmt.
StringStatement r stmt =>
Char -> SVariable r -> SValue r -> MS (r stmt)
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 stmt)] -> [MS (r stmt)] -> [MS (r stmt)]
forall a. [a] -> [a] -> [a]
++ [MS (r stmt)]
lnV)]
          return $ readLines ls
        ---------------
        lineData
          ::
            ( OOVariableValue r
            , ListStatement r stmt
            , OODeclStatement r stmt bod
            , StringStatement r stmt
            , VariableElim r
            )
          => Maybe String -> LinePattern -> r ScopeData -> GenState [MS (r stmt)]
        lineData :: forall (r :: * -> *) stmt bod.
(OOVariableValue r, ListStatement r stmt,
 OODeclStatement r stmt bod, StringStatement r stmt,
 VariableElim r) =>
Maybe Name -> LinePattern -> r ScopeData -> GenState [MS (r stmt)]
lineData Maybe Name
s p :: LinePattern
p@(Straight [Input]
_) r ScopeData
_ = do
          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
          return [stringListVals vs v_linetokens]
        lineData Maybe Name
s p :: LinePattern
p@(Repeat [Input]
ds) r ScopeData
scp = do
          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
          sequence $ clearTemps s ds scp ++ return
            (stringListLists vs v_linetokens) : appendTemps s ds
        ---------------
        clearTemps
          :: (OODeclStatement r stmt bod)
          => Maybe String -> [DataItem] -> r ScopeData -> [GenState (MS (r stmt))]
        clearTemps :: forall (r :: * -> *) stmt bod.
OODeclStatement r stmt bod =>
Maybe Name -> [Input] -> r ScopeData -> [GenState (MS (r stmt))]
clearTemps Maybe Name
Nothing    [Input]
_  r ScopeData
_   = []
        clearTemps (Just Name
sfx) [Input]
es r ScopeData
scp = (Input -> GenState (MS (r stmt)))
-> [Input] -> [GenState (MS (r stmt))]
forall a b. (a -> b) -> [a] -> [b]
map (\Input
v -> Name -> Input -> r ScopeData -> GenState (MS (r stmt))
forall (r :: * -> *) stmt bod.
OODeclStatement r stmt bod =>
Name -> Input -> r ScopeData -> GenState (MS (r stmt))
clearTemp Name
sfx Input
v r ScopeData
scp) [Input]
es
        ---------------
        clearTemp
          :: (OODeclStatement r stmt bod)
          => String -> DataItem -> r ScopeData -> GenState (MS (r stmt))
        clearTemp :: forall (r :: * -> *) stmt bod.
OODeclStatement r stmt bod =>
Name -> Input -> r ScopeData -> GenState (MS (r stmt))
clearTemp Name
sfx Input
v r ScopeData
scp = (CodeType -> MS (r stmt))
-> StateT DrasilState Identity CodeType
-> StateT DrasilState Identity (MS (r stmt))
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 stmt)
forall (r :: * -> *) stmt bod.
DeclStatement r stmt bod =>
SVariable r -> r ScopeData -> [SValue r] -> MS (r stmt)
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
          :: (ListStatement r stmt, OOVariableValue r)
          => Maybe String -> [DataItem] -> [GenState (MS (r stmt))]
        appendTemps :: forall (r :: * -> *) stmt.
(ListStatement r stmt, OOVariableValue r) =>
Maybe Name -> [Input] -> [GenState (MS (r stmt))]
appendTemps Maybe Name
Nothing [Input]
_ = []
        appendTemps (Just Name
sfx) [Input]
es = (Input -> GenState (MS (r stmt)))
-> [Input] -> [GenState (MS (r stmt))]
forall a b. (a -> b) -> [a] -> [b]
map (Name -> Input -> GenState (MS (r stmt))
forall (r :: * -> *) stmt.
(ListStatement r stmt, OOVariableValue r) =>
Name -> Input -> GenState (MS (r stmt))
appendTemp Name
sfx) [Input]
es
        ---------------
        appendTemp
          :: (ListStatement r stmt, OOVariableValue r)
          => String -> DataItem -> GenState (MS (r stmt))
        appendTemp :: forall (r :: * -> *) stmt.
(ListStatement r stmt, OOVariableValue r) =>
Name -> Input -> GenState (MS (r stmt))
appendTemp Name
sfx Input
v = (CodeType -> MS (r stmt))
-> StateT DrasilState Identity CodeType
-> StateT DrasilState Identity (MS (r stmt))
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 stmt)
forall (r :: * -> *) stmt.
ListStatement r stmt =>
SValue r -> SValue r -> MS (r stmt)
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
    , MathConstant r
    , VariableValue r
    , BooleanExpression r
    , Comparison r
    , NumericExpression r
    , ValueExpression r
    , Argument r
    , List r
    , Reference r
    , OO.Set r
    , TypeElim r
    )
  => UID -> Name -> VS (r TypeData) -> GenState (SValue r)
valueProc :: forall (r :: * -> *).
(NativeVector r, MathConstant r, VariableValue r,
 BooleanExpression r, Comparison r, NumericExpression r,
 ValueExpression r, Argument r, List r, Reference r, Set r,
 TypeElim r) =>
UID -> Name -> VS (r TypeData) -> GenState (SValue r)
valueProc UID
u Name
s VS (r TypeData)
t = do
  g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  let cs = DrasilState
g
      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 = do
        cd <- UID -> ConstantMap -> Maybe CodeDefinition
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup UID
u ConstantMap
mm
        maybeInline (g ^. conStruct) cd
      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 = 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 = UID -> MatchedConceptMap -> Maybe CodeConcept
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup UID
u MatchedConceptMap
cm
  val <- maybe (valueOf <$> variableProc s t)
                (convExprProc . (^. codeExpr)) constDef
  return $ maybe val conceptToGOOL 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
  g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  let cs = DrasilState
g
      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 s `elem` map codeName (cs ^. inputs)
    then inputVariableProc (g ^. inStruct) Var (var s t)
    else if s `elem` map codeName (cs ^. constDefns)
      then constVariableProc (g ^. conStruct) (g ^. conRepr)
              ((defFunc $ g ^. conRepr) s t)
      else return $ var s 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
  g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  inputVariableProc (g ^. inStruct) cr 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
    , MathConstant r
    , VariableValue r
    , BooleanExpression r
    , Comparison r
    , NumericExpression r
    , ValueExpression r
    , Argument r
    , List r
    , Reference r
    , OO.Set r
    , TypeElim r
    )
  => CodeVarChunk -> GenState (SValue r)
mkValProc :: forall (r :: * -> *).
(NativeVector r, MathConstant r, VariableValue r,
 BooleanExpression r, Comparison r, NumericExpression r,
 ValueExpression r, Argument r, List r, Reference r, Set r,
 TypeElim r) =>
Input -> GenState (SValue r)
mkValProc Input
v = do
  t <- Input -> StateT DrasilState Identity CodeType
forall c. HasSpace c => c -> StateT DrasilState Identity CodeType
codeType Input
v
  let toGOOLVal Maybe CodeChunk
Nothing = UID -> Name -> VS (r TypeData) -> GenState (SValue r)
forall (r :: * -> *).
(NativeVector r, MathConstant r, VariableValue r,
 BooleanExpression r, Comparison r, NumericExpression r,
 ValueExpression r, Argument r, List r, Reference r, Set r,
 TypeElim r) =>
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 CodeChunk
_) = Name -> GenState (SValue r)
forall a. HasCallStack => Name -> a
error Name
"mkValProc: Procedural renderers do not support objects"
  toGOOLVal (v ^. 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
  t <- Input -> StateT DrasilState Identity CodeType
forall c. HasSpace c => c -> StateT DrasilState Identity CodeType
codeType Input
v
  let toGOOLVar Maybe CodeChunk
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 CodeChunk
_) = Name -> GenState (SVariable r)
forall a. HasCallStack => Name -> a
error Name
"mkVarProc: Procedural renderers do not support objects"
  toGOOLVar (v ^. obv)

-- | Converts a 'Mod' to GOOL.
genModDefProc
  ::
    ( NativeVector r
    , MathConstant r
    , BooleanExpression r
    , Comparison r
    , NumericExpression r
    , ValueExpression r
    , VariableValue r
    , DeclStatement r stmt bod
    , AssignStatement r stmt
    , ControlStatement r stmt bod
    , StringStatement r stmt
    , FileHandling r stmt
    , ReadFile r stmt
    , PrintFile r stmt
    , Argument r
    , Array r
    , List r
    , Reference r
    , OO.Set r
    , ProcProg r vis stmt mthd prg file mod bod block
    , TypeElim r
    )
  => Mod -> GenState (FS (r file))
genModDefProc :: forall (r :: * -> *) stmt bod vis mthd prg file mod block.
(NativeVector r, MathConstant r, BooleanExpression r, Comparison r,
 NumericExpression r, ValueExpression r, VariableValue r,
 DeclStatement r stmt bod, AssignStatement r stmt,
 ControlStatement r stmt bod, StringStatement r stmt,
 FileHandling r stmt, ReadFile r stmt, PrintFile r stmt, Argument r,
 Array r, List r, Reference r, Set r,
 ProcProg r vis stmt mthd prg file mod bod block, TypeElim 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 mthd)))]
-> GenState (FS (r file))
forall (r :: * -> *) vis stmt mthd prg file mod bod block.
ProcProg r vis stmt mthd prg file mod bod block =>
Name
-> Name
-> [Name]
-> [GenState (Maybe (MS (r mthd)))]
-> GenState (FS (r file))
genModuleWithImportsProc Name
n Name
desc [Name]
is
          ((Func -> GenState (Maybe (MS (r mthd))))
-> [Func] -> [GenState (Maybe (MS (r mthd)))]
forall a b. (a -> b) -> [a] -> [b]
map ((MS (r mthd) -> Maybe (MS (r mthd)))
-> StateT DrasilState Identity (MS (r mthd))
-> GenState (Maybe (MS (r mthd)))
forall a b.
(a -> b)
-> StateT DrasilState Identity a -> StateT DrasilState Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MS (r mthd) -> Maybe (MS (r mthd))
forall a. a -> Maybe a
Just (StateT DrasilState Identity (MS (r mthd))
 -> GenState (Maybe (MS (r mthd))))
-> (Func -> StateT DrasilState Identity (MS (r mthd)))
-> Func
-> GenState (Maybe (MS (r mthd)))
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 mthd)))
-> [StateVariable]
-> Func
-> StateT DrasilState Identity (MS (r mthd))
forall (r :: * -> *) block stmt bod vis mthd.
(BlockSym r block stmt, BodySym r bod block, NativeVector r,
 MathConstant r, BooleanExpression r, Comparison r,
 NumericExpression r, ValueExpression r, VariableValue r,
 MultiStatement r stmt, ValueStatement r stmt,
 DeclStatement r stmt bod, AssignStatement r stmt,
 ControlStatement r stmt bod, StringStatement r stmt,
 FileHandling r stmt, ReadFile r stmt, PrintFile r stmt, Argument r,
 Array r, List r, ListStatement r stmt, Reference r,
 MethodSym r vis mthd bod, Set r, TypeElim r, VariableElim r) =>
(Name
 -> VS (r TypeData)
 -> Name
 -> [ParameterChunk]
 -> Maybe Name
 -> [MS (r block)]
 -> GenState (MS (r mthd)))
-> [StateVariable] -> Func -> GenState (MS (r mthd))
genFuncProc Name
-> VS (r TypeData)
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MS (r block)]
-> StateT DrasilState Identity (MS (r mthd))
forall (r :: * -> *) stmt bod block vis mthd.
(Literal r, VariableValue r, MultiStatement r stmt,
 DeclStatement r stmt bod, FileHandling r stmt, PrintFile r stmt,
 BlockSym r block stmt, BodySym r bod block,
 MethodSym r vis mthd bod, VariableElim r) =>
Name
-> VS (r TypeData)
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MS (r block)]
-> GenState (MS (r mthd))
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
  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)
  return $ paramFunc (passBy p) 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
  ::
    ( OO.Literal r
    , VariableValue r
    , MultiStatement r stmt
    , DeclStatement r stmt bod
    , FileHandling r stmt
    , PrintFile r stmt
    , BlockSym r block stmt
    , BodySym r bod block
    , MethodSym r vis mthd bod
    , VariableElim r
    )
  => Label
  -> VS (r TypeData)
  -> Description
  -> [ParameterChunk]
  -> Maybe Description
  -> [MS (r block)]
  -> GenState (MS (r mthd))
publicFuncProc :: forall (r :: * -> *) stmt bod block vis mthd.
(Literal r, VariableValue r, MultiStatement r stmt,
 DeclStatement r stmt bod, FileHandling r stmt, PrintFile r stmt,
 BlockSym r block stmt, BodySym r bod block,
 MethodSym r vis mthd bod, VariableElim r) =>
Name
-> VS (r TypeData)
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MS (r block)]
-> GenState (MS (r mthd))
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 bod) -> MS (r mthd))
-> Name
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MS (r block)]
-> GenState (MS (r mthd))
forall (r :: * -> *) stmt bod block vis mthd.
(Literal r, VariableValue r, MultiStatement r stmt,
 DeclStatement r stmt bod, FileHandling r stmt, PrintFile r stmt,
 BlockSym r block stmt, BodySym r bod block,
 MethodSym r vis mthd bod, VariableElim r) =>
([MS (r ParamData)] -> MS (r bod) -> MS (r mthd))
-> Name
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MS (r block)]
-> GenState (MS (r mthd))
genMethodProc (Name
-> r vis
-> VS (r TypeData)
-> [MS (r ParamData)]
-> MS (r bod)
-> MS (r mthd)
forall (r :: * -> *) vis mthd bod.
MethodSym r vis mthd bod =>
Name
-> r vis
-> VS (r TypeData)
-> [MS (r ParamData)]
-> MS (r bod)
-> MS (r mthd)
function Name
n r vis
forall {k} (r :: k -> *) (vis :: k). 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
  ::
    ( OO.Literal r
    , VariableValue r
    , MultiStatement r stmt
    , DeclStatement r stmt bod
    , FileHandling r stmt
    , PrintFile r stmt
    , BlockSym r block stmt
    , BodySym r bod block
    , MethodSym r vis mthd bod
    , VariableElim r
    )
  => Label
  -> VS (r TypeData)
  -> Description
  -> [ParameterChunk]
  -> Maybe Description
  -> [MS (r block)]
  -> GenState (MS (r mthd))
privateFuncProc :: forall (r :: * -> *) stmt bod block vis mthd.
(Literal r, VariableValue r, MultiStatement r stmt,
 DeclStatement r stmt bod, FileHandling r stmt, PrintFile r stmt,
 BlockSym r block stmt, BodySym r bod block,
 MethodSym r vis mthd bod, VariableElim r) =>
Name
-> VS (r TypeData)
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MS (r block)]
-> GenState (MS (r mthd))
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 bod) -> MS (r mthd))
-> Name
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MS (r block)]
-> GenState (MS (r mthd))
forall (r :: * -> *) stmt bod block vis mthd.
(Literal r, VariableValue r, MultiStatement r stmt,
 DeclStatement r stmt bod, FileHandling r stmt, PrintFile r stmt,
 BlockSym r block stmt, BodySym r bod block,
 MethodSym r vis mthd bod, VariableElim r) =>
([MS (r ParamData)] -> MS (r bod) -> MS (r mthd))
-> Name
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MS (r block)]
-> GenState (MS (r mthd))
genMethodProc (Name
-> r vis
-> VS (r TypeData)
-> [MS (r ParamData)]
-> MS (r bod)
-> MS (r mthd)
forall (r :: * -> *) vis mthd bod.
MethodSym r vis mthd bod =>
Name
-> r vis
-> VS (r TypeData)
-> [MS (r ParamData)]
-> MS (r bod)
-> MS (r mthd)
function Name
n r vis
forall {k} (r :: k -> *) (vis :: k). 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
  ::
    ( OO.Literal r
    , VariableValue r
    , MultiStatement r stmt
    , DeclStatement r stmt bod
    , FileHandling r stmt
    , PrintFile r stmt
    , BlockSym r block stmt
    , BodySym r bod block
    , MethodSym r vis mthd bod
    , VariableElim r
    )
  => ([MS (r ParamData)] -> MS (r bod) -> MS (r mthd))
  -> Label
  -> Description
  -> [ParameterChunk]
  -> Maybe Description
  -> [MS (r block)]
  -> GenState (MS (r mthd))
genMethodProc :: forall (r :: * -> *) stmt bod block vis mthd.
(Literal r, VariableValue r, MultiStatement r stmt,
 DeclStatement r stmt bod, FileHandling r stmt, PrintFile r stmt,
 BlockSym r block stmt, BodySym r bod block,
 MethodSym r vis mthd bod, VariableElim r) =>
([MS (r ParamData)] -> MS (r bod) -> MS (r mthd))
-> Name
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MS (r block)]
-> GenState (MS (r mthd))
genMethodProc [MS (r ParamData)] -> MS (r bod) -> MS (r mthd)
f Name
n Name
desc [ParameterChunk]
p Maybe Name
r [MS (r block)]
b = do
  g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  vars <- mapM (mkVarProc . quantvar) p
  ps <- mapM mkParamProc p
  bod <- logBody n vars b
  let fn = [MS (r ParamData)] -> MS (r bod) -> MS (r mthd)
f [MS (r ParamData)]
ps MS (r bod)
bod
  pComms <- mapM getCommentBrief p
  return $ if CommentFunc `elem` (g ^. commented)
    then docFunc desc pComms r fn else 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
  ::
    ( BlockSym r block stmt
    , BodySym r bod block
    , NativeVector r
    , MathConstant r
    , BooleanExpression r
    , Comparison r
    , NumericExpression r
    , ValueExpression r
    , VariableValue r
    , MultiStatement r stmt
    , ValueStatement r stmt
    , DeclStatement r stmt bod
    , AssignStatement r stmt
    , ControlStatement r stmt bod
    , StringStatement r stmt
    , FileHandling r stmt
    , ReadFile r stmt
    , PrintFile r stmt
    , Argument r
    , Array r
    , List r
    , ListStatement r stmt
    , Reference r
    , MethodSym r vis mthd bod
    , OO.Set r
    , TypeElim r
    , VariableElim r
    )
  => (Name -> VS (r TypeData) -> Description -> [ParameterChunk] -> Maybe Description -> [MS (r block)] -> GenState (MS (r mthd)))
  -> [StateVariable]
  -> Func
  -> GenState (MS (r mthd))
genFuncProc :: forall (r :: * -> *) block stmt bod vis mthd.
(BlockSym r block stmt, BodySym r bod block, NativeVector r,
 MathConstant r, BooleanExpression r, Comparison r,
 NumericExpression r, ValueExpression r, VariableValue r,
 MultiStatement r stmt, ValueStatement r stmt,
 DeclStatement r stmt bod, AssignStatement r stmt,
 ControlStatement r stmt bod, StringStatement r stmt,
 FileHandling r stmt, ReadFile r stmt, PrintFile r stmt, Argument r,
 Array r, List r, ListStatement r stmt, Reference r,
 MethodSym r vis mthd bod, Set r, TypeElim r, VariableElim r) =>
(Name
 -> VS (r TypeData)
 -> Name
 -> [ParameterChunk]
 -> Maybe Name
 -> [MS (r block)]
 -> GenState (MS (r mthd)))
-> [StateVariable] -> Func -> GenState (MS (r mthd))
genFuncProc Name
-> VS (r TypeData)
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MS (r block)]
-> GenState (MS (r mthd))
f [StateVariable]
svs (FDef (FuncDef Name
n Name
desc [ParameterChunk]
parms Space
o Maybe Name
rd [FuncStmt]
s)) = do
  g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  modify (\DrasilState
st -> DrasilState
st {currentScope = Local})
  stmts <- mapM convStmtProc s
  vars <- mapM mkVarProc (fstdecl (g ^. systemdb) s
    \\ (map quantvar parms ++ map stVar svs))
  t <- spaceCodeType o
  f n (convType t) desc parms rd [block $ map (`varDec` local) vars, block stmts]
genFuncProc Name
-> VS (r TypeData)
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MS (r block)]
-> GenState (MS (r mthd))
_ [StateVariable]
_ (FDef (CtorDef {})) = Name -> GenState (MS (r mthd))
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 mthd))
_ [StateVariable]
_ (FData (FuncData Name
n Name
desc DataDesc
ddef)) = Name -> Name -> DataDesc -> GenState (MS (r mthd))
forall (r :: * -> *) block stmt bod vis mthd.
(BlockSym r block stmt, BodySym r bod block, NativeVector r,
 MathConstant r, BooleanExpression r, Comparison r,
 NumericExpression r, ValueExpression r, VariableValue r,
 DeclStatement r stmt bod, ControlStatement r stmt bod,
 StringStatement r stmt, FileHandling r stmt, ReadFile r stmt,
 PrintFile r stmt, Argument r, List r, ListStatement r stmt,
 Reference r, Set r, MultiStatement r stmt,
 MethodSym r vis mthd bod, TypeElim r, VariableElim r) =>
Name -> Name -> DataDesc -> GenState (MS (r mthd))
genDataFuncProc Name
n Name
desc DataDesc
ddef

-- | Converts a 'Mod'\'s functions to GOOL.
genModFuncsProc
  ::
    ( BlockSym r block stmt
    , BodySym r bod block
    , NativeVector r
    , MathConstant r
    , BooleanExpression r
    , Comparison r
    , NumericExpression r
    , ValueExpression r
    , VariableValue r
    , MultiStatement r stmt
    , ValueStatement r stmt
    , DeclStatement r stmt bod
    , AssignStatement r stmt
    , ControlStatement r stmt bod
    , StringStatement r stmt
    , FileHandling r stmt
    , ReadFile r stmt
    , PrintFile r stmt
    , Argument r
    , Array r
    , List r
    , ListStatement r stmt
    , Reference r
    , MethodSym r vis mthd bod
    , OO.Set r
    , TypeElim r
    , VariableElim r
    )
  => Mod -> [GenState (MS (r mthd))]
genModFuncsProc :: forall (r :: * -> *) block stmt bod vis mthd.
(BlockSym r block stmt, BodySym r bod block, NativeVector r,
 MathConstant r, BooleanExpression r, Comparison r,
 NumericExpression r, ValueExpression r, VariableValue r,
 MultiStatement r stmt, ValueStatement r stmt,
 DeclStatement r stmt bod, AssignStatement r stmt,
 ControlStatement r stmt bod, StringStatement r stmt,
 FileHandling r stmt, ReadFile r stmt, PrintFile r stmt, Argument r,
 Array r, List r, ListStatement r stmt, Reference r,
 MethodSym r vis mthd bod, Set r, TypeElim r, VariableElim r) =>
Mod -> [GenState (MS (r mthd))]
genModFuncsProc (Mod Name
_ Name
_ [Name]
_ [Class]
_ [Func]
fs) = (Func -> GenState (MS (r mthd)))
-> [Func] -> [GenState (MS (r mthd))]
forall a b. (a -> b) -> [a] -> [b]
map ((Name
 -> VS (r TypeData)
 -> Name
 -> [ParameterChunk]
 -> Maybe Name
 -> [MS (r block)]
 -> GenState (MS (r mthd)))
-> [StateVariable] -> Func -> GenState (MS (r mthd))
forall (r :: * -> *) block stmt bod vis mthd.
(BlockSym r block stmt, BodySym r bod block, NativeVector r,
 MathConstant r, BooleanExpression r, Comparison r,
 NumericExpression r, ValueExpression r, VariableValue r,
 MultiStatement r stmt, ValueStatement r stmt,
 DeclStatement r stmt bod, AssignStatement r stmt,
 ControlStatement r stmt bod, StringStatement r stmt,
 FileHandling r stmt, ReadFile r stmt, PrintFile r stmt, Argument r,
 Array r, List r, ListStatement r stmt, Reference r,
 MethodSym r vis mthd bod, Set r, TypeElim r, VariableElim r) =>
(Name
 -> VS (r TypeData)
 -> Name
 -> [ParameterChunk]
 -> Maybe Name
 -> [MS (r block)]
 -> GenState (MS (r mthd)))
-> [StateVariable] -> Func -> GenState (MS (r mthd))
genFuncProc Name
-> VS (r TypeData)
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MS (r block)]
-> GenState (MS (r mthd))
forall (r :: * -> *) stmt bod block vis mthd.
(Literal r, VariableValue r, MultiStatement r stmt,
 DeclStatement r stmt bod, FileHandling r stmt, PrintFile r stmt,
 BlockSym r block stmt, BodySym r bod block,
 MethodSym r vis mthd bod, VariableElim r) =>
Name
-> VS (r TypeData)
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MS (r block)]
-> GenState (MS (r mthd))
publicFuncProc []) [Func]
fs

-- this is really ugly!!
-- | Read from a data description into an 'MS block' of 'MS Statement's.
readDataProc
  ::
    ( BlockSym r block stmt
    , BodySym r bod block
    , NativeVector r
    , MathConstant r
    , BooleanExpression r
    , Comparison r
    , NumericExpression r
    , ValueExpression r
    , VariableValue r
    , DeclStatement r stmt bod
    , ControlStatement r stmt bod
    , StringStatement r stmt
    , FileHandling r stmt
    , ReadFile r stmt
    , Argument r
    , List r
    , ListStatement r stmt
    , Reference r
    , OO.Set r
    , TypeElim r
    )
  => DataDesc -> GenState [MS (r block)]
readDataProc :: forall (r :: * -> *) block stmt bod.
(BlockSym r block stmt, BodySym r bod block, NativeVector r,
 MathConstant r, BooleanExpression r, Comparison r,
 NumericExpression r, ValueExpression r, VariableValue r,
 DeclStatement r stmt bod, ControlStatement r stmt bod,
 StringStatement r stmt, FileHandling r stmt, ReadFile r stmt,
 Argument r, List r, ListStatement r stmt, Reference r, Set r,
 TypeElim r) =>
DataDesc -> GenState [MS (r block)]
readDataProc DataDesc
ddef = do
  g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  let 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
  inD <- mapM (`inData` localScope) ddef
  v_filename <- mkValProc (quantvar inFileName)
  return [block $
    varDec var_infile localScope :
    (if any (\Data
d -> Data -> Bool
isLine Data
d Bool -> Bool -> Bool
|| Data -> Bool
isLines Data
d) ddef then [varDec var_line localScope,
    listDec 0 var_linetokens localScope] else []) ++
    [listDec 0 var_lines localScope | any isLines ddef] ++ openFileR var_infile
    v_filename : concat inD ++ [closeFile v_infile]]
  where inData
          ::
            ( BlockSym r block stmt
            , BodySym r bod block
            , VariableValue r
            , NativeVector r
            , List r
            , ListStatement r stmt
            , DeclStatement r stmt bod
            , ControlStatement r stmt bod
            , StringStatement r stmt
            , ReadFile r stmt
            )
          => Data -> r ScopeData -> GenState [MS (r stmt)]
        inData :: forall (r :: * -> *) block stmt bod.
(BlockSym r block stmt, BodySym r bod block, VariableValue r,
 NativeVector r, List r, ListStatement r stmt,
 DeclStatement r stmt bod, ControlStatement r stmt bod,
 StringStatement r stmt, ReadFile r stmt) =>
Data -> r ScopeData -> GenState [MS (r stmt)]
inData (Singleton Input
v) r ScopeData
_ = do
            vv <- Input -> GenState (SVariable r)
forall (r :: * -> *).
VariableSym r =>
Input -> GenState (SVariable r)
mkVarProc Input
v
            return [getFileInput v_infile vv]
        inData Data
JunkData r ScopeData
_ = [MS (r stmt)] -> StateT DrasilState Identity [MS (r stmt)]
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return [SValue r -> MS (r stmt)
forall (r :: * -> *) stmt.
ReadFile r stmt =>
SValue r -> MS (r stmt)
discardFileLine SValue r
forall (r :: * -> *). VariableValue r => SValue r
v_infile]
        inData (Line LinePattern
lp Char
d) r ScopeData
scp = do
          lnI <- Maybe Name
-> LinePattern
-> r ScopeData
-> StateT DrasilState Identity [MS (r stmt)]
forall (r :: * -> *) stmt bod.
(VariableValue r, NativeVector r, ListStatement r stmt,
 DeclStatement r stmt bod, StringStatement r stmt) =>
Maybe Name -> LinePattern -> r ScopeData -> GenState [MS (r stmt)]
lineData Maybe Name
forall a. Maybe a
Nothing LinePattern
lp r ScopeData
scp
          return $ [getFileInputLine v_infile var_line,
            stringSplit d var_linetokens v_line] ++ lnI
        inData (Lines LinePattern
lp Maybe Integer
ls Char
d) r ScopeData
scp = do
          lnV <- Maybe Name
-> LinePattern
-> r ScopeData
-> StateT DrasilState Identity [MS (r stmt)]
forall (r :: * -> *) stmt bod.
(VariableValue r, NativeVector r, ListStatement r stmt,
 DeclStatement r stmt bod, StringStatement r stmt) =>
Maybe Name -> LinePattern -> r ScopeData -> GenState [MS (r stmt)]
lineData (Name -> Maybe Name
forall a. a -> Maybe a
Just Name
"_temp") LinePattern
lp r ScopeData
scp
          let readLines Maybe Integer
Nothing = [SValue r -> SVariable r -> MS (r stmt)
forall (r :: * -> *) stmt.
ReadFile r stmt =>
SValue r -> SVariable r -> MS (r stmt)
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 bod) -> MS (r stmt)
forall (r :: * -> *) stmt bod.
ControlStatement r stmt bod =>
SVariable r
-> SValue r -> SValue r -> SValue r -> MS (r bod) -> MS (r stmt)
forRange SVariable r
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 :: * -> *). List r => 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 stmt)] -> MS (r bod)
forall {k} (r :: k -> *) (block :: k) (stmt :: k) (bod :: k).
(BlockSym r block stmt, BodySym r bod block) =>
[MS (r stmt)] -> MS (r bod)
bodyStatements ([MS (r stmt)] -> MS (r bod)) -> [MS (r stmt)] -> MS (r bod)
forall a b. (a -> b) -> a -> b
$ Char -> SVariable r -> SValue r -> MS (r stmt)
forall (r :: * -> *) stmt.
StringStatement r stmt =>
Char -> SVariable r -> SValue r -> MS (r stmt)
stringSplit Char
d SVariable r
forall (r :: * -> *). VariableSym r => SVariable r
var_linetokens (
                  SValue r -> SValue r -> SValue r
forall (r :: * -> *). List r => 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 stmt) -> [MS (r stmt)] -> [MS (r stmt)]
forall a. a -> [a] -> [a]
: [MS (r stmt)]
lnV)]
              readLines (Just Integer
numLines) = [SVariable r
-> SValue r -> SValue r -> SValue r -> MS (r bod) -> MS (r stmt)
forall (r :: * -> *) stmt bod.
ControlStatement r stmt bod =>
SVariable r
-> SValue r -> SValue r -> SValue r -> MS (r bod) -> MS (r stmt)
forRange SVariable r
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 stmt)] -> MS (r bod)
forall {k} (r :: k -> *) (block :: k) (stmt :: k) (bod :: k).
(BlockSym r block stmt, BodySym r bod block) =>
[MS (r stmt)] -> MS (r bod)
bodyStatements ([MS (r stmt)] -> MS (r bod)) -> [MS (r stmt)] -> MS (r bod)
forall a b. (a -> b) -> a -> b
$
                  [SValue r -> SVariable r -> MS (r stmt)
forall (r :: * -> *) stmt.
ReadFile r stmt =>
SValue r -> SVariable r -> MS (r stmt)
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 stmt)
forall (r :: * -> *) stmt.
StringStatement r stmt =>
Char -> SVariable r -> SValue r -> MS (r stmt)
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 stmt)] -> [MS (r stmt)] -> [MS (r stmt)]
forall a. [a] -> [a] -> [a]
++ [MS (r stmt)]
lnV)]
          return $ readLines ls
        ---------------
        lineData
          ::
            ( VariableValue r
            , NativeVector r
            , ListStatement r stmt
            , DeclStatement r stmt bod
            , StringStatement r stmt
            )
          => Maybe String -> LinePattern -> r ScopeData -> GenState [MS (r stmt)]
        lineData :: forall (r :: * -> *) stmt bod.
(VariableValue r, NativeVector r, ListStatement r stmt,
 DeclStatement r stmt bod, StringStatement r stmt) =>
Maybe Name -> LinePattern -> r ScopeData -> GenState [MS (r stmt)]
lineData Maybe Name
s p :: LinePattern
p@(Straight [Input]
_) r ScopeData
_ = do
          vs <- Maybe Name -> LinePattern -> GenState [SVariable r]
forall (r :: * -> *).
VariableSym r =>
Maybe Name -> LinePattern -> GenState [SVariable r]
getEntryVarsProc Maybe Name
s LinePattern
p
          return [stringListVals vs v_linetokens]
        lineData Maybe Name
s p :: LinePattern
p@(Repeat [Input]
ds) r ScopeData
scp = do
          vs <- Maybe Name -> LinePattern -> GenState [SVariable r]
forall (r :: * -> *).
VariableSym r =>
Maybe Name -> LinePattern -> GenState [SVariable r]
getEntryVarsProc Maybe Name
s LinePattern
p
          sequence $ clearTemps s ds scp ++ return
            (stringListLists vs v_linetokens) : appendTemps s ds
        ---------------
        clearTemps
          :: (DeclStatement r stmt bod)
          => Maybe String -> [DataItem] -> r ScopeData -> [GenState (MS (r stmt))]
        clearTemps :: forall (r :: * -> *) stmt bod.
DeclStatement r stmt bod =>
Maybe Name -> [Input] -> r ScopeData -> [GenState (MS (r stmt))]
clearTemps Maybe Name
Nothing    [Input]
_  r ScopeData
_   = []
        clearTemps (Just Name
sfx) [Input]
es r ScopeData
scp = (Input -> GenState (MS (r stmt)))
-> [Input] -> [GenState (MS (r stmt))]
forall a b. (a -> b) -> [a] -> [b]
map (\Input
v -> Name -> Input -> r ScopeData -> GenState (MS (r stmt))
forall (r :: * -> *) stmt bod.
DeclStatement r stmt bod =>
Name -> Input -> r ScopeData -> GenState (MS (r stmt))
clearTemp Name
sfx Input
v r ScopeData
scp) [Input]
es
        ---------------
        clearTemp
          :: (DeclStatement r stmt bod)
          => String -> DataItem -> r ScopeData -> GenState (MS (r stmt))
        clearTemp :: forall (r :: * -> *) stmt bod.
DeclStatement r stmt bod =>
Name -> Input -> r ScopeData -> GenState (MS (r stmt))
clearTemp Name
sfx Input
v r ScopeData
scp = (CodeType -> MS (r stmt))
-> StateT DrasilState Identity CodeType
-> StateT DrasilState Identity (MS (r stmt))
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 stmt)
forall (r :: * -> *) stmt bod.
DeclStatement r stmt bod =>
SVariable r -> r ScopeData -> [SValue r] -> MS (r stmt)
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
          :: (ListStatement r stmt, VariableValue r)
          => Maybe String -> [DataItem] -> [GenState (MS (r stmt))]
        appendTemps :: forall (r :: * -> *) stmt.
(ListStatement r stmt, VariableValue r) =>
Maybe Name -> [Input] -> [GenState (MS (r stmt))]
appendTemps Maybe Name
Nothing [Input]
_ = []
        appendTemps (Just Name
sfx) [Input]
es = (Input -> GenState (MS (r stmt)))
-> [Input] -> [GenState (MS (r stmt))]
forall a b. (a -> b) -> [a] -> [b]
map (Name -> Input -> GenState (MS (r stmt))
forall (r :: * -> *) stmt.
(ListStatement r stmt, VariableValue r) =>
Name -> Input -> GenState (MS (r stmt))
appendTemp Name
sfx) [Input]
es
        ---------------
        appendTemp
          :: (ListStatement r stmt, VariableValue r)
          => String -> DataItem -> GenState (MS (r stmt))
        appendTemp :: forall (r :: * -> *) stmt.
(ListStatement r stmt, VariableValue r) =>
Name -> Input -> GenState (MS (r stmt))
appendTemp Name
sfx Input
v = (CodeType -> MS (r stmt))
-> StateT DrasilState Identity CodeType
-> StateT DrasilState Identity (MS (r stmt))
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 stmt)
forall (r :: * -> *) stmt.
ListStatement r stmt =>
SValue r -> SValue r -> MS (r stmt)
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
  ::
    ( MathConstant r
    , VariableValue r
    , BooleanExpression r
    , Comparison r
    , NumericExpression r
    , ValueExpression r
    , Argument r
    , NativeVector r
    , Reference r
    , OO.Set r
    , List r
    , TypeElim r
    )
  => CodeExpr -> GenState (SValue r)
convExprProc :: forall (r :: * -> *).
(MathConstant r, VariableValue r, BooleanExpression r,
 Comparison r, NumericExpression r, ValueExpression r, Argument r,
 NativeVector r, Reference r, Set r, List r, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc (Lit (Dbl Double
d)) = do
  sm <- Space -> StateT DrasilState Identity CodeType
spaceCodeType Space
Real
  let 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"
  return $ getLiteral sm
convExprProc (Lit (ExactDbl Integer
d)) = CodeExpr -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *).
(MathConstant r, VariableValue r, BooleanExpression r,
 Comparison r, NumericExpression r, ValueExpression r, Argument r,
 NativeVector r, Reference r, Set r, List r, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc (CodeExpr -> StateT DrasilState Identity (SValue r))
-> CodeExpr -> StateT DrasilState Identity (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 -> StateT DrasilState Identity (SValue r)
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (SValue r -> StateT DrasilState Identity (SValue r))
-> SValue r -> StateT DrasilState Identity (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 -> StateT DrasilState Identity (SValue r)
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (SValue r -> StateT DrasilState Identity (SValue r))
-> SValue r -> StateT DrasilState Identity (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
  sm <- Space -> StateT DrasilState Identity CodeType
spaceCodeType Space
Rational
  let 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"
  return $ getLiteral sm (fromIntegral a / (10 ** fromIntegral 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]
-> StateT DrasilState Identity (SValue r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (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 :: * -> *).
(MathConstant r, VariableValue r, BooleanExpression r,
 Comparison r, NumericExpression r, ValueExpression r, Argument r,
 NativeVector r, Reference r, Set r, List r, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc [CodeExpr]
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]
-> StateT DrasilState Identity (SValue r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (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 :: * -> *).
(MathConstant r, VariableValue r, BooleanExpression r,
 Comparison r, NumericExpression r, ValueExpression r, Argument r,
 NativeVector r, Reference r, Set r, List r, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc [CodeExpr]
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]
-> StateT DrasilState Identity (SValue r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (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 :: * -> *).
(MathConstant r, VariableValue r, BooleanExpression r,
 Comparison r, NumericExpression r, ValueExpression r, Argument r,
 NativeVector r, Reference r, Set r, List r, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc [CodeExpr]
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]
-> StateT DrasilState Identity (SValue r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (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 :: * -> *).
(MathConstant r, VariableValue r, BooleanExpression r,
 Comparison r, NumericExpression r, ValueExpression r, Argument r,
 NativeVector r, Reference r, Set r, List r, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc [CodeExpr]
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]
-> StateT DrasilState Identity (SValue r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (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 :: * -> *).
(MathConstant r, VariableValue r, BooleanExpression r,
 Comparison r, NumericExpression r, ValueExpression r, Argument r,
 NativeVector r, Reference r, Set r, List r, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc [CodeExpr]
l
convExprProc (C UID
c) = do
  g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  let v = DefinedQuantityDict -> Input
forall c. (Quantity c, MayHaveUnit c, Concept c) => c -> Input
quantvar (DrasilState -> UID -> DefinedQuantityDict
lookupC DrasilState
g UID
c)
  mkValProc v
convExprProc (FCall UID
c [CodeExpr]
x [(UID, CodeExpr)]
ns) = UID
-> [CodeExpr]
-> [(UID, CodeExpr)]
-> (Name
    -> Name
    -> VS (r TypeData)
    -> [SValue r]
    -> NamedArgs r
    -> StateT DrasilState Identity (SValue r))
-> (Name
    -> Name
    -> VS (r TypeData)
    -> [SValue r]
    -> NamedArgs r
    -> SValue r)
-> StateT DrasilState Identity (SValue r)
forall (r :: * -> *).
(MathConstant r, VariableValue r, BooleanExpression r,
 Comparison r, NumericExpression r, ValueExpression r, Argument r,
 List r, NativeVector r, Reference r, Set r, 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
-> StateT DrasilState Identity (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 -> StateT DrasilState Identity (SValue r)
forall a. HasCallStack => Name -> a
error Name
"convExprProc: Procedural renderers do not support object creation"
convExprProc (Message {}) = Name -> StateT DrasilState Identity (SValue r)
forall a. HasCallStack => Name -> a
error Name
"convExprProc: Procedural renderers do not support methods"
convExprProc (Field UID
_ UID
_) = Name -> StateT DrasilState Identity (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)
-> StateT DrasilState Identity (SValue r)
-> StateT DrasilState Identity (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 -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *).
(MathConstant r, VariableValue r, BooleanExpression r,
 Comparison r, NumericExpression r, ValueExpression r, Argument r,
 NativeVector r, Reference r, Set r, List r, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
u)
convExprProc (UnaryOpB UFuncB
o CodeExpr
u)   = (SValue r -> SValue r)
-> StateT DrasilState Identity (SValue r)
-> StateT DrasilState Identity (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 -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *).
(MathConstant r, VariableValue r, BooleanExpression r,
 Comparison r, NumericExpression r, ValueExpression r, Argument r,
 NativeVector r, Reference r, Set r, List r, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
u)
convExprProc (UnaryOpVV UFuncVV
NegV CodeExpr
u) = (SValue r -> SValue r)
-> StateT DrasilState Identity (SValue r)
-> StateT DrasilState Identity (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 -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *).
(MathConstant r, VariableValue r, BooleanExpression r,
 Comparison r, NumericExpression r, ValueExpression r, Argument r,
 NativeVector r, Reference r, Set r, List r, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
u)
convExprProc (UnaryOpVN UFuncVN
Dim CodeExpr
u)  = (SValue r -> SValue r)
-> StateT DrasilState Identity (SValue r)
-> StateT DrasilState Identity (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 :: * -> *). List r => SValue r -> SValue r
listSize (CodeExpr -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *).
(MathConstant r, VariableValue r, BooleanExpression r,
 Comparison r, NumericExpression r, ValueExpression r, Argument r,
 NativeVector r, Reference r, Set r, List r, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
u)
convExprProc (UnaryOpVN UFuncVN
Norm CodeExpr
u) = (SValue r -> SValue r)
-> StateT DrasilState Identity (SValue r)
-> StateT DrasilState Identity (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 -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *).
(MathConstant r, VariableValue r, BooleanExpression r,
 Comparison r, NumericExpression r, ValueExpression r, Argument r,
 NativeVector r, Reference r, Set r, List r, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
u)
convExprProc (ArithBinaryOp ArithBinOp
Frac (Lit (Int Integer
a)) (Lit (Int Integer
b))) = do -- hack to deal with integer division
  sm <- Space -> StateT DrasilState Identity CodeType
spaceCodeType Space
Rational
  let 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"
  return $ getLiteral sm
convExprProc (ArithBinaryOp ArithBinOp
o CodeExpr
a CodeExpr
b) = (SValue r -> SValue r -> SValue r)
-> StateT DrasilState Identity (SValue r)
-> StateT DrasilState Identity (SValue r)
-> StateT DrasilState Identity (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 -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *).
(MathConstant r, VariableValue r, BooleanExpression r,
 Comparison r, NumericExpression r, ValueExpression r, Argument r,
 NativeVector r, Reference r, Set r, List r, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
a) (CodeExpr -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *).
(MathConstant r, VariableValue r, BooleanExpression r,
 Comparison r, NumericExpression r, ValueExpression r, Argument r,
 NativeVector r, Reference r, Set r, List r, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
b)
convExprProc (LABinaryOp LABinOp
o CodeExpr
a CodeExpr
b)    = (SValue r -> SValue r -> SValue r)
-> StateT DrasilState Identity (SValue r)
-> StateT DrasilState Identity (SValue r)
-> StateT DrasilState Identity (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 :: * -> *).
List r =>
LABinOp -> SValue r -> SValue r -> SValue r
laBfunc LABinOp
o) (CodeExpr -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *).
(MathConstant r, VariableValue r, BooleanExpression r,
 Comparison r, NumericExpression r, ValueExpression r, Argument r,
 NativeVector r, Reference r, Set r, List r, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
a) (CodeExpr -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *).
(MathConstant r, VariableValue r, BooleanExpression r,
 Comparison r, NumericExpression r, ValueExpression r, Argument r,
 NativeVector r, Reference r, Set r, List r, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
b)
convExprProc (EqBinaryOp EqBinOp
o CodeExpr
a CodeExpr
b)    = (SValue r -> SValue r -> SValue r)
-> StateT DrasilState Identity (SValue r)
-> StateT DrasilState Identity (SValue r)
-> StateT DrasilState Identity (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 -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *).
(MathConstant r, VariableValue r, BooleanExpression r,
 Comparison r, NumericExpression r, ValueExpression r, Argument r,
 NativeVector r, Reference r, Set r, List r, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
a) (CodeExpr -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *).
(MathConstant r, VariableValue r, BooleanExpression r,
 Comparison r, NumericExpression r, ValueExpression r, Argument r,
 NativeVector r, Reference r, Set r, List r, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
b)
convExprProc (OrdBinaryOp OrdBinOp
o CodeExpr
a CodeExpr
b)   = (SValue r -> SValue r -> SValue r)
-> StateT DrasilState Identity (SValue r)
-> StateT DrasilState Identity (SValue r)
-> StateT DrasilState Identity (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 -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *).
(MathConstant r, VariableValue r, BooleanExpression r,
 Comparison r, NumericExpression r, ValueExpression r, Argument r,
 NativeVector r, Reference r, Set r, List r, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
a) (CodeExpr -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *).
(MathConstant r, VariableValue r, BooleanExpression r,
 Comparison r, NumericExpression r, ValueExpression r, Argument r,
 NativeVector r, Reference r, Set r, List r, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
b)
convExprProc (VVVBinaryOp VVVBinOp
VAdd CodeExpr
a CodeExpr
b)  = (SValue r -> SValue r -> SValue r)
-> StateT DrasilState Identity (SValue r)
-> StateT DrasilState Identity (SValue r)
-> StateT DrasilState Identity (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 -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *).
(MathConstant r, VariableValue r, BooleanExpression r,
 Comparison r, NumericExpression r, ValueExpression r, Argument r,
 NativeVector r, Reference r, Set r, List r, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
a) (CodeExpr -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *).
(MathConstant r, VariableValue r, BooleanExpression r,
 Comparison r, NumericExpression r, ValueExpression r, Argument r,
 NativeVector r, Reference r, Set r, List r, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
b)
convExprProc (VVVBinaryOp VVVBinOp
VSub CodeExpr
a CodeExpr
b) = (SValue r -> SValue r -> SValue r)
-> StateT DrasilState Identity (SValue r)
-> StateT DrasilState Identity (SValue r)
-> StateT DrasilState Identity (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 -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *).
(MathConstant r, VariableValue r, BooleanExpression r,
 Comparison r, NumericExpression r, ValueExpression r, Argument r,
 NativeVector r, Reference r, Set r, List r, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
a) (CodeExpr -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *).
(MathConstant r, VariableValue r, BooleanExpression r,
 Comparison r, NumericExpression r, ValueExpression r, Argument r,
 NativeVector r, Reference r, Set r, List r, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
b)
convExprProc (VVVBinaryOp VVVBinOp
Cross CodeExpr
_ CodeExpr
_) = Name -> StateT DrasilState Identity (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)
-> StateT DrasilState Identity (SValue r)
-> StateT DrasilState Identity (SValue r)
-> StateT DrasilState Identity (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 -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *).
(MathConstant r, VariableValue r, BooleanExpression r,
 Comparison r, NumericExpression r, ValueExpression r, Argument r,
 NativeVector r, Reference r, Set r, List r, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
a) (CodeExpr -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *).
(MathConstant r, VariableValue r, BooleanExpression r,
 Comparison r, NumericExpression r, ValueExpression r, Argument r,
 NativeVector r, Reference r, Set r, List r, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
b)
convExprProc (NVVBinaryOp NVVBinOp
Scale CodeExpr
a CodeExpr
b) = (SValue r -> SValue r -> SValue r)
-> StateT DrasilState Identity (SValue r)
-> StateT DrasilState Identity (SValue r)
-> StateT DrasilState Identity (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 -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *).
(MathConstant r, VariableValue r, BooleanExpression r,
 Comparison r, NumericExpression r, ValueExpression r, Argument r,
 NativeVector r, Reference r, Set r, List r, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
a) (CodeExpr -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *).
(MathConstant r, VariableValue r, BooleanExpression r,
 Comparison r, NumericExpression r, ValueExpression r, Argument r,
 NativeVector r, Reference r, Set r, List r, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
b)
convExprProc (ESSBinaryOp ESSBinOp
o CodeExpr
a CodeExpr
b)   = (SValue r -> SValue r -> SValue r)
-> StateT DrasilState Identity (SValue r)
-> StateT DrasilState Identity (SValue r)
-> StateT DrasilState Identity (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 -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *).
(MathConstant r, VariableValue r, BooleanExpression r,
 Comparison r, NumericExpression r, ValueExpression r, Argument r,
 NativeVector r, Reference r, Set r, List r, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
a) (CodeExpr -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *).
(MathConstant r, VariableValue r, BooleanExpression r,
 Comparison r, NumericExpression r, ValueExpression r, Argument r,
 NativeVector r, Reference r, Set r, List r, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
b)
convExprProc (ESBBinaryOp ESBBinOp
o CodeExpr
a CodeExpr
b)   = (SValue r -> SValue r -> SValue r)
-> StateT DrasilState Identity (SValue r)
-> StateT DrasilState Identity (SValue r)
-> StateT DrasilState Identity (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 -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *).
(MathConstant r, VariableValue r, BooleanExpression r,
 Comparison r, NumericExpression r, ValueExpression r, Argument r,
 NativeVector r, Reference r, Set r, List r, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
a) (CodeExpr -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *).
(MathConstant r, VariableValue r, BooleanExpression r,
 Comparison r, NumericExpression r, ValueExpression r, Argument r,
 NativeVector r, Reference r, Set r, List r, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
b)
convExprProc (Case Completeness
c [(CodeExpr, CodeExpr)]
l)            = [(CodeExpr, CodeExpr)] -> StateT DrasilState Identity (SValue r)
doit [(CodeExpr, CodeExpr)]
l -- FIXME this is sub-optimal
  where
    doit :: [(CodeExpr, CodeExpr)] -> StateT DrasilState Identity (SValue r)
doit [] = Name -> StateT DrasilState Identity (SValue r)
forall a. HasCallStack => Name -> a
error Name
"should never happen" -- TODO: change error message?
    doit [(CodeExpr
e,CodeExpr
_)] = CodeExpr -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *).
(MathConstant r, VariableValue r, BooleanExpression r,
 Comparison r, NumericExpression r, ValueExpression r, Argument r,
 NativeVector r, Reference r, Set r, List r, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
e -- should always be the else clause
    doit ((CodeExpr
e,CodeExpr
cond):[(CodeExpr, CodeExpr)]
xs) = (SValue r -> SValue r -> SValue r -> SValue r)
-> StateT DrasilState Identity (SValue r)
-> StateT DrasilState Identity (SValue r)
-> StateT DrasilState Identity (SValue r)
-> StateT DrasilState Identity (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 -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *).
(MathConstant r, VariableValue r, BooleanExpression r,
 Comparison r, NumericExpression r, ValueExpression r, Argument r,
 NativeVector r, Reference r, Set r, List r, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
cond) (CodeExpr -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *).
(MathConstant r, VariableValue r, BooleanExpression r,
 Comparison r, NumericExpression r, ValueExpression r, Argument r,
 NativeVector r, Reference r, Set r, List r, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
e)
      (CodeExpr -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *).
(MathConstant r, VariableValue r, BooleanExpression r,
 Comparison r, NumericExpression r, ValueExpression r, Argument r,
 NativeVector r, Reference r, Set r, List r, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc (Completeness -> [(CodeExpr, CodeExpr)] -> CodeExpr
Case Completeness
c [(CodeExpr, CodeExpr)]
xs))
convExprProc (Matrix [[CodeExpr]
l]) = do
  ar <- (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 :: * -> *).
(MathConstant r, VariableValue r, BooleanExpression r,
 Comparison r, NumericExpression r, ValueExpression r, Argument r,
 NativeVector r, Reference r, Set r, List r, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc [CodeExpr]
l
                                    -- hd will never fail here
  return $ litArray (fmap valueType (head ar)) ar
convExprProc Matrix{} = Name -> StateT DrasilState Identity (SValue r)
forall a. HasCallStack => Name -> a
error Name
"convExprProc: Matrix"
convExprProc (S.Set Space
s [CodeExpr]
l) = do
  ar <- (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 :: * -> *).
(MathConstant r, VariableValue r, BooleanExpression r,
 Comparison r, NumericExpression r, ValueExpression r, Argument r,
 NativeVector r, Reference r, Set r, List r, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc [CodeExpr]
l
  sm <- spaceCodeType s
  return $ litSet (convType sm) ar
convExprProc (Variable Name
s (S.Set Space
l [CodeExpr]
_)) = do
  sm <- Space -> StateT DrasilState Identity CodeType
spaceCodeType Space
l
  let 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)
  return $ valueOf varSet
convExprProc (Variable Name
_ CodeExpr
_) = Name -> StateT DrasilState Identity (SValue r)
forall a. HasCallStack => Name -> a
error Name
"convExpr: Variable"
convExprProc Operator{} = Name -> StateT DrasilState Identity (SValue r)
forall a. HasCallStack => Name -> a
error Name
"convExprProc: Operator"
convExprProc (RealI UID
c RealInterval CodeExpr CodeExpr
ri)  = do
  g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  convExprProc $ renderRealInt (lookupC g c) 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
  ::
    ( MathConstant r
    , VariableValue r
    , BooleanExpression r
    , Comparison r
    , NumericExpression r
    , ValueExpression r
    , Argument r
    , List r
    , NativeVector r
    , Reference r
    , OO.Set r
    , 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 :: * -> *).
(MathConstant r, VariableValue r, BooleanExpression r,
 Comparison r, NumericExpression r, ValueExpression r, Argument r,
 List r, NativeVector r, Reference r, Set r, 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
  g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  let mem = DrasilState -> Map Name Name
eMap DrasilState
g
      lem = DrasilState -> Map Name Name
libEMap DrasilState
g
      funcCd = DefinedQuantityDict -> CodeFuncChunk
forall c.
(Quantity c, MayHaveUnit c, Concept c) =>
c -> CodeFuncChunk
quantfunc (DrasilState -> UID -> DefinedQuantityDict
lookupC DrasilState
g UID
c)
      funcNm = CodeFuncChunk -> Name
forall c. CodeIdea c => c -> Name
codeName CodeFuncChunk
funcCd
  funcTp <- codeType funcCd
  args <- mapM convExprProc x
  nms <- mapM (mkVarProc . quantvar . lookupC g . fst) ns
  nargs <- mapM (convExprProc . snd) ns
  maybe (maybe (error $ "Call to non-existent function " ++ 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))
      (Map.lookup funcNm 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))
    (Map.lookup funcNm mem)

-- | Converts a 'FuncStmt' to a GOOL Statement.
convStmtProc
  ::
    ( BlockSym r block stmt
    , BodySym r bod block
    , MathConstant r
    , VariableValue r
    , BooleanExpression r
    , NumericExpression r
    , ValueExpression r
    , Comparison r
    , Argument r
    , Array r
    , List r
    , ListStatement r stmt
    , NativeVector r
    , Reference r
    , OO.Set r
    , MultiStatement r stmt
    , ValueStatement r stmt
    , DeclStatement r stmt bod
    , AssignStatement r stmt
    , ControlStatement r stmt bod
    , TypeElim r
    , VariableElim r
    )
  => FuncStmt -> GenState (MS (r stmt))
convStmtProc :: forall (r :: * -> *) block stmt bod.
(BlockSym r block stmt, BodySym r bod block, MathConstant r,
 VariableValue r, BooleanExpression r, NumericExpression r,
 ValueExpression r, Comparison r, Argument r, Array r, List r,
 ListStatement r stmt, NativeVector r, Reference r, Set r,
 MultiStatement r stmt, ValueStatement r stmt,
 DeclStatement r stmt bod, AssignStatement r stmt,
 ControlStatement r stmt bod, TypeElim r, VariableElim r) =>
FuncStmt -> GenState (MS (r stmt))
convStmtProc (FAsg Input
v (Matrix [[CodeExpr]
es])) = do
  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 :: * -> *).
(MathConstant r, VariableValue r, BooleanExpression r,
 Comparison r, NumericExpression r, ValueExpression r, Argument r,
 NativeVector r, Reference r, Set r, List r, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc [CodeExpr]
es
  v' <- mkVarProc v
  t <- codeType v
  let listFunc (OO.List CodeType
_) = VS (r TypeData) -> [SValue r] -> SValue r
forall (r :: * -> *).
Literal r =>
VS (r TypeData) -> [SValue r] -> SValue r
litList
      listFunc (OO.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"
  return $ assign v' (listFunc t (innerType $ fmap variableType v')
    els)
convStmtProc (FAsg Input
v CodeExpr
e) = do
  e' <- CodeExpr -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *).
(MathConstant r, VariableValue r, BooleanExpression r,
 Comparison r, NumericExpression r, ValueExpression r, Argument r,
 NativeVector r, Reference r, Set r, List r, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
e
  v' <- mkVarProc v
  return $ assign v' e'
convStmtProc (FAsgIndex Input
v Integer
i CodeExpr
e) = do
  e' <- CodeExpr -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *).
(MathConstant r, VariableValue r, BooleanExpression r,
 Comparison r, NumericExpression r, ValueExpression r, Argument r,
 NativeVector r, Reference r, Set r, List r, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
e
  v' <- mkVarProc v
  t <- codeType v
  let asgFunc (OO.List CodeType
_) = SValue r -> SValue r -> SValue r -> MS (r stmt)
forall (r :: * -> *) stmt.
ListStatement r stmt =>
SValue r -> SValue r -> SValue r -> MS (r stmt)
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 (OO.Array CodeType
_) = SVariable r -> SValue r -> MS (r stmt)
forall (r :: * -> *) stmt.
AssignStatement r stmt =>
SVariable r -> SValue r -> MS (r stmt)
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 stmt)
forall a. HasCallStack => Name -> a
error Name
"FAsgIndex used with non-indexed value"
  return $ asgFunc t
convStmtProc (FFor Input
v CodeExpr
start CodeExpr
end CodeExpr
step [FuncStmt]
st) = do
  stmts <- (FuncStmt -> StateT DrasilState Identity (MS (r stmt)))
-> [FuncStmt] -> StateT DrasilState Identity [MS (r stmt)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM FuncStmt -> StateT DrasilState Identity (MS (r stmt))
forall (r :: * -> *) block stmt bod.
(BlockSym r block stmt, BodySym r bod block, MathConstant r,
 VariableValue r, BooleanExpression r, NumericExpression r,
 ValueExpression r, Comparison r, Argument r, Array r, List r,
 ListStatement r stmt, NativeVector r, Reference r, Set r,
 MultiStatement r stmt, ValueStatement r stmt,
 DeclStatement r stmt bod, AssignStatement r stmt,
 ControlStatement r stmt bod, TypeElim r, VariableElim r) =>
FuncStmt -> GenState (MS (r stmt))
convStmtProc [FuncStmt]
st
  vari <- mkVarProc v
  start' <- convExprProc start
  end' <- convExprProc end
  step' <- convExprProc step
  return $ forRange vari start' end' step' (bodyStatements stmts)
convStmtProc (FForEach Input
v CodeExpr
e [FuncStmt]
st) = do
  stmts <- (FuncStmt -> StateT DrasilState Identity (MS (r stmt)))
-> [FuncStmt] -> StateT DrasilState Identity [MS (r stmt)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM FuncStmt -> StateT DrasilState Identity (MS (r stmt))
forall (r :: * -> *) block stmt bod.
(BlockSym r block stmt, BodySym r bod block, MathConstant r,
 VariableValue r, BooleanExpression r, NumericExpression r,
 ValueExpression r, Comparison r, Argument r, Array r, List r,
 ListStatement r stmt, NativeVector r, Reference r, Set r,
 MultiStatement r stmt, ValueStatement r stmt,
 DeclStatement r stmt bod, AssignStatement r stmt,
 ControlStatement r stmt bod, TypeElim r, VariableElim r) =>
FuncStmt -> GenState (MS (r stmt))
convStmtProc [FuncStmt]
st
  vari <- mkVarProc v
  e' <- convExprProc e
  return $ forEach vari e' (bodyStatements stmts)
convStmtProc (FWhile CodeExpr
e [FuncStmt]
st) = do
  stmts <- (FuncStmt -> StateT DrasilState Identity (MS (r stmt)))
-> [FuncStmt] -> StateT DrasilState Identity [MS (r stmt)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM FuncStmt -> StateT DrasilState Identity (MS (r stmt))
forall (r :: * -> *) block stmt bod.
(BlockSym r block stmt, BodySym r bod block, MathConstant r,
 VariableValue r, BooleanExpression r, NumericExpression r,
 ValueExpression r, Comparison r, Argument r, Array r, List r,
 ListStatement r stmt, NativeVector r, Reference r, Set r,
 MultiStatement r stmt, ValueStatement r stmt,
 DeclStatement r stmt bod, AssignStatement r stmt,
 ControlStatement r stmt bod, TypeElim r, VariableElim r) =>
FuncStmt -> GenState (MS (r stmt))
convStmtProc [FuncStmt]
st
  e' <- convExprProc e
  return $ while e' (bodyStatements stmts)
convStmtProc (FCond CodeExpr
e [FuncStmt]
tSt []) = do
  stmts <- (FuncStmt -> StateT DrasilState Identity (MS (r stmt)))
-> [FuncStmt] -> StateT DrasilState Identity [MS (r stmt)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM FuncStmt -> StateT DrasilState Identity (MS (r stmt))
forall (r :: * -> *) block stmt bod.
(BlockSym r block stmt, BodySym r bod block, MathConstant r,
 VariableValue r, BooleanExpression r, NumericExpression r,
 ValueExpression r, Comparison r, Argument r, Array r, List r,
 ListStatement r stmt, NativeVector r, Reference r, Set r,
 MultiStatement r stmt, ValueStatement r stmt,
 DeclStatement r stmt bod, AssignStatement r stmt,
 ControlStatement r stmt bod, TypeElim r, VariableElim r) =>
FuncStmt -> GenState (MS (r stmt))
convStmtProc [FuncStmt]
tSt
  e' <- convExprProc e
  return $ ifNoElse [(e', bodyStatements stmts)]
convStmtProc (FCond CodeExpr
e [FuncStmt]
tSt [FuncStmt]
eSt) = do
  stmt1 <- (FuncStmt -> StateT DrasilState Identity (MS (r stmt)))
-> [FuncStmt] -> StateT DrasilState Identity [MS (r stmt)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM FuncStmt -> StateT DrasilState Identity (MS (r stmt))
forall (r :: * -> *) block stmt bod.
(BlockSym r block stmt, BodySym r bod block, MathConstant r,
 VariableValue r, BooleanExpression r, NumericExpression r,
 ValueExpression r, Comparison r, Argument r, Array r, List r,
 ListStatement r stmt, NativeVector r, Reference r, Set r,
 MultiStatement r stmt, ValueStatement r stmt,
 DeclStatement r stmt bod, AssignStatement r stmt,
 ControlStatement r stmt bod, TypeElim r, VariableElim r) =>
FuncStmt -> GenState (MS (r stmt))
convStmtProc [FuncStmt]
tSt
  stmt2 <- mapM convStmtProc eSt
  e' <- convExprProc e
  return $ ifCond [(e', bodyStatements stmt1)] (bodyStatements stmt2)
convStmtProc (FRet CodeExpr
e) = do
  e' <- CodeExpr -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *).
(MathConstant r, VariableValue r, BooleanExpression r,
 Comparison r, NumericExpression r, ValueExpression r, Argument r,
 NativeVector r, Reference r, Set r, List r, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
e
  return $ returnStmt e'
convStmtProc (FThrow Name
s) = MS (r stmt) -> StateT DrasilState Identity (MS (r stmt))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (MS (r stmt) -> StateT DrasilState Identity (MS (r stmt)))
-> MS (r stmt) -> StateT DrasilState Identity (MS (r stmt))
forall a b. (a -> b) -> a -> b
$ Name -> MS (r stmt)
forall (r :: * -> *) stmt bod.
ControlStatement r stmt bod =>
Name -> MS (r stmt)
throw Name
s
convStmtProc (FTry [FuncStmt]
t [FuncStmt]
c) = do
  stmt1 <- (FuncStmt -> StateT DrasilState Identity (MS (r stmt)))
-> [FuncStmt] -> StateT DrasilState Identity [MS (r stmt)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM FuncStmt -> StateT DrasilState Identity (MS (r stmt))
forall (r :: * -> *) block stmt bod.
(BlockSym r block stmt, BodySym r bod block, MathConstant r,
 VariableValue r, BooleanExpression r, NumericExpression r,
 ValueExpression r, Comparison r, Argument r, Array r, List r,
 ListStatement r stmt, NativeVector r, Reference r, Set r,
 MultiStatement r stmt, ValueStatement r stmt,
 DeclStatement r stmt bod, AssignStatement r stmt,
 ControlStatement r stmt bod, TypeElim r, VariableElim r) =>
FuncStmt -> GenState (MS (r stmt))
convStmtProc [FuncStmt]
t
  stmt2 <- mapM convStmtProc c
  return $ tryCatch (bodyStatements stmt1) (bodyStatements stmt2)
convStmtProc FuncStmt
FContinue = MS (r stmt) -> StateT DrasilState Identity (MS (r stmt))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return MS (r stmt)
forall (r :: * -> *) stmt bod.
ControlStatement r stmt bod =>
MS (r stmt)
continue
convStmtProc (FDecDef Input
v (Matrix [[]])) = do
  g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  let scp = ScopeType -> r ScopeData
forall (r :: * -> *). ScopeSym r => ScopeType -> r ScopeData
convScope (ScopeType -> r ScopeData) -> ScopeType -> r ScopeData
forall a b. (a -> b) -> a -> b
$ DrasilState -> ScopeType
currentScope DrasilState
g
  vari <- mkVarProc v
  let convDec (OO.List CodeType
_) = Integer -> SVariable r -> r ScopeData -> MS (r stmt)
forall (r :: * -> *) stmt bod.
DeclStatement r stmt bod =>
Integer -> SVariable r -> r ScopeData -> MS (r stmt)
listDec Integer
0 SVariable r
vari
      convDec (OO.Array CodeType
_) = Integer -> SValue r -> SVariable r -> r ScopeData -> MS (r stmt)
forall (r :: * -> *) stmt bod.
DeclStatement r stmt bod =>
Integer -> SValue r -> SVariable r -> r ScopeData -> MS (r stmt)
arrayDec Integer
0 SValue r
forall a. HasCallStack => a
undefined SVariable r
vari
      convDec CodeType
_ = SVariable r -> r ScopeData -> MS (r stmt)
forall (r :: * -> *) stmt bod.
DeclStatement r stmt bod =>
SVariable r -> r ScopeData -> MS (r stmt)
varDec SVariable r
vari
  fmap (`convDec` scp) (codeType v)
convStmtProc (FDecDef Input
v CodeExpr
e) = do
  g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  let scp = ScopeType -> r ScopeData
forall (r :: * -> *). ScopeSym r => ScopeType -> r ScopeData
convScope (ScopeType -> r ScopeData) -> ScopeType -> r ScopeData
forall a b. (a -> b) -> a -> b
$ DrasilState -> ScopeType
currentScope DrasilState
g
  v' <- mkVarProc v
  t <- codeType v
  let convDecDef (Matrix [[CodeExpr]
lst]) = do
        let contDecDef :: CodeType -> SVariable r -> r ScopeData -> [SValue r] -> MS (r stmt)
contDecDef (OO.List CodeType
_) = SVariable r -> r ScopeData -> [SValue r] -> MS (r stmt)
forall (r :: * -> *) stmt bod.
DeclStatement r stmt bod =>
SVariable r -> r ScopeData -> [SValue r] -> MS (r stmt)
listDecDef
            contDecDef (OO.Array CodeType
_) = SVariable r -> r ScopeData -> [SValue r] -> MS (r stmt)
forall (r :: * -> *) stmt bod.
DeclStatement r stmt bod =>
SVariable r -> r ScopeData -> [SValue r] -> MS (r stmt)
arrayDecDef
            contDecDef CodeType
_ = Name -> SVariable r -> r ScopeData -> [SValue r] -> MS (r stmt)
forall a. HasCallStack => Name -> a
error Name
"Type mismatch between variable and value in declare-define FuncStmt"
        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 :: * -> *).
(MathConstant r, VariableValue r, BooleanExpression r,
 Comparison r, NumericExpression r, ValueExpression r, Argument r,
 NativeVector r, Reference r, Set r, List r, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc [CodeExpr]
lst
        return $ contDecDef t v' scp e'
      convDecDef CodeExpr
_ = do
        e' <- CodeExpr -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *).
(MathConstant r, VariableValue r, BooleanExpression r,
 Comparison r, NumericExpression r, ValueExpression r, Argument r,
 NativeVector r, Reference r, Set r, List r, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
e
        return $ varDecDef v' scp e'
  convDecDef e
convStmtProc (FFuncDef CodeFuncChunk
f [ParameterChunk]
ps [FuncStmt]
sts) = do
  g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  let scp = ScopeType -> r ScopeData
forall (r :: * -> *). ScopeSym r => ScopeType -> r ScopeData
convScope (ScopeType -> r ScopeData) -> ScopeType -> r ScopeData
forall a b. (a -> b) -> a -> b
$ DrasilState -> ScopeType
currentScope DrasilState
g
  f' <- mkVarProc (quantvar f)
  pms <- mapM (mkVarProc . quantvar) ps
  b <- mapM convStmtProc sts
  return $ funcDecDef f' scp pms (bodyStatements b)
convStmtProc (FVal CodeExpr
e) = do
  e' <- CodeExpr -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *).
(MathConstant r, VariableValue r, BooleanExpression r,
 Comparison r, NumericExpression r, ValueExpression r, Argument r,
 NativeVector r, Reference r, Set r, List r, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
e
  return $ valStmt e'
convStmtProc (FMulti [FuncStmt]
ss) = do
  stmts <- (FuncStmt -> StateT DrasilState Identity (MS (r stmt)))
-> [FuncStmt] -> StateT DrasilState Identity [MS (r stmt)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM FuncStmt -> StateT DrasilState Identity (MS (r stmt))
forall (r :: * -> *) block stmt bod.
(BlockSym r block stmt, BodySym r bod block, MathConstant r,
 VariableValue r, BooleanExpression r, NumericExpression r,
 ValueExpression r, Comparison r, Argument r, Array r, List r,
 ListStatement r stmt, NativeVector r, Reference r, Set r,
 MultiStatement r stmt, ValueStatement r stmt,
 DeclStatement r stmt bod, AssignStatement r stmt,
 ControlStatement r stmt bod, TypeElim r, VariableElim r) =>
FuncStmt -> GenState (MS (r stmt))
convStmtProc [FuncStmt]
ss
  return $ multi stmts
convStmtProc (FAppend CodeExpr
a CodeExpr
b) = do
  a' <- CodeExpr -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *).
(MathConstant r, VariableValue r, BooleanExpression r,
 Comparison r, NumericExpression r, ValueExpression r, Argument r,
 NativeVector r, Reference r, Set r, List r, TypeElim r) =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
a
  b' <- convExprProc b
  return $ listAppend a' b'

-- | Generates a function that reads a file whose format is based on the passed
-- 'DataDesc'.
genDataFuncProc
  ::
    ( BlockSym r block stmt
    , BodySym r bod block
    , NativeVector r
    , MathConstant r
    , BooleanExpression r
    , Comparison r
    , NumericExpression r
    , ValueExpression r
    , VariableValue r
    , DeclStatement r stmt bod
    , ControlStatement r stmt bod
    , StringStatement r stmt
    , FileHandling r stmt
    , ReadFile r stmt
    , PrintFile r stmt
    , Argument r
    , List r
    , ListStatement r stmt
    , Reference r
    , OO.Set r
    , MultiStatement r stmt
    , MethodSym r vis mthd bod
    , TypeElim r
    , VariableElim r
    )
  => Name -> Description -> DataDesc -> GenState (MS (r mthd))
genDataFuncProc :: forall (r :: * -> *) block stmt bod vis mthd.
(BlockSym r block stmt, BodySym r bod block, NativeVector r,
 MathConstant r, BooleanExpression r, Comparison r,
 NumericExpression r, ValueExpression r, VariableValue r,
 DeclStatement r stmt bod, ControlStatement r stmt bod,
 StringStatement r stmt, FileHandling r stmt, ReadFile r stmt,
 PrintFile r stmt, Argument r, List r, ListStatement r stmt,
 Reference r, Set r, MultiStatement r stmt,
 MethodSym r vis mthd bod, TypeElim r, VariableElim r) =>
Name -> Name -> DataDesc -> GenState (MS (r mthd))
genDataFuncProc Name
nameTitle Name
desc DataDesc
ddef = do
  let parms :: [Input]
parms = DataDesc -> [Input]
getInputs DataDesc
ddef
  bod <- DataDesc -> GenState [MS (r block)]
forall (r :: * -> *) block stmt bod.
(BlockSym r block stmt, BodySym r bod block, NativeVector r,
 MathConstant r, BooleanExpression r, Comparison r,
 NumericExpression r, ValueExpression r, VariableValue r,
 DeclStatement r stmt bod, ControlStatement r stmt bod,
 StringStatement r stmt, FileHandling r stmt, ReadFile r stmt,
 Argument r, List r, ListStatement r stmt, Reference r, Set r,
 TypeElim r) =>
DataDesc -> GenState [MS (r block)]
readDataProc DataDesc
ddef
  publicFuncProc nameTitle void desc (map pcAuto $ quantvar inFileName : parms)
    Nothing bod

-- | Generates a public function, defined by its inputs and outputs.
publicInOutFuncProc
  ::
    ( BlockSym r block stmt
    , BodySym r bod block
    , OO.Literal r
    , VariableValue r
    , MultiStatement r stmt
    , DeclStatement r stmt bod
    , FileHandling r stmt
    , PrintFile r stmt
    , MethodSym r vis mthd bod
    , VariableElim r
    )
  => Label
  -> Description
  -> [CodeVarChunk]
  -> [CodeVarChunk]
  -> [MS (r block)]
  -> GenState (MS (r mthd))
publicInOutFuncProc :: forall (r :: * -> *) block stmt bod vis mthd.
(BlockSym r block stmt, BodySym r bod block, Literal r,
 VariableValue r, MultiStatement r stmt, DeclStatement r stmt bod,
 FileHandling r stmt, PrintFile r stmt, MethodSym r vis mthd bod,
 VariableElim r) =>
Name
-> Name
-> [Input]
-> [Input]
-> [MS (r block)]
-> GenState (MS (r mthd))
publicInOutFuncProc Name
n = ([SVariable r]
 -> [SVariable r] -> [SVariable r] -> MS (r bod) -> MS (r mthd))
-> (Name
    -> [(Name, SVariable r)]
    -> [(Name, SVariable r)]
    -> [(Name, SVariable r)]
    -> MS (r bod)
    -> MS (r mthd))
-> Name
-> Name
-> [Input]
-> [Input]
-> [MS (r block)]
-> GenState (MS (r mthd))
forall (r :: * -> *) stmt bod block mthd.
(Literal r, VariableValue r, MultiStatement r stmt,
 DeclStatement r stmt bod, FileHandling r stmt, PrintFile r stmt,
 BlockSym r block stmt, BodySym r bod block, VariableElim r) =>
([SVariable r]
 -> [SVariable r] -> [SVariable r] -> MS (r bod) -> MS (r mthd))
-> (Name
    -> [(Name, SVariable r)]
    -> [(Name, SVariable r)]
    -> [(Name, SVariable r)]
    -> MS (r bod)
    -> MS (r mthd))
-> Name
-> Name
-> [Input]
-> [Input]
-> [MS (r block)]
-> GenState (MS (r mthd))
genInOutFuncProc (Name
-> r vis
-> [SVariable r]
-> [SVariable r]
-> [SVariable r]
-> MS (r bod)
-> MS (r mthd)
forall (r :: * -> *) vis mthd bod.
MethodSym r vis mthd bod =>
Name -> r vis -> InOutFunc r mthd bod
inOutFunc Name
n r vis
forall {k} (r :: k -> *) (vis :: k). VisibilitySym r vis => r vis
public) (Name
-> r vis
-> Name
-> [(Name, SVariable r)]
-> [(Name, SVariable r)]
-> [(Name, SVariable r)]
-> MS (r bod)
-> MS (r mthd)
forall (r :: * -> *) vis mthd bod.
MethodSym r vis mthd bod =>
Name -> r vis -> DocInOutFunc r mthd bod
docInOutFunc Name
n r vis
forall {k} (r :: k -> *) (vis :: k). VisibilitySym r vis => r vis
public) Name
n

-- | Generates a private function, defined by its inputs and outputs.
privateInOutFuncProc
  ::
    ( BlockSym r block stmt
    , BodySym r bod block
    , OO.Literal r
    , VariableValue r
    , MultiStatement r stmt
    , DeclStatement r stmt bod
    , FileHandling r stmt
    , PrintFile r stmt
    , MethodSym r vis mthd bod
    , VariableElim r
    )
  => Label
  -> Description
  -> [CodeVarChunk]
  -> [CodeVarChunk]
  -> [MS (r block)]
  -> GenState (MS (r mthd))
privateInOutFuncProc :: forall (r :: * -> *) block stmt bod vis mthd.
(BlockSym r block stmt, BodySym r bod block, Literal r,
 VariableValue r, MultiStatement r stmt, DeclStatement r stmt bod,
 FileHandling r stmt, PrintFile r stmt, MethodSym r vis mthd bod,
 VariableElim r) =>
Name
-> Name
-> [Input]
-> [Input]
-> [MS (r block)]
-> GenState (MS (r mthd))
privateInOutFuncProc Name
n = ([SVariable r]
 -> [SVariable r] -> [SVariable r] -> MS (r bod) -> MS (r mthd))
-> (Name
    -> [(Name, SVariable r)]
    -> [(Name, SVariable r)]
    -> [(Name, SVariable r)]
    -> MS (r bod)
    -> MS (r mthd))
-> Name
-> Name
-> [Input]
-> [Input]
-> [MS (r block)]
-> GenState (MS (r mthd))
forall (r :: * -> *) stmt bod block mthd.
(Literal r, VariableValue r, MultiStatement r stmt,
 DeclStatement r stmt bod, FileHandling r stmt, PrintFile r stmt,
 BlockSym r block stmt, BodySym r bod block, VariableElim r) =>
([SVariable r]
 -> [SVariable r] -> [SVariable r] -> MS (r bod) -> MS (r mthd))
-> (Name
    -> [(Name, SVariable r)]
    -> [(Name, SVariable r)]
    -> [(Name, SVariable r)]
    -> MS (r bod)
    -> MS (r mthd))
-> Name
-> Name
-> [Input]
-> [Input]
-> [MS (r block)]
-> GenState (MS (r mthd))
genInOutFuncProc (Name
-> r vis
-> [SVariable r]
-> [SVariable r]
-> [SVariable r]
-> MS (r bod)
-> MS (r mthd)
forall (r :: * -> *) vis mthd bod.
MethodSym r vis mthd bod =>
Name -> r vis -> InOutFunc r mthd bod
inOutFunc Name
n r vis
forall {k} (r :: k -> *) (vis :: k). VisibilitySym r vis => r vis
private) (Name
-> r vis
-> Name
-> [(Name, SVariable r)]
-> [(Name, SVariable r)]
-> [(Name, SVariable r)]
-> MS (r bod)
-> MS (r mthd)
forall (r :: * -> *) vis mthd bod.
MethodSym r vis mthd bod =>
Name -> r vis -> DocInOutFunc r mthd bod
docInOutFunc Name
n r vis
forall {k} (r :: k -> *) (vis :: k). 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
  ::
    ( OO.Literal r
    , VariableValue r
    , MultiStatement r stmt
    , DeclStatement r stmt bod
    , FileHandling r stmt
    , PrintFile r stmt
    , BlockSym r block stmt
    , BodySym r bod block
    , VariableElim r
    )
  => ([SVariable r] -> [SVariable r] -> [SVariable r] -> MS (r bod) -> MS (r mthd))
  -> (String -> [(String, SVariable r)] -> [(String, SVariable r)] -> [(String, SVariable r)] -> MS (r bod) -> MS (r mthd))
  -> Label
  -> Description
  -> [CodeVarChunk]
  -> [CodeVarChunk]
  -> [MS (r block)]
  -> GenState (MS (r mthd))
genInOutFuncProc :: forall (r :: * -> *) stmt bod block mthd.
(Literal r, VariableValue r, MultiStatement r stmt,
 DeclStatement r stmt bod, FileHandling r stmt, PrintFile r stmt,
 BlockSym r block stmt, BodySym r bod block, VariableElim r) =>
([SVariable r]
 -> [SVariable r] -> [SVariable r] -> MS (r bod) -> MS (r mthd))
-> (Name
    -> [(Name, SVariable r)]
    -> [(Name, SVariable r)]
    -> [(Name, SVariable r)]
    -> MS (r bod)
    -> MS (r mthd))
-> Name
-> Name
-> [Input]
-> [Input]
-> [MS (r block)]
-> GenState (MS (r mthd))
genInOutFuncProc [SVariable r]
-> [SVariable r] -> [SVariable r] -> MS (r bod) -> MS (r mthd)
f Name
-> [(Name, SVariable r)]
-> [(Name, SVariable r)]
-> [(Name, SVariable r)]
-> MS (r bod)
-> MS (r mthd)
docf Name
n Name
desc [Input]
ins' [Input]
outs' [MS (r block)]
b = do
  g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  modify (\DrasilState
st -> DrasilState
st {currentScope = Local})
  let ins = [Input]
ins' [Input] -> [Input] -> [Input]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Input]
outs'
      outs = [Input]
outs' [Input] -> [Input] -> [Input]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Input]
ins'
      both = [Input]
ins' [Input] -> [Input] -> [Input]
forall a. Eq a => [a] -> [a] -> [a]
`intersect` [Input]
outs'
  inVs <- mapM mkVarProc ins
  outVs <- mapM mkVarProc outs
  bothVs <- mapM mkVarProc both
  bod <- logBody n (bothVs ++ inVs) b
  pComms <- mapM getCommentBrief ins
  oComms <- mapM getCommentBrief outs
  bComms <- mapM getCommentBrief both
  return $ if CommentFunc `elem` g ^. commented
    then docf desc (zip pComms inVs) (zip oComms outVs) (zip
    bComms bothVs) bod else f inVs outVs bothVs 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