{-# LANGUAGE PostfixOperators, Rank2Types #-}
{-# OPTIONS_GHC -Wno-redundant-constraints #-}
module Language.Drasil.Code.Imperative.Import (codeType, spaceCodeType,
  publicFunc, privateMethod, publicInOutFunc, privateInOutMethod,
  genConstructor, mkVar, mkVal, convExpr, convStmt, genModDef, genModFuncs,
  genModClasses, readData, renderC
) where

import Language.Drasil (HasSymbol, HasUID(..), HasSpace(..),
  Space (Rational, Real), RealInterval(..), UID, Constraint(..), Inclusive (..))
import Database.Drasil (symbResolve)
import Language.Drasil.CodeExpr (sy, ($<), ($>), ($<=), ($>=), ($&&))
import Language.Drasil.CodeExpr.Development (CodeExpr(..), ArithBinOp(..),
  AssocArithOper(..), AssocBoolOper(..), BoolBinOp(..), EqBinOp(..),
  LABinOp(..), OrdBinOp(..), UFunc(..), UFuncB(..), UFuncVV(..), UFuncVN(..),
  VVNBinOp(..), VVVBinOp(..), NVVBinOp(..))
import Language.Drasil.Code.Imperative.Comments (getComment)
import Language.Drasil.Code.Imperative.ConceptMatch (conceptToGOOL)
import Language.Drasil.Code.Imperative.GenerateGOOL (auxClass, fApp, ctorCall,
  genModuleWithImports, primaryClass)
import Language.Drasil.Code.Imperative.Helpers (lookupC)
import Language.Drasil.Code.Imperative.Logging (maybeLog, logBody)
import Language.Drasil.Code.Imperative.DrasilState (GenState, DrasilState(..))
import Language.Drasil.Chunk.Code (CodeIdea(codeName), CodeVarChunk, obv,
  quantvar, quantfunc, ccObjVar, DefiningCodeExpr(..))
import Language.Drasil.Chunk.Parameter (ParameterChunk(..), PassBy(..), pcAuto)
import Language.Drasil.Code.CodeQuantityDicts (inFileName, inParams, consts)
import Language.Drasil.Choices (Comments(..), ConstantRepr(..),
  ConstantStructure(..), Structure(..))
import Language.Drasil.CodeSpec (CodeSpec(..))
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 GOOL.Drasil (Label, SFile, MSBody, MSBlock, VSType, SVariable, SValue,
  MSStatement, MSParameter, SMethod, CSStateVar, SClass, NamedArgs,
  Initializers, OOProg, PermanenceSym(..), bodyStatements, BlockSym(..),
  TypeSym(..), VariableSym(..), VariableElim(..), ($->), ValueSym(..),
  Literal(..), VariableValue(..), NumericExpression(..), BooleanExpression(..),
  Comparison(..), ValueExpression(..), objMethodCallMixedArgs, List(..),
  StatementSym(..), AssignStatement(..), DeclStatement(..), IOStatement(..),
  StringStatement(..), ControlStatement(..), ifNoElse, ScopeSym(..),
  ParameterSym(..), MethodSym(..), pubDVar, privDVar, nonInitConstructor,
  convType, ScopeTag(..), CodeType(..), onStateValue)
import qualified GOOL.Drasil as C (CodeType(List, Array))

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

-- | 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 -> GenState CodeType
codeType c
c = Space -> GenState CodeType
spaceCodeType (c
c forall s a. s -> Getting a s a -> a
^. forall c. HasSpace c => Getter c Space
typ)

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

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

-- | If variable is an input, construct it with 'var' and pass to inputVariable.
-- If variable is a constant and 'Var' constant representation is chosen,
-- construct it with 'var' and pass to 'constVariable'.
-- If variable is a constant and 'Const' constant representation is chosen,
-- construct it with 'staticVar' and pass to 'constVariable'.
-- If variable is neither, just construct it with 'var' and return it.
variable :: (OOProg r) => Name -> VSType r -> GenState (SVariable r)
variable :: forall (r :: * -> *).
OOProg r =>
Name -> VSType r -> GenState (SVariable r)
variable Name
s VSType r
t = do
  DrasilState
g <- forall s (m :: * -> *). MonadState s m => m s
get
  let cs :: CodeSpec
cs = DrasilState -> CodeSpec
codeSpec DrasilState
g
      defFunc :: ConstantRepr -> Name -> VSType r -> SVariable r
defFunc ConstantRepr
Var = forall (r :: * -> *).
VariableSym r =>
Name -> VSType r -> SVariable r
var
      defFunc ConstantRepr
Const = forall (r :: * -> *).
VariableSym r =>
Name -> VSType r -> SVariable r
staticVar
  if Name
s forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` forall a b. (a -> b) -> [a] -> [b]
map forall c. CodeIdea c => c -> Name
codeName (CodeSpec -> [Input]
inputs CodeSpec
cs)
    then forall (r :: * -> *).
OOProg r =>
Structure -> ConstantRepr -> SVariable r -> GenState (SVariable r)
inputVariable (DrasilState -> Structure
inStruct DrasilState
g) ConstantRepr
Var (forall (r :: * -> *).
VariableSym r =>
Name -> VSType r -> SVariable r
var Name
s VSType r
t)
    else if Name
s forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` forall a b. (a -> b) -> [a] -> [b]
map forall c. CodeIdea c => c -> Name
codeName (CodeSpec -> [CodeDefinition]
constants forall a b. (a -> b) -> a -> b
$ DrasilState -> CodeSpec
codeSpec DrasilState
g)
      then forall (r :: * -> *).
OOProg r =>
ConstantStructure
-> ConstantRepr -> SVariable r -> GenState (SVariable r)
constVariable (DrasilState -> ConstantStructure
conStruct DrasilState
g) (DrasilState -> ConstantRepr
conRepr DrasilState
g) ((forall {r :: * -> *}.
VariableSym r =>
ConstantRepr -> Name -> VSType r -> SVariable r
defFunc forall a b. (a -> b) -> a -> b
$ DrasilState -> ConstantRepr
conRepr DrasilState
g) Name
s VSType r
t)
      else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (r :: * -> *).
VariableSym r =>
Name -> VSType r -> SVariable r
var Name
s VSType r
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 :: (OOProg r) => Structure -> ConstantRepr -> SVariable r ->
  GenState (SVariable r)
inputVariable :: forall (r :: * -> *).
OOProg r =>
Structure -> ConstantRepr -> SVariable r -> GenState (SVariable r)
inputVariable Structure
Unbundled ConstantRepr
_ SVariable r
v = forall (m :: * -> *) a. Monad m => a -> m a
return SVariable r
v
inputVariable Structure
Bundled ConstantRepr
Var SVariable r
v = do
  DrasilState
g <- forall s (m :: * -> *). MonadState s m => m s
get
  let inClsName :: Name
inClsName = Name
"InputParameters"
  SVariable r
ip <- forall (r :: * -> *). OOProg r => Input -> GenState (SVariable r)
mkVar (forall c. (Quantity c, MayHaveUnit c) => c -> Input
quantvar QuantityDict
inParams)
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if DrasilState -> Name
currentClass DrasilState
g forall a. Eq a => a -> a -> Bool
== Name
inClsName then forall (r :: * -> *). VariableSym r => SVariable r -> SVariable r
objVarSelf SVariable r
v else SVariable r
ip forall (r :: * -> *).
VariableSym r =>
SVariable r -> SVariable r -> SVariable r
$-> SVariable r
v
inputVariable Structure
Bundled ConstantRepr
Const SVariable r
v = do
  SVariable r
ip <- forall (r :: * -> *). OOProg r => Input -> GenState (SVariable r)
mkVar (forall c. (Quantity c, MayHaveUnit c) => c -> Input
quantvar QuantityDict
inParams)
  forall (r :: * -> *).
OOProg r =>
SVariable r -> SVariable r -> GenState (SVariable r)
classVariable SVariable r
ip SVariable r
v

-- | If 'Unbundled' constants, just return variable as-is.
-- If 'Bundled' constants and 'Var' constant representation, access variable
-- through 'consts' object.
-- If 'Bundled' constants and 'Const' constant representation, access variable
-- through class, so call 'classVariable'.
-- If constants stored 'WithInputs', call 'inputVariable'.
-- If constants are 'Inline'd, the generator should not be attempting to make a
-- variable for one of the constants.
constVariable :: (OOProg r) => ConstantStructure -> ConstantRepr ->
  SVariable r -> GenState (SVariable r)
constVariable :: forall (r :: * -> *).
OOProg r =>
ConstantStructure
-> ConstantRepr -> SVariable r -> GenState (SVariable r)
constVariable (Store Structure
Unbundled) ConstantRepr
_ SVariable r
v = forall (m :: * -> *) a. Monad m => a -> m a
return SVariable r
v
constVariable (Store Structure
Bundled) ConstantRepr
Var SVariable r
v = do
  SVariable r
cs <- forall (r :: * -> *). OOProg r => Input -> GenState (SVariable r)
mkVar (forall c. (Quantity c, MayHaveUnit c) => c -> Input
quantvar QuantityDict
consts)
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ SVariable r
cs forall (r :: * -> *).
VariableSym r =>
SVariable r -> SVariable r -> SVariable r
$-> SVariable r
v
constVariable (Store Structure
Bundled) ConstantRepr
Const SVariable r
v = do
  SVariable r
cs <- forall (r :: * -> *). OOProg r => Input -> GenState (SVariable r)
mkVar (forall c. (Quantity c, MayHaveUnit c) => c -> Input
quantvar QuantityDict
consts)
  forall (r :: * -> *).
OOProg r =>
SVariable r -> SVariable r -> GenState (SVariable r)
classVariable SVariable r
cs SVariable r
v
constVariable ConstantStructure
WithInputs ConstantRepr
cr SVariable r
v = do
  DrasilState
g <- forall s (m :: * -> *). MonadState s m => m s
get
  forall (r :: * -> *).
OOProg r =>
Structure -> ConstantRepr -> SVariable r -> GenState (SVariable r)
inputVariable (DrasilState -> Structure
inStruct DrasilState
g) ConstantRepr
cr SVariable r
v
constVariable ConstantStructure
Inline ConstantRepr
_ SVariable r
_ = forall a. HasCallStack => Name -> a
error forall a b. (a -> b) -> a -> b
$ Name
"mkVar called on a constant, but user " 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 'classVar'.
-- If the variable is exported by a different module, use 'extClassVar'.
classVariable :: (OOProg r) => SVariable r -> SVariable r ->
  GenState (SVariable r)
classVariable :: forall (r :: * -> *).
OOProg r =>
SVariable r -> SVariable r -> GenState (SVariable r)
classVariable SVariable r
c SVariable r
v = do
  DrasilState
g <- forall s (m :: * -> *). MonadState s m => m s
get
  let checkCurrent :: Name -> VSType r -> SVariable r -> SVariable r
checkCurrent Name
m = if DrasilState -> Name
currentModule DrasilState
g forall a. Eq a => a -> a -> Bool
== Name
m then forall (r :: * -> *).
VariableSym r =>
VSType r -> SVariable r -> SVariable r
classVar else forall (r :: * -> *).
VariableSym r =>
VSType r -> SVariable r -> SVariable r
extClassVar
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ do
    r (Variable r)
v' <- SVariable r
v
    let nm :: Name
nm = forall (r :: * -> *). VariableElim r => r (Variable r) -> Name
variableName r (Variable r)
v'
    forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. HasCallStack => Name -> a
error forall a b. (a -> b) -> a -> b
$ Name
"Variable " forall a. [a] -> [a] -> [a]
++ Name
nm forall a. [a] -> [a] -> [a]
++ Name
" missing from export map")
      forall {r :: * -> *}.
VariableSym r =>
Name -> VSType r -> SVariable r -> SVariable r
checkCurrent (forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
nm (DrasilState -> ModExportMap
eMap DrasilState
g)) (forall a b s. (a -> b) -> State s a -> State s b
onStateValue forall (r :: * -> *).
VariableElim r =>
r (Variable r) -> r (Type r)
variableType SVariable r
c) SVariable r
v

-- | Generates a GOOL Value for a variable represented by a 'CodeVarChunk'.
mkVal :: (OOProg r) => CodeVarChunk -> GenState (SValue r)
mkVal :: forall (r :: * -> *). OOProg r => Input -> GenState (SValue r)
mkVal Input
v = do
  CodeType
t <- forall c. HasSpace c => c -> GenState CodeType
codeType Input
v
  let toGOOLVal :: Maybe c -> GenState (SValue r)
toGOOLVal Maybe c
Nothing = forall (r :: * -> *).
OOProg r =>
UID -> Name -> VSType r -> GenState (SValue r)
value (Input
v forall s a. s -> Getting a s a -> a
^. forall c. HasUID c => Lens' c UID
uid) (forall c. CodeIdea c => c -> Name
codeName Input
v) (forall (r :: * -> *). TypeSym r => CodeType -> VSType r
convType CodeType
t)
      toGOOLVal (Just c
o) = do
        CodeType
ot <- forall c. HasSpace c => c -> GenState CodeType
codeType c
o
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
valueOf forall a b. (a -> b) -> a -> b
$ forall (r :: * -> *).
VariableSym r =>
SVariable r -> SVariable r -> SVariable r
objVar (forall (r :: * -> *).
VariableSym r =>
Name -> VSType r -> SVariable r
var (forall c. CodeIdea c => c -> Name
codeName c
o) (forall (r :: * -> *). TypeSym r => CodeType -> VSType r
convType CodeType
ot))
          (forall (r :: * -> *).
VariableSym r =>
Name -> VSType r -> SVariable r
var (forall c. CodeIdea c => c -> Name
codeName Input
v) (forall (r :: * -> *). TypeSym r => CodeType -> VSType r
convType CodeType
t))
  forall {r :: * -> *} {c}.
(OOProg r, HasSpace c, CodeIdea c) =>
Maybe c -> GenState (SValue r)
toGOOLVal (Input
v forall s a. s -> Getting a s a -> a
^. Lens' Input (Maybe CodeChunk)
obv)

-- | Generates a GOOL Variable for a variable represented by a 'CodeVarChunk'.
mkVar :: (OOProg r) => CodeVarChunk -> GenState (SVariable r)
mkVar :: forall (r :: * -> *). OOProg r => Input -> GenState (SVariable r)
mkVar Input
v = do
  CodeType
t <- forall c. HasSpace c => c -> GenState CodeType
codeType Input
v
  let toGOOLVar :: Maybe c -> GenState (SVariable r)
toGOOLVar Maybe c
Nothing = forall (r :: * -> *).
OOProg r =>
Name -> VSType r -> GenState (SVariable r)
variable (forall c. CodeIdea c => c -> Name
codeName Input
v) (forall (r :: * -> *). TypeSym r => CodeType -> VSType r
convType CodeType
t)
      toGOOLVar (Just c
o) = do
        CodeType
ot <- forall c. HasSpace c => c -> GenState CodeType
codeType c
o
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (r :: * -> *).
VariableSym r =>
SVariable r -> SVariable r -> SVariable r
objVar (forall (r :: * -> *).
VariableSym r =>
Name -> VSType r -> SVariable r
var (forall c. CodeIdea c => c -> Name
codeName c
o) (forall (r :: * -> *). TypeSym r => CodeType -> VSType r
convType CodeType
ot))
          (forall (r :: * -> *).
VariableSym r =>
Name -> VSType r -> SVariable r
var (forall c. CodeIdea c => c -> Name
codeName Input
v) (forall (r :: * -> *). TypeSym r => CodeType -> VSType r
convType CodeType
t))
  forall {r :: * -> *} {c}.
(OOProg r, HasSpace c, CodeIdea c) =>
Maybe c -> GenState (SVariable r)
toGOOLVar (Input
v forall s a. s -> Getting a s a -> a
^. Lens' Input (Maybe CodeChunk)
obv)

-- | Generates a GOOL Parameter for a parameter represented by a 'ParameterChunk'.
mkParam :: (OOProg r) => ParameterChunk -> GenState (MSParameter r)
mkParam :: forall (r :: * -> *).
OOProg r =>
ParameterChunk -> GenState (MSParameter r)
mkParam ParameterChunk
p = do
  VS (r (Variable r))
v <- forall (r :: * -> *). OOProg r => Input -> GenState (SVariable r)
mkVar (forall c. (Quantity c, MayHaveUnit c) => c -> Input
quantvar ParameterChunk
p)
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall {r :: * -> *}.
ParameterSym r =>
PassBy -> VS (r (Variable r)) -> MS (r (Parameter r))
paramFunc (ParameterChunk -> PassBy
passBy ParameterChunk
p) VS (r (Variable r))
v
  where paramFunc :: PassBy -> VS (r (Variable r)) -> MS (r (Parameter r))
paramFunc PassBy
Ref = forall (r :: * -> *).
ParameterSym r =>
SVariable r -> MSParameter r
pointerParam
        paramFunc PassBy
Val = forall (r :: * -> *).
ParameterSym r =>
SVariable r -> MSParameter r
param

-- | Generates a public function.
publicFunc :: (OOProg r) => Label -> VSType r -> Description ->
  [ParameterChunk] -> Maybe Description -> [MSBlock r] ->
  GenState (SMethod r)
publicFunc :: forall (r :: * -> *).
OOProg r =>
Name
-> VSType r
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MSBlock r]
-> GenState (SMethod r)
publicFunc Name
n VSType r
t = forall (r :: * -> *).
OOProg r =>
([MSParameter r] -> MSBody r -> SMethod r)
-> Name
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MSBlock r]
-> GenState (SMethod r)
genMethod (forall (r :: * -> *).
MethodSym r =>
Name
-> r (Scope r)
-> VSType r
-> [MSParameter r]
-> MSBody r
-> SMethod r
function Name
n forall (r :: * -> *). ScopeSym r => r (Scope r)
public VSType r
t) Name
n

-- | Generates a public method.
publicMethod :: (OOProg r) => Label -> VSType r -> Description ->
  [ParameterChunk] -> Maybe Description -> [MSBlock r] ->
  GenState (SMethod r)
publicMethod :: forall (r :: * -> *).
OOProg r =>
Name
-> VSType r
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MSBlock r]
-> GenState (SMethod r)
publicMethod Name
n VSType r
t = forall (r :: * -> *).
OOProg r =>
([MSParameter r] -> MSBody r -> SMethod r)
-> Name
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MSBlock r]
-> GenState (SMethod r)
genMethod (forall (r :: * -> *).
MethodSym r =>
Name
-> r (Scope r)
-> r (Permanence r)
-> VSType r
-> [MSParameter r]
-> MSBody r
-> SMethod r
method Name
n forall (r :: * -> *). ScopeSym r => r (Scope r)
public forall (r :: * -> *). PermanenceSym r => r (Permanence r)
dynamic VSType r
t) Name
n

-- | Generates a private method.
privateMethod :: (OOProg r) => Label -> VSType r -> Description ->
  [ParameterChunk] -> Maybe Description -> [MSBlock r] ->
  GenState (SMethod r)
privateMethod :: forall (r :: * -> *).
OOProg r =>
Name
-> VSType r
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MSBlock r]
-> GenState (SMethod r)
privateMethod Name
n VSType r
t = forall (r :: * -> *).
OOProg r =>
([MSParameter r] -> MSBody r -> SMethod r)
-> Name
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MSBlock r]
-> GenState (SMethod r)
genMethod (forall (r :: * -> *).
MethodSym r =>
Name
-> r (Scope r)
-> r (Permanence r)
-> VSType r
-> [MSParameter r]
-> MSBody r
-> SMethod r
method Name
n forall (r :: * -> *). ScopeSym r => r (Scope r)
private forall (r :: * -> *). PermanenceSym r => r (Permanence r)
dynamic VSType r
t) Name
n

-- | Generates a public function, defined by its inputs and outputs.
publicInOutFunc :: (OOProg r) => Label -> Description -> [CodeVarChunk] ->
  [CodeVarChunk] -> [MSBlock r] -> GenState (SMethod r)
publicInOutFunc :: forall (r :: * -> *).
OOProg r =>
Name
-> Name
-> [Input]
-> [Input]
-> [MSBlock r]
-> GenState (SMethod r)
publicInOutFunc Name
n = forall (r :: * -> *).
OOProg r =>
([SVariable r]
 -> [SVariable r] -> [SVariable r] -> MSBody r -> SMethod r)
-> (Name
    -> [(Name, SVariable r)]
    -> [(Name, SVariable r)]
    -> [(Name, SVariable r)]
    -> MSBody r
    -> SMethod r)
-> Name
-> Name
-> [Input]
-> [Input]
-> [MSBlock r]
-> GenState (SMethod r)
genInOutFunc (forall (r :: * -> *).
MethodSym r =>
Name -> r (Scope r) -> InOutFunc r
inOutFunc Name
n forall (r :: * -> *). ScopeSym r => r (Scope r)
public) (forall (r :: * -> *).
MethodSym r =>
Name -> r (Scope r) -> DocInOutFunc r
docInOutFunc Name
n forall (r :: * -> *). ScopeSym r => r (Scope r)
public) Name
n

-- | Generates a private method, defined by its inputs and outputs.
privateInOutMethod :: (OOProg r) => Label -> Description -> [CodeVarChunk] ->
  [CodeVarChunk] -> [MSBlock r] -> GenState (SMethod r)
privateInOutMethod :: forall (r :: * -> *).
OOProg r =>
Name
-> Name
-> [Input]
-> [Input]
-> [MSBlock r]
-> GenState (SMethod r)
privateInOutMethod Name
n = forall (r :: * -> *).
OOProg r =>
([SVariable r]
 -> [SVariable r] -> [SVariable r] -> MSBody r -> SMethod r)
-> (Name
    -> [(Name, SVariable r)]
    -> [(Name, SVariable r)]
    -> [(Name, SVariable r)]
    -> MSBody r
    -> SMethod r)
-> Name
-> Name
-> [Input]
-> [Input]
-> [MSBlock r]
-> GenState (SMethod r)
genInOutFunc (forall (r :: * -> *).
MethodSym r =>
Name -> r (Scope r) -> r (Permanence r) -> InOutFunc r
inOutMethod Name
n forall (r :: * -> *). ScopeSym r => r (Scope r)
private forall (r :: * -> *). PermanenceSym r => r (Permanence r)
dynamic) (forall (r :: * -> *).
MethodSym r =>
Name -> r (Scope r) -> r (Permanence r) -> DocInOutFunc r
docInOutMethod Name
n forall (r :: * -> *). ScopeSym r => r (Scope r)
private forall (r :: * -> *). PermanenceSym r => r (Permanence r)
dynamic) Name
n

-- | Generates a constructor.
genConstructor :: (OOProg r) => Label -> Description -> [ParameterChunk] ->
  [MSBlock r] -> GenState (SMethod r)
genConstructor :: forall (r :: * -> *).
OOProg r =>
Name
-> Name -> [ParameterChunk] -> [MSBlock r] -> GenState (SMethod r)
genConstructor Name
n Name
desc [ParameterChunk]
p = forall (r :: * -> *).
OOProg r =>
([MSParameter r] -> MSBody r -> SMethod r)
-> Name
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MSBlock r]
-> GenState (SMethod r)
genMethod forall (r :: * -> *).
MethodSym r =>
[MSParameter r] -> MSBody r -> SMethod r
nonInitConstructor Name
n Name
desc [ParameterChunk]
p forall a. Maybe a
Nothing

-- | Generates a constructor that includes initialization of variables.
genInitConstructor :: (OOProg r) => Label -> Description -> [ParameterChunk]
  -> Initializers r -> [MSBlock r] -> GenState (SMethod r)
genInitConstructor :: forall (r :: * -> *).
OOProg r =>
Name
-> Name
-> [ParameterChunk]
-> Initializers r
-> [MSBlock r]
-> GenState (SMethod r)
genInitConstructor Name
n Name
desc [ParameterChunk]
p Initializers r
is = forall (r :: * -> *).
OOProg r =>
([MSParameter r] -> MSBody r -> SMethod r)
-> Name
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MSBlock r]
-> GenState (SMethod r)
genMethod (forall (r :: * -> *).
MethodSym r =>
[MSParameter r] -> Initializers r -> MSBody r -> SMethod r
`constructor` Initializers r
is) Name
n Name
desc [ParameterChunk]
p
  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) => ([MSParameter r] -> MSBody r -> SMethod r) ->
  Label -> Description -> [ParameterChunk] -> Maybe Description -> [MSBlock r]
  -> GenState (SMethod r)
genMethod :: forall (r :: * -> *).
OOProg r =>
([MSParameter r] -> MSBody r -> SMethod r)
-> Name
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MSBlock r]
-> GenState (SMethod r)
genMethod [MSParameter r] -> MSBody r -> SMethod r
f Name
n Name
desc [ParameterChunk]
p Maybe Name
r [MSBlock r]
b = do
  DrasilState
g <- forall s (m :: * -> *). MonadState s m => m s
get
  [VS (r (Variable r))]
vars <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (r :: * -> *). OOProg r => Input -> GenState (SVariable r)
mkVar forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. (Quantity c, MayHaveUnit c) => c -> Input
quantvar) [ParameterChunk]
p
  [MSParameter r]
ps <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (r :: * -> *).
OOProg r =>
ParameterChunk -> GenState (MSParameter r)
mkParam [ParameterChunk]
p
  MSBody r
bod <- forall (r :: * -> *).
OOProg r =>
Name -> [SVariable r] -> [MSBlock r] -> GenState (MSBody r)
logBody Name
n [VS (r (Variable r))]
vars [MSBlock r]
b
  let fn :: SMethod r
fn = [MSParameter r] -> MSBody r -> SMethod r
f [MSParameter r]
ps MSBody r
bod
  [Name]
pComms <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall c. CodeIdea c => c -> GenState Name
getComment [ParameterChunk]
p
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if Comments
CommentFunc forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` DrasilState -> [Comments]
commented DrasilState
g
    then forall (r :: * -> *).
MethodSym r =>
Name -> [Name] -> Maybe Name -> SMethod r -> SMethod r
docFunc Name
desc [Name]
pComms Maybe Name
r SMethod r
fn else SMethod r
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 scope, permanence, name, description,
-- list of inputs, list of outputs, and body.
genInOutFunc :: (OOProg r) => ([SVariable r] -> [SVariable r] ->
    [SVariable r] -> MSBody r -> SMethod r) ->
  (String -> [(String, SVariable r)] -> [(String, SVariable r)] ->
    [(String, SVariable r)] -> MSBody r -> SMethod r)
  -> Label -> Description -> [CodeVarChunk] -> [CodeVarChunk] ->
  [MSBlock r] -> GenState (SMethod r)
genInOutFunc :: forall (r :: * -> *).
OOProg r =>
([SVariable r]
 -> [SVariable r] -> [SVariable r] -> MSBody r -> SMethod r)
-> (Name
    -> [(Name, SVariable r)]
    -> [(Name, SVariable r)]
    -> [(Name, SVariable r)]
    -> MSBody r
    -> SMethod r)
-> Name
-> Name
-> [Input]
-> [Input]
-> [MSBlock r]
-> GenState (SMethod r)
genInOutFunc [SVariable r]
-> [SVariable r] -> [SVariable r] -> MSBody r -> SMethod r
f Name
-> [(Name, SVariable r)]
-> [(Name, SVariable r)]
-> [(Name, SVariable r)]
-> MSBody r
-> SMethod r
docf Name
n Name
desc [Input]
ins' [Input]
outs' [MSBlock r]
b = do
  DrasilState
g <- forall s (m :: * -> *). MonadState s m => m s
get
  let ins :: [Input]
ins = [Input]
ins' forall a. Eq a => [a] -> [a] -> [a]
\\ [Input]
outs'
      outs :: [Input]
outs = [Input]
outs' forall a. Eq a => [a] -> [a] -> [a]
\\ [Input]
ins'
      both :: [Input]
both = [Input]
ins' forall a. Eq a => [a] -> [a] -> [a]
`intersect` [Input]
outs'
  [SVariable r]
inVs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (r :: * -> *). OOProg r => Input -> GenState (SVariable r)
mkVar [Input]
ins
  [SVariable r]
outVs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (r :: * -> *). OOProg r => Input -> GenState (SVariable r)
mkVar [Input]
outs
  [SVariable r]
bothVs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (r :: * -> *). OOProg r => Input -> GenState (SVariable r)
mkVar [Input]
both
  MSBody r
bod <- forall (r :: * -> *).
OOProg r =>
Name -> [SVariable r] -> [MSBlock r] -> GenState (MSBody r)
logBody Name
n ([SVariable r]
bothVs forall a. [a] -> [a] -> [a]
++ [SVariable r]
inVs) [MSBlock r]
b
  [Name]
pComms <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall c. CodeIdea c => c -> GenState Name
getComment [Input]
ins
  [Name]
oComms <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall c. CodeIdea c => c -> GenState Name
getComment [Input]
outs
  [Name]
bComms <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall c. CodeIdea c => c -> GenState Name
getComment [Input]
both
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if Comments
CommentFunc forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` DrasilState -> [Comments]
commented DrasilState
g
    then Name
-> [(Name, SVariable r)]
-> [(Name, SVariable r)]
-> [(Name, SVariable r)]
-> MSBody r
-> SMethod r
docf Name
desc (forall a b. [a] -> [b] -> [(a, b)]
zip [Name]
pComms [SVariable r]
inVs) (forall a b. [a] -> [b] -> [(a, b)]
zip [Name]
oComms [SVariable r]
outVs) (forall a b. [a] -> [b] -> [(a, b)]
zip
    [Name]
bComms [SVariable r]
bothVs) MSBody r
bod else [SVariable r]
-> [SVariable r] -> [SVariable r] -> MSBody r -> SMethod r
f [SVariable r]
inVs [SVariable r]
outVs [SVariable r]
bothVs MSBody r
bod

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

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

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

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

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

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

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

-- | Similar to 'unop', but for vectors.
unopVV :: (OOProg r) => UFuncVV -> (SValue r -> SValue r)
unopVV :: forall (r :: * -> *). OOProg r => UFuncVV -> SValue r -> SValue r
unopVV UFuncVV
NegV = 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 :: (OOProg r) => ArithBinOp -> (SValue r -> SValue r -> SValue r)
arithBfunc :: forall (r :: * -> *).
OOProg r =>
ArithBinOp -> SValue r -> SValue r -> SValue r
arithBfunc ArithBinOp
Pow  = forall (r :: * -> *).
NumericExpression r =>
SValue r -> SValue r -> SValue r
(#^)
arithBfunc ArithBinOp
Subt = forall (r :: * -> *).
NumericExpression r =>
SValue r -> SValue r -> SValue r
(#-)
arithBfunc ArithBinOp
Frac = forall (r :: * -> *).
NumericExpression r =>
SValue r -> SValue r -> SValue r
(#/)

-- Maps a 'BoolBinOp' to it's corresponding GOOL binary function.
boolBfunc :: BoolBinOp -> (SValue r -> SValue r -> SValue r)
boolBfunc :: forall (r :: * -> *). BoolBinOp -> SValue r -> SValue r -> SValue r
boolBfunc BoolBinOp
Impl = forall a. HasCallStack => Name -> a
error Name
"convExpr :=>"
boolBfunc BoolBinOp
Iff  = forall a. HasCallStack => Name -> a
error Name
"convExpr :<=>"

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

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

-- Maps an 'OrdBinOp' to it's corresponding GOOL binary function.
ordBfunc :: (OOProg r) => OrdBinOp -> (SValue r -> SValue r -> SValue r)
ordBfunc :: forall (r :: * -> *).
OOProg r =>
OrdBinOp -> SValue r -> SValue r -> SValue r
ordBfunc OrdBinOp
Gt  = forall (r :: * -> *).
Comparison r =>
SValue r -> SValue r -> SValue r
(?>)
ordBfunc OrdBinOp
Lt  = forall (r :: * -> *).
Comparison r =>
SValue r -> SValue r -> SValue r
(?<)
ordBfunc OrdBinOp
LEq = forall (r :: * -> *).
Comparison r =>
SValue r -> SValue r -> SValue r
(?<=)
ordBfunc OrdBinOp
GEq = 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 = forall a. HasCallStack => Name -> a
error Name
"bfunc: Cross not implemented"
vecVecVecBfunc VVVBinOp
VAdd = forall a. HasCallStack => Name -> a
error Name
"bfunc: Vector addition not implemented"
vecVecVecBfunc VVVBinOp
VSub = 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 = 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 = forall a. HasCallStack => Name -> a
error Name
"convExpr Scaling of Vectors"

-- medium hacks --

-- | Converts a 'Mod' to GOOL.
genModDef :: (OOProg r) => Mod -> GenState (SFile r)
genModDef :: forall (r :: * -> *). OOProg r => Mod -> GenState (SFile r)
genModDef (Mod Name
n Name
desc [Name]
is [Class]
cs [Func]
fs) = forall (r :: * -> *).
OOProg r =>
Name
-> Name
-> [Name]
-> [GenState (Maybe (SMethod r))]
-> [GenState (Maybe (SClass r))]
-> GenState (SFile r)
genModuleWithImports Name
n Name
desc [Name]
is (forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
  forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (r :: * -> *).
OOProg r =>
(Name
 -> VSType r
 -> Name
 -> [ParameterChunk]
 -> Maybe Name
 -> [MSBlock r]
 -> GenState (SMethod r))
-> [StateVariable] -> Func -> GenState (SMethod r)
genFunc forall (r :: * -> *).
OOProg r =>
Name
-> VSType r
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MSBlock r]
-> GenState (SMethod r)
publicFunc []) [Func]
fs)
  (case [Class]
cs of [] -> []
              (Class
cl:[Class]
cls) -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just (forall (r :: * -> *).
OOProg r =>
(Name
 -> Maybe Name
 -> Name
 -> [CSStateVar r]
 -> GenState [SMethod r]
 -> GenState (SClass r))
-> Class -> GenState (SClass r)
genClass forall (r :: * -> *).
OOProg r =>
Name
-> Maybe Name
-> Name
-> [CSStateVar r]
-> GenState [SMethod r]
-> GenState (SClass r)
primaryClass Class
cl) forall a. a -> [a] -> [a]
:
                forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (r :: * -> *).
OOProg r =>
(Name
 -> Maybe Name
 -> Name
 -> [CSStateVar r]
 -> GenState [SMethod r]
 -> GenState (SClass r))
-> Class -> GenState (SClass r)
genClass forall (r :: * -> *).
OOProg r =>
Name
-> Maybe Name
-> Name
-> [CSStateVar r]
-> GenState [SMethod r]
-> GenState (SClass r)
auxClass) [Class]
cls)

-- | Converts a 'Mod'\'s functions to GOOL.
genModFuncs :: (OOProg r) => Mod -> [GenState (SMethod r)]
genModFuncs :: forall (r :: * -> *). OOProg r => Mod -> [GenState (SMethod r)]
genModFuncs (Mod Name
_ Name
_ [Name]
_ [Class]
_ [Func]
fs) = forall a b. (a -> b) -> [a] -> [b]
map (forall (r :: * -> *).
OOProg r =>
(Name
 -> VSType r
 -> Name
 -> [ParameterChunk]
 -> Maybe Name
 -> [MSBlock r]
 -> GenState (SMethod r))
-> [StateVariable] -> Func -> GenState (SMethod r)
genFunc forall (r :: * -> *).
OOProg r =>
Name
-> VSType r
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MSBlock r]
-> GenState (SMethod r)
publicFunc []) [Func]
fs

-- | Converts a 'Mod'\'s classes to GOOL.
genModClasses :: (OOProg r) => Mod -> [GenState (SClass r)]
genModClasses :: forall (r :: * -> *). OOProg r => Mod -> [GenState (SClass r)]
genModClasses (Mod Name
_ Name
_ [Name]
_ [Class]
cs [Func]
_) = forall a b. (a -> b) -> [a] -> [b]
map (forall (r :: * -> *).
OOProg r =>
(Name
 -> Maybe Name
 -> Name
 -> [CSStateVar r]
 -> GenState [SMethod r]
 -> GenState (SClass r))
-> Class -> GenState (SClass r)
genClass forall (r :: * -> *).
OOProg r =>
Name
-> Maybe Name
-> Name
-> [CSStateVar r]
-> GenState [SMethod r]
-> GenState (SClass r)
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) => (Name -> Maybe Name -> Description -> [CSStateVar r]
  -> GenState [SMethod r] -> GenState (SClass r)) ->
  M.Class -> GenState (SClass r)
genClass :: forall (r :: * -> *).
OOProg r =>
(Name
 -> Maybe Name
 -> Name
 -> [CSStateVar r]
 -> GenState [SMethod r]
 -> GenState (SClass r))
-> Class -> GenState (SClass r)
genClass Name
-> Maybe Name
-> Name
-> [CSStateVar r]
-> GenState [SMethod r]
-> GenState (SClass r)
f (M.ClassDef Name
n Maybe Name
i Name
desc [StateVariable]
svs [Func]
ms) = let svar :: ScopeTag -> SVariable r -> CSStateVar r
svar ScopeTag
Pub = forall (r :: * -> *). StateVarSym r => SVariable r -> CSStateVar r
pubDVar
                                              svar ScopeTag
Priv = forall (r :: * -> *). StateVarSym r => SVariable r -> CSStateVar r
privDVar
  in do
  [CSStateVar r]
svrs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(SV ScopeTag
s Input
v) -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall {r :: * -> *}.
StateVarSym r =>
ScopeTag -> SVariable r -> CSStateVar r
svar ScopeTag
s forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (r :: * -> *).
VariableSym r =>
Name -> VSType r -> SVariable r
var (forall c. CodeIdea c => c -> Name
codeName Input
v) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (r :: * -> *). TypeSym r => CodeType -> VSType r
convType)
    (forall c. HasSpace c => c -> GenState CodeType
codeType Input
v)) [StateVariable]
svs
  Name
-> Maybe Name
-> Name
-> [CSStateVar r]
-> GenState [SMethod r]
-> GenState (SClass r)
f Name
n Maybe Name
i Name
desc [CSStateVar r]
svrs (forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (r :: * -> *).
OOProg r =>
(Name
 -> VSType r
 -> Name
 -> [ParameterChunk]
 -> Maybe Name
 -> [MSBlock r]
 -> GenState (SMethod r))
-> [StateVariable] -> Func -> GenState (SMethod r)
genFunc forall (r :: * -> *).
OOProg r =>
Name
-> VSType r
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MSBlock r]
-> GenState (SMethod r)
publicMethod [StateVariable]
svs) [Func]
ms)

-- | Converts a 'Func' (from the Mod AST) to GOOL.
-- The function generator to use is passed as a parameter. Automatically adds
-- variable declaration statements for any undeclared variables. For methods,
-- the list of StateVariables is needed so they can be included in the list of
-- declared variables.
genFunc :: (OOProg r) => (Name -> VSType r -> Description -> [ParameterChunk]
  -> Maybe Description -> [MSBlock r] -> GenState (SMethod r)) ->
  [StateVariable] -> Func -> GenState (SMethod r)
genFunc :: forall (r :: * -> *).
OOProg r =>
(Name
 -> VSType r
 -> Name
 -> [ParameterChunk]
 -> Maybe Name
 -> [MSBlock r]
 -> GenState (SMethod r))
-> [StateVariable] -> Func -> GenState (SMethod r)
genFunc Name
-> VSType r
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MSBlock r]
-> GenState (SMethod r)
f [StateVariable]
svs (FDef (FuncDef Name
n Name
desc [ParameterChunk]
parms Space
o Maybe Name
rd [FuncStmt]
s)) = do
  DrasilState
g <- forall s (m :: * -> *). MonadState s m => m s
get
  [MS (r (Statement r))]
stmts <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (r :: * -> *).
OOProg r =>
FuncStmt -> GenState (MSStatement r)
convStmt [FuncStmt]
s
  [VS (r (Variable r))]
vars <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (r :: * -> *). OOProg r => Input -> GenState (SVariable r)
mkVar (ChunkDB -> [FuncStmt] -> [Input]
fstdecl (CodeSpec -> ChunkDB
sysinfodb forall a b. (a -> b) -> a -> b
$ DrasilState -> CodeSpec
codeSpec DrasilState
g) [FuncStmt]
s
    forall a. Eq a => [a] -> [a] -> [a]
\\ (forall a b. (a -> b) -> [a] -> [b]
map forall c. (Quantity c, MayHaveUnit c) => c -> Input
quantvar [ParameterChunk]
parms forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map StateVariable -> Input
stVar [StateVariable]
svs))
  CodeType
t <- Space -> GenState CodeType
spaceCodeType Space
o
  Name
-> VSType r
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MSBlock r]
-> GenState (SMethod r)
f Name
n (forall (r :: * -> *). TypeSym r => CodeType -> VSType r
convType CodeType
t) Name
desc [ParameterChunk]
parms Maybe Name
rd [forall (r :: * -> *). BlockSym r => [MSStatement r] -> MSBlock r
block forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall (r :: * -> *).
DeclStatement r =>
SVariable r -> MSStatement r
varDec [VS (r (Variable r))]
vars, forall (r :: * -> *). BlockSym r => [MSStatement r] -> MSBlock r
block [MS (r (Statement r))]
stmts]
genFunc Name
-> VSType r
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MSBlock r]
-> GenState (SMethod r)
_ [StateVariable]
svs (FDef (CtorDef Name
n Name
desc [ParameterChunk]
parms [Initializer]
i [FuncStmt]
s)) = do
  DrasilState
g <- forall s (m :: * -> *). MonadState s m => m s
get
  [VS (r (Value r))]
inits <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (r :: * -> *). OOProg r => CodeExpr -> GenState (SValue r)
convExpr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [Initializer]
i
  [VS (r (Variable r))]
initvars <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((\Input
iv -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (r :: * -> *).
VariableSym r =>
Name -> VSType r -> SVariable r
var (forall c. CodeIdea c => c -> Name
codeName Input
iv) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (r :: * -> *). TypeSym r => CodeType -> VSType r
convType) (forall c. HasSpace c => c -> GenState CodeType
codeType Input
iv))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [Initializer]
i
  [MS (r (Statement r))]
stmts <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (r :: * -> *).
OOProg r =>
FuncStmt -> GenState (MSStatement r)
convStmt [FuncStmt]
s
  [VS (r (Variable r))]
vars <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (r :: * -> *). OOProg r => Input -> GenState (SVariable r)
mkVar (ChunkDB -> [FuncStmt] -> [Input]
fstdecl (CodeSpec -> ChunkDB
sysinfodb forall a b. (a -> b) -> a -> b
$ DrasilState -> CodeSpec
codeSpec DrasilState
g) [FuncStmt]
s
    forall a. Eq a => [a] -> [a] -> [a]
\\ (forall a b. (a -> b) -> [a] -> [b]
map forall c. (Quantity c, MayHaveUnit c) => c -> Input
quantvar [ParameterChunk]
parms forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map StateVariable -> Input
stVar [StateVariable]
svs))
  forall (r :: * -> *).
OOProg r =>
Name
-> Name
-> [ParameterChunk]
-> Initializers r
-> [MSBlock r]
-> GenState (SMethod r)
genInitConstructor Name
n Name
desc [ParameterChunk]
parms (forall a b. [a] -> [b] -> [(a, b)]
zip [VS (r (Variable r))]
initvars [VS (r (Value r))]
inits)
    [forall (r :: * -> *). BlockSym r => [MSStatement r] -> MSBlock r
block forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall (r :: * -> *).
DeclStatement r =>
SVariable r -> MSStatement r
varDec [VS (r (Variable r))]
vars, forall (r :: * -> *). BlockSym r => [MSStatement r] -> MSBlock r
block [MS (r (Statement r))]
stmts]
genFunc Name
-> VSType r
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MSBlock r]
-> GenState (SMethod r)
_ [StateVariable]
_ (FData (FuncData Name
n Name
desc DataDesc
ddef)) = forall (r :: * -> *).
OOProg r =>
Name -> Name -> DataDesc -> GenState (SMethod r)
genDataFunc Name
n Name
desc DataDesc
ddef

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

-- | Generates a function that reads a file whose format is based on the passed
-- 'DataDesc'.
genDataFunc :: (OOProg r) => Name -> Description -> DataDesc ->
  GenState (SMethod r)
genDataFunc :: forall (r :: * -> *).
OOProg r =>
Name -> Name -> DataDesc -> GenState (SMethod r)
genDataFunc Name
nameTitle Name
desc DataDesc
ddef = do
  let parms :: [Input]
parms = DataDesc -> [Input]
getInputs DataDesc
ddef
  [MS (r (Block r))]
bod <- forall (r :: * -> *). OOProg r => DataDesc -> GenState [MSBlock r]
readData DataDesc
ddef
  forall (r :: * -> *).
OOProg r =>
Name
-> VSType r
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MSBlock r]
-> GenState (SMethod r)
publicFunc Name
nameTitle forall (r :: * -> *). TypeSym r => VSType r
void Name
desc (forall a b. (a -> b) -> [a] -> [b]
map forall c. CodeIdea c => c -> ParameterChunk
pcAuto forall a b. (a -> b) -> a -> b
$ forall c. (Quantity c, MayHaveUnit c) => c -> Input
quantvar QuantityDict
inFileName forall a. a -> [a] -> [a]
: [Input]
parms)
    forall a. Maybe a
Nothing [MS (r (Block r))]
bod

-- this is really ugly!!
-- | Read from a data description into a 'MSBlock' of 'MSStatement's.
readData :: (OOProg r) => DataDesc -> GenState [MSBlock r]
readData :: forall (r :: * -> *). OOProg r => DataDesc -> GenState [MSBlock r]
readData DataDesc
ddef = do
  [[MS (r (Statement r))]]
inD <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (r :: * -> *). OOProg r => Data -> GenState [MSStatement r]
inData DataDesc
ddef
  VS (r (Value r))
v_filename <- forall (r :: * -> *). OOProg r => Input -> GenState (SValue r)
mkVal forall a b. (a -> b) -> a -> b
$ forall c. (Quantity c, MayHaveUnit c) => c -> Input
quantvar QuantityDict
inFileName
  forall (m :: * -> *) a. Monad m => a -> m a
return [forall (r :: * -> *). BlockSym r => [MSStatement r] -> MSBlock r
block forall a b. (a -> b) -> a -> b
$
    forall (r :: * -> *).
DeclStatement r =>
SVariable r -> MSStatement r
varDec forall (r :: * -> *). OOProg r => SVariable r
var_infile forall a. a -> [a] -> [a]
:
    (if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Data
d -> Data -> Bool
isLine Data
d Bool -> Bool -> Bool
|| Data -> Bool
isLines Data
d) DataDesc
ddef then [forall (r :: * -> *).
DeclStatement r =>
SVariable r -> MSStatement r
varDec forall (r :: * -> *). OOProg r => SVariable r
var_line, forall (r :: * -> *).
DeclStatement r =>
Integer -> SVariable r -> MSStatement r
listDec Integer
0 forall (r :: * -> *). OOProg r => SVariable r
var_linetokens] else []) forall a. [a] -> [a] -> [a]
++
    [forall (r :: * -> *).
DeclStatement r =>
Integer -> SVariable r -> MSStatement r
listDec Integer
0 forall (r :: * -> *). OOProg r => SVariable r
var_lines | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Data -> Bool
isLines DataDesc
ddef] forall a. [a] -> [a] -> [a]
++
    forall (r :: * -> *).
IOStatement r =>
SVariable r -> SValue r -> MSStatement r
openFileR forall (r :: * -> *). OOProg r => SVariable r
var_infile VS (r (Value r))
v_filename forall a. a -> [a] -> [a]
:
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[MS (r (Statement r))]]
inD forall a. [a] -> [a] -> [a]
++ [
    forall (r :: * -> *). IOStatement r => SValue r -> MSStatement r
closeFile forall (r :: * -> *). OOProg r => SValue r
v_infile ]]
  where inData :: (OOProg r) => Data -> GenState [MSStatement r]
        inData :: forall (r :: * -> *). OOProg r => Data -> GenState [MSStatement r]
inData (Singleton Input
v) = do
            VS (r (Variable r))
vv <- forall (r :: * -> *). OOProg r => Input -> GenState (SVariable r)
mkVar Input
v
            [MSStatement r]
l <- forall (r :: * -> *).
OOProg r =>
SVariable r -> GenState [MSStatement r]
maybeLog VS (r (Variable r))
vv
            forall (m :: * -> *) a. Monad m => a -> m a
return [forall (r :: * -> *).
StatementSym r =>
[MSStatement r] -> MSStatement r
multi forall a b. (a -> b) -> a -> b
$ forall (r :: * -> *).
IOStatement r =>
SValue r -> SVariable r -> MSStatement r
getFileInput forall (r :: * -> *). OOProg r => SValue r
v_infile VS (r (Variable r))
vv forall a. a -> [a] -> [a]
: [MSStatement r]
l]
        inData Data
JunkData = forall (m :: * -> *) a. Monad m => a -> m a
return [forall (r :: * -> *). IOStatement r => SValue r -> MSStatement r
discardFileLine forall (r :: * -> *). OOProg r => SValue r
v_infile]
        inData (Line LinePattern
lp Char
d) = do
          [MSStatement r]
lnI <- forall (r :: * -> *).
OOProg r =>
Maybe Name -> LinePattern -> GenState [MSStatement r]
lineData forall a. Maybe a
Nothing LinePattern
lp
          [MSStatement r]
logs <- forall (r :: * -> *).
OOProg r =>
LinePattern -> GenState [MSStatement r]
getEntryVarLogs LinePattern
lp
          forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [forall (r :: * -> *).
IOStatement r =>
SValue r -> SVariable r -> MSStatement r
getFileInputLine forall (r :: * -> *). OOProg r => SValue r
v_infile forall (r :: * -> *). OOProg r => SVariable r
var_line,
            forall (r :: * -> *).
StringStatement r =>
Char -> SVariable r -> SValue r -> MSStatement r
stringSplit Char
d forall (r :: * -> *). OOProg r => SVariable r
var_linetokens forall (r :: * -> *). OOProg r => SValue r
v_line] forall a. [a] -> [a] -> [a]
++ [MSStatement r]
lnI forall a. [a] -> [a] -> [a]
++ [MSStatement r]
logs
        inData (Lines LinePattern
lp Maybe Integer
ls Char
d) = do
          [MSStatement r]
lnV <- forall (r :: * -> *).
OOProg r =>
Maybe Name -> LinePattern -> GenState [MSStatement r]
lineData (forall a. a -> Maybe a
Just Name
"_temp") LinePattern
lp
          [MSStatement r]
logs <- forall (r :: * -> *).
OOProg r =>
LinePattern -> GenState [MSStatement r]
getEntryVarLogs LinePattern
lp
          let readLines :: Maybe Integer -> [MSStatement r]
readLines Maybe Integer
Nothing = [forall (r :: * -> *).
IOStatement r =>
SValue r -> SVariable r -> MSStatement r
getFileInputAll forall (r :: * -> *). OOProg r => SValue r
v_infile forall (r :: * -> *). OOProg r => SVariable r
var_lines,
                forall (r :: * -> *).
ControlStatement r =>
SVariable r
-> SValue r -> SValue r -> SValue r -> MSBody r -> MSStatement r
forRange forall (r :: * -> *). OOProg r => SVariable r
var_i (forall (r :: * -> *). Literal r => Integer -> SValue r
litInt Integer
0) (forall (r :: * -> *). List r => SValue r -> SValue r
listSize forall (r :: * -> *). OOProg r => SValue r
v_lines) (forall (r :: * -> *). Literal r => Integer -> SValue r
litInt Integer
1)
                  (forall (r :: * -> *). BodySym r => [MSStatement r] -> MSBody r
bodyStatements forall a b. (a -> b) -> a -> b
$ forall (r :: * -> *).
StringStatement r =>
Char -> SVariable r -> SValue r -> MSStatement r
stringSplit Char
d forall (r :: * -> *). OOProg r => SVariable r
var_linetokens (
                  forall (r :: * -> *). List r => SValue r -> SValue r -> SValue r
listAccess forall (r :: * -> *). OOProg r => SValue r
v_lines forall (r :: * -> *). OOProg r => SValue r
v_i) forall a. a -> [a] -> [a]
: [MSStatement r]
lnV)]
              readLines (Just Integer
numLines) = [forall (r :: * -> *).
ControlStatement r =>
SVariable r
-> SValue r -> SValue r -> SValue r -> MSBody r -> MSStatement r
forRange forall (r :: * -> *). OOProg r => SVariable r
var_i (forall (r :: * -> *). Literal r => Integer -> SValue r
litInt Integer
0)
                (forall (r :: * -> *). Literal r => Integer -> SValue r
litInt Integer
numLines) (forall (r :: * -> *). Literal r => Integer -> SValue r
litInt Integer
1)
                (forall (r :: * -> *). BodySym r => [MSStatement r] -> MSBody r
bodyStatements forall a b. (a -> b) -> a -> b
$
                  [forall (r :: * -> *).
IOStatement r =>
SValue r -> SVariable r -> MSStatement r
getFileInputLine forall (r :: * -> *). OOProg r => SValue r
v_infile forall (r :: * -> *). OOProg r => SVariable r
var_line,
                   forall (r :: * -> *).
StringStatement r =>
Char -> SVariable r -> SValue r -> MSStatement r
stringSplit Char
d forall (r :: * -> *). OOProg r => SVariable r
var_linetokens forall (r :: * -> *). OOProg r => SValue r
v_line
                  ] forall a. [a] -> [a] -> [a]
++ [MSStatement r]
lnV)]
          forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Maybe Integer -> [MSStatement r]
readLines Maybe Integer
ls forall a. [a] -> [a] -> [a]
++ [MSStatement r]
logs
        ---------------
        lineData :: (OOProg r) => Maybe String -> LinePattern ->
          GenState [MSStatement r]
        lineData :: forall (r :: * -> *).
OOProg r =>
Maybe Name -> LinePattern -> GenState [MSStatement r]
lineData Maybe Name
s p :: LinePattern
p@(Straight [Input]
_) = do
          [VS (r (Variable r))]
vs <- forall (r :: * -> *).
OOProg r =>
Maybe Name -> LinePattern -> GenState [SVariable r]
getEntryVars Maybe Name
s LinePattern
p
          forall (m :: * -> *) a. Monad m => a -> m a
return [forall (r :: * -> *).
StringStatement r =>
[SVariable r] -> SValue r -> MSStatement r
stringListVals [VS (r (Variable r))]
vs forall (r :: * -> *). OOProg r => SValue r
v_linetokens]
        lineData Maybe Name
s p :: LinePattern
p@(Repeat [Input]
ds) = do
          [VS (r (Variable r))]
vs <- forall (r :: * -> *).
OOProg r =>
Maybe Name -> LinePattern -> GenState [SVariable r]
getEntryVars Maybe Name
s LinePattern
p
          forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence forall a b. (a -> b) -> a -> b
$ forall (r :: * -> *).
OOProg r =>
Maybe Name -> [Input] -> [GenState (MSStatement r)]
clearTemps Maybe Name
s [Input]
ds forall a. [a] -> [a] -> [a]
++ forall (m :: * -> *) a. Monad m => a -> m a
return (forall (r :: * -> *).
StringStatement r =>
[SVariable r] -> SValue r -> MSStatement r
stringListLists [VS (r (Variable r))]
vs forall (r :: * -> *). OOProg r => SValue r
v_linetokens)
            forall a. a -> [a] -> [a]
: forall (r :: * -> *).
OOProg r =>
Maybe Name -> [Input] -> [GenState (MSStatement r)]
appendTemps Maybe Name
s [Input]
ds
        ---------------
        clearTemps :: (OOProg r) => Maybe String -> [DataItem] ->
          [GenState (MSStatement r)]
        clearTemps :: forall (r :: * -> *).
OOProg r =>
Maybe Name -> [Input] -> [GenState (MSStatement r)]
clearTemps Maybe Name
Nothing [Input]
_ = []
        clearTemps (Just Name
sfx) [Input]
es = forall a b. (a -> b) -> [a] -> [b]
map (forall (r :: * -> *).
OOProg r =>
Name -> Input -> GenState (MSStatement r)
clearTemp Name
sfx) [Input]
es
        ---------------
        clearTemp :: (OOProg r) => String -> DataItem ->
          GenState (MSStatement r)
        clearTemp :: forall (r :: * -> *).
OOProg r =>
Name -> Input -> GenState (MSStatement r)
clearTemp Name
sfx Input
v = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\CodeType
t -> forall (r :: * -> *).
DeclStatement r =>
SVariable r -> [SValue r] -> MSStatement r
listDecDef (forall (r :: * -> *).
VariableSym r =>
Name -> VSType r -> SVariable r
var (forall c. CodeIdea c => c -> Name
codeName Input
v forall a. [a] -> [a] -> [a]
++ Name
sfx)
          (forall (r :: * -> *). TypeSym r => VSType r -> VSType r
listInnerType forall a b. (a -> b) -> a -> b
$ forall (r :: * -> *). TypeSym r => CodeType -> VSType r
convType CodeType
t)) []) (forall c. HasSpace c => c -> GenState CodeType
codeType Input
v)
        ---------------
        appendTemps :: (OOProg r) => Maybe String -> [DataItem] ->
          [GenState (MSStatement r)]
        appendTemps :: forall (r :: * -> *).
OOProg r =>
Maybe Name -> [Input] -> [GenState (MSStatement r)]
appendTemps Maybe Name
Nothing [Input]
_ = []
        appendTemps (Just Name
sfx) [Input]
es = forall a b. (a -> b) -> [a] -> [b]
map (forall (r :: * -> *).
OOProg r =>
Name -> Input -> GenState (MSStatement r)
appendTemp Name
sfx) [Input]
es
        ---------------
        appendTemp :: (OOProg r) => String -> DataItem ->
          GenState (MSStatement r)
        appendTemp :: forall (r :: * -> *).
OOProg r =>
Name -> Input -> GenState (MSStatement r)
appendTemp Name
sfx Input
v = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\CodeType
t -> forall (r :: * -> *). StatementSym r => SValue r -> MSStatement r
valStmt forall a b. (a -> b) -> a -> b
$ forall (r :: * -> *). List r => SValue r -> SValue r -> SValue r
listAppend
          (forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
valueOf forall a b. (a -> b) -> a -> b
$ forall (r :: * -> *).
VariableSym r =>
Name -> VSType r -> SVariable r
var (forall c. CodeIdea c => c -> Name
codeName Input
v) (forall (r :: * -> *). TypeSym r => CodeType -> VSType r
convType CodeType
t))
          (forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
valueOf forall a b. (a -> b) -> a -> b
$ forall (r :: * -> *).
VariableSym r =>
Name -> VSType r -> SVariable r
var (forall c. CodeIdea c => c -> Name
codeName Input
v forall a. [a] -> [a] -> [a]
++ Name
sfx) (forall (r :: * -> *). TypeSym r => CodeType -> VSType r
convType CodeType
t))) (forall c. HasSpace c => c -> GenState CodeType
codeType Input
v)
        ---------------
        l_line, l_lines, l_linetokens, l_infile, l_i :: Label
        var_line, var_lines, var_linetokens, var_infile, var_i ::
          (OOProg r) => SVariable r
        v_line, v_lines, v_linetokens, v_infile, v_i ::
          (OOProg r) => SValue r
        l_line :: Name
l_line = Name
"line"
        var_line :: forall (r :: * -> *). OOProg r => SVariable r
var_line = forall (r :: * -> *).
VariableSym r =>
Name -> VSType r -> SVariable r
var Name
l_line forall (r :: * -> *). TypeSym r => VSType r
string
        v_line :: forall (r :: * -> *). OOProg r => SValue r
v_line = forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
valueOf forall (r :: * -> *). OOProg r => SVariable r
var_line
        l_lines :: Name
l_lines = Name
"lines"
        var_lines :: forall (r :: * -> *). OOProg r => SVariable r
var_lines = forall (r :: * -> *).
VariableSym r =>
Name -> VSType r -> SVariable r
var Name
l_lines (forall (r :: * -> *). TypeSym r => VSType r -> VSType r
listType forall (r :: * -> *). TypeSym r => VSType r
string)
        v_lines :: forall (r :: * -> *). OOProg r => SValue r
v_lines = forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
valueOf forall (r :: * -> *). OOProg r => SVariable r
var_lines
        l_linetokens :: Name
l_linetokens = Name
"linetokens"
        var_linetokens :: forall (r :: * -> *). OOProg r => SVariable r
var_linetokens = forall (r :: * -> *).
VariableSym r =>
Name -> VSType r -> SVariable r
var Name
l_linetokens (forall (r :: * -> *). TypeSym r => VSType r -> VSType r
listType forall (r :: * -> *). TypeSym r => VSType r
string)
        v_linetokens :: forall (r :: * -> *). OOProg r => SValue r
v_linetokens = forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
valueOf forall (r :: * -> *). OOProg r => SVariable r
var_linetokens
        l_infile :: Name
l_infile = Name
"infile"
        var_infile :: forall (r :: * -> *). OOProg r => SVariable r
var_infile = forall (r :: * -> *).
VariableSym r =>
Name -> VSType r -> SVariable r
var Name
l_infile forall (r :: * -> *). TypeSym r => VSType r
infile
        v_infile :: forall (r :: * -> *). OOProg r => SValue r
v_infile = forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
valueOf forall (r :: * -> *). OOProg r => SVariable r
var_infile
        l_i :: Name
l_i = Name
"i"
        var_i :: forall (r :: * -> *). OOProg r => SVariable r
var_i = forall (r :: * -> *).
VariableSym r =>
Name -> VSType r -> SVariable r
var Name
l_i forall (r :: * -> *). TypeSym r => VSType r
int
        v_i :: forall (r :: * -> *). OOProg r => SValue r
v_i = forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
valueOf forall (r :: * -> *). OOProg r => SVariable r
var_i

-- | Get entry variables.
getEntryVars :: (OOProg r) => Maybe String -> LinePattern ->
  GenState [SVariable r]
getEntryVars :: forall (r :: * -> *).
OOProg r =>
Maybe Name -> LinePattern -> GenState [SVariable r]
getEntryVars Maybe Name
s LinePattern
lp = forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall (r :: * -> *). OOProg r => Input -> GenState (SVariable r)
mkVar (\Name
st Input
v -> forall c. HasSpace c => c -> GenState CodeType
codeType Input
v forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (forall (r :: * -> *).
OOProg r =>
Name -> VSType r -> GenState (SVariable r)
variable
  (forall c. CodeIdea c => c -> Name
codeName Input
v forall a. [a] -> [a] -> [a]
++ Name
st) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (r :: * -> *). TypeSym r => VSType r -> VSType r
listInnerType forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (r :: * -> *). TypeSym r => CodeType -> VSType r
convType)) Maybe Name
s) (LinePattern -> [Input]
getPatternInputs LinePattern
lp)

-- | Get entry variable logs.
getEntryVarLogs :: (OOProg r) => LinePattern ->
  GenState [MSStatement r]
getEntryVarLogs :: forall (r :: * -> *).
OOProg r =>
LinePattern -> GenState [MSStatement r]
getEntryVarLogs LinePattern
lp = do
  [VS (r (Variable r))]
vs <- forall (r :: * -> *).
OOProg r =>
Maybe Name -> LinePattern -> GenState [SVariable r]
getEntryVars forall a. Maybe a
Nothing LinePattern
lp
  [[MSStatement r]]
logs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (r :: * -> *).
OOProg r =>
SVariable r -> GenState [MSStatement r]
maybeLog [VS (r (Variable r))]
vs
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[MSStatement r]]
logs