{-# LANGUAGE LambdaCase #-}
module Language.Drasil.Code.Imperative.Modules (
genMain, genMainProc, genMainFunc, genMainFuncProc, genInputClass,
genInputDerived, genInputDerivedProc, genInputMod, genInputModProc,
genInputConstraints, genInputConstraintsProc, genInputFormat,
genInputFormatProc, genConstMod, checkConstClass, genConstClass, genCalcMod,
genCalcModProc, genCalcFunc, genCalcFuncProc, genOutputMod, genOutputModProc,
genOutputFormat, genOutputFormatProc, genSampleInput
) where
import Language.Drasil (Constraint(..), RealInterval(..),
HasUID(uid), Stage(..))
import Database.Drasil (ChunkDB)
import Language.Drasil.CodeExpr.Development
import Language.Drasil.Code.Imperative.Comments (getComment)
import Language.Drasil.Code.Imperative.Descriptions (constClassDesc,
constModDesc, dvFuncDesc, inConsFuncDesc, inFmtFuncDesc, inputClassDesc,
inputConstructorDesc, inputParametersDesc, modDesc, outputFormatDesc,
woFuncDesc, calcModDesc)
import Language.Drasil.Code.Imperative.FunctionCalls (genCalcCall,
genCalcCallProc, genAllInputCalls, genAllInputCallsProc, genOutputCall,
genOutputCallProc)
import Language.Drasil.Code.Imperative.GenerateGOOL (ClassType(..), genModule,
genModuleProc, genModuleWithImports, genModuleWithImportsProc, primaryClass,
auxClass)
import Language.Drasil.Code.Imperative.Helpers (liftS, convScope)
import Language.Drasil.Code.Imperative.Import (codeType, convExpr, convExprProc,
convStmt, convStmtProc, genConstructor, mkVal, mkValProc, mkVar, mkVarProc,
privateInOutMethod, privateMethod, privateFuncProc, publicFunc,
publicFuncProc, publicInOutFunc, publicInOutFuncProc, privateInOutFuncProc,
readData, readDataProc, renderC)
import Language.Drasil.Code.Imperative.Logging (maybeLog, varLogFile)
import Language.Drasil.Code.Imperative.Parameters (getConstraintParams,
getDerivedIns, getDerivedOuts, getInConstructorParams, getInputFormatIns,
getInputFormatOuts, getCalcParams, getOutputParams)
import Language.Drasil.Code.Imperative.DrasilState (GenState, DrasilState(..),
ScopeType(..), genICName)
import Language.Drasil.Code.Imperative.GOOL.ClassInterface (AuxiliarySym(..))
import Language.Drasil.Chunk.Code (CodeIdea(codeName), CodeVarChunk, quantvar,
DefiningCodeExpr(..))
import Language.Drasil.Chunk.CodeDefinition (CodeDefinition, DefinitionType(..),
defType)
import Language.Drasil.Chunk.ConstraintMap (physLookup, sfwrLookup)
import Language.Drasil.Chunk.Parameter (pcAuto)
import Language.Drasil.Code.CodeQuantityDicts (inFileName, inParams, consts)
import Language.Drasil.Code.DataDesc (DataDesc, junkLine, singleton)
import Language.Drasil.Code.ExtLibImport (defs, imports, steps)
import Language.Drasil.Choices (Comments(..), ConstantStructure(..),
ConstantRepr(..), ConstraintBehaviour(..), ImplementationType(..),
Logging(..), Structure(..), hasSampleInput, InternalConcept(..))
import Language.Drasil.CodeSpec (HasOldCodeSpec(..))
import Language.Drasil.Expr.Development (Completeness(..))
import Language.Drasil.Printers (SingleLine(OneLine), codeExprDoc, showHasSymbImpl)
import Drasil.GOOL (MSBody, MSBlock, SVariable, SValue, MSStatement,
SMethod, CSStateVar, SClass, SharedProg, OOProg, BodySym(..), bodyStatements,
oneLiner, BlockSym(..), PermanenceSym(..), TypeSym(..), VariableSym(..),
ScopeSym(..), Literal(..), VariableValue(..), CommandLineArgs(..),
BooleanExpression(..), StatementSym(..), AssignStatement(..),
DeclStatement(..), OODeclStatement(..), objDecNewNoParams,
extObjDecNewNoParams, IOStatement(..), ControlStatement(..), ifNoElse,
VisibilitySym(..), MethodSym(..), StateVarSym(..), pubDVar, convType,
convTypeOO, VisibilityTag(..))
import qualified Drasil.GOOL as OO (SFile)
import Drasil.GProc (ProcProg)
import qualified Drasil.GProc as Proc (SFile)
import Prelude hiding (print)
import Data.List (intersperse, partition)
import Data.Map ((!), elems, member)
import qualified Data.Map as Map (lookup, filter)
import Data.Maybe (maybeToList, catMaybes)
import Control.Monad (liftM2, zipWithM)
import Control.Monad.State (get, gets, modify)
import Control.Lens ((^.))
import Text.PrettyPrint.HughesPJ (render)
import Data.Deriving.Internal (interleave)
type ConstraintCE = Constraint CodeExpr
genMain :: (OOProg r) => GenState (OO.SFile r)
genMain :: forall (r :: * -> *). OOProg r => GenState (SFile r)
genMain = String
-> String
-> [GenState (Maybe (SMethod r))]
-> [GenState (Maybe (SClass r))]
-> StateT
DrasilState Identity (StateT FileState Identity (r (File r)))
forall (r :: * -> *).
OOProg r =>
String
-> String
-> [GenState (Maybe (SMethod r))]
-> [GenState (Maybe (SClass r))]
-> GenState (SFile r)
genModule String
"Control" String
"Controls the flow of the program"
[GenState (Maybe (SMethod r))
forall (r :: * -> *). OOProg r => GenState (Maybe (SMethod r))
genMainFunc] []
genMainFunc :: (OOProg r) => GenState (Maybe (SMethod r))
genMainFunc :: forall (r :: * -> *). OOProg r => GenState (Maybe (SMethod r))
genMainFunc = do
DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
let mainFunc :: ImplementationType
-> StateT DrasilState Identity (Maybe (MS (r (Method r))))
mainFunc ImplementationType
Library = Maybe (MS (r (Method r)))
-> StateT DrasilState Identity (Maybe (MS (r (Method r))))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MS (r (Method r)))
forall a. Maybe a
Nothing
mainFunc ImplementationType
Program = do
(DrasilState -> DrasilState) -> StateT DrasilState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\DrasilState
st -> DrasilState
st {currentScope = MainFn})
VS (r (Variable r))
v_filename <- CodeVarChunk -> StateT DrasilState Identity (VS (r (Variable r)))
forall (r :: * -> *).
OOProg r =>
CodeVarChunk -> GenState (SVariable r)
mkVar (QuantityDict -> CodeVarChunk
forall c. (Quantity c, MayHaveUnit c) => c -> CodeVarChunk
quantvar QuantityDict
inFileName)
[MS (r (Statement r))]
logInFile <- VS (r (Variable r))
-> StateT DrasilState Identity [MS (r (Statement r))]
forall (r :: * -> *).
SharedProg r =>
SVariable r -> GenState [MSStatement r]
maybeLog VS (r (Variable r))
v_filename
Maybe (MS (r (Statement r)))
co <- GenState (Maybe (MS (r (Statement r))))
forall (r :: * -> *). OOProg r => GenState (Maybe (MSStatement r))
initConsts
Maybe (MS (r (Statement r)))
ip <- GenState (Maybe (MS (r (Statement r))))
forall (r :: * -> *). OOProg r => GenState (Maybe (MSStatement r))
getInputDecl
[MS (r (Statement r))]
ics <- StateT DrasilState Identity [MS (r (Statement r))]
forall (r :: * -> *). OOProg r => GenState [MSStatement r]
genAllInputCalls
[Maybe (MS (r (Statement r)))]
varDef <- (CodeDefinition -> GenState (Maybe (MS (r (Statement r)))))
-> [CodeDefinition]
-> StateT DrasilState Identity [Maybe (MS (r (Statement r)))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM CodeDefinition -> GenState (Maybe (MS (r (Statement r))))
forall (r :: * -> *).
OOProg r =>
CodeDefinition -> GenState (Maybe (MSStatement r))
genCalcCall (DrasilState -> CodeSpec
codeSpec DrasilState
g CodeSpec
-> Getting [CodeDefinition] CodeSpec [CodeDefinition]
-> [CodeDefinition]
forall s a. s -> Getting a s a -> a
^. Getting [CodeDefinition] CodeSpec [CodeDefinition]
forall c. HasOldCodeSpec c => Lens' c [CodeDefinition]
Lens' CodeSpec [CodeDefinition]
execOrderO)
Maybe (MS (r (Statement r)))
wo <- GenState (Maybe (MS (r (Statement r))))
forall (r :: * -> *). OOProg r => GenState (Maybe (MSStatement r))
genOutputCall
Maybe (MS (r (Method r)))
-> StateT DrasilState Identity (Maybe (MS (r (Method r))))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MS (r (Method r)))
-> StateT DrasilState Identity (Maybe (MS (r (Method r)))))
-> Maybe (MS (r (Method r)))
-> StateT DrasilState Identity (Maybe (MS (r (Method r))))
forall a b. (a -> b) -> a -> b
$ MS (r (Method r)) -> Maybe (MS (r (Method r)))
forall a. a -> Maybe a
Just (MS (r (Method r)) -> Maybe (MS (r (Method r))))
-> MS (r (Method r)) -> Maybe (MS (r (Method r)))
forall a b. (a -> b) -> a -> b
$ (if Comments
CommentFunc Comments -> [Comments] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` DrasilState -> [Comments]
commented DrasilState
g then MS (r (Body r)) -> MS (r (Method r))
forall (r :: * -> *). MethodSym r => MSBody r -> SMethod r
docMain else
MS (r (Body r)) -> MS (r (Method r))
forall (r :: * -> *). MethodSym r => MSBody r -> SMethod r
mainFunction) (MS (r (Body r)) -> MS (r (Method r)))
-> MS (r (Body r)) -> MS (r (Method r))
forall a b. (a -> b) -> a -> b
$ [MS (r (Statement r))] -> MS (r (Body r))
forall (r :: * -> *). BodySym r => [MSStatement r] -> MSBody r
bodyStatements ([MS (r (Statement r))] -> MS (r (Body r)))
-> [MS (r (Statement r))] -> MS (r (Body r))
forall a b. (a -> b) -> a -> b
$ [Logging] -> r (Scope r) -> [MS (r (Statement r))]
forall (r :: * -> *).
SharedProg r =>
[Logging] -> r (Scope r) -> [MSStatement r]
initLogFileVar (DrasilState -> [Logging]
logKind DrasilState
g) r (Scope r)
forall (r :: * -> *). ScopeSym r => r (Scope r)
mainFn
[MS (r (Statement r))]
-> [MS (r (Statement r))] -> [MS (r (Statement r))]
forall a. [a] -> [a] -> [a]
++ VS (r (Variable r))
-> r (Scope r) -> SValue r -> MS (r (Statement r))
forall (r :: * -> *).
DeclStatement r =>
SVariable r -> r (Scope r) -> SValue r -> MSStatement r
varDecDef VS (r (Variable r))
v_filename r (Scope r)
forall (r :: * -> *). ScopeSym r => r (Scope r)
mainFn (Integer -> SValue r
forall (r :: * -> *). CommandLineArgs r => Integer -> SValue r
arg Integer
0)
MS (r (Statement r))
-> [MS (r (Statement r))] -> [MS (r (Statement r))]
forall a. a -> [a] -> [a]
: [MS (r (Statement r))]
logInFile
[MS (r (Statement r))]
-> [MS (r (Statement r))] -> [MS (r (Statement r))]
forall a. [a] -> [a] -> [a]
++ [Maybe (MS (r (Statement r)))] -> [MS (r (Statement r))]
forall a. [Maybe a] -> [a]
catMaybes [Maybe (MS (r (Statement r)))
co, Maybe (MS (r (Statement r)))
ip] [MS (r (Statement r))]
-> [MS (r (Statement r))] -> [MS (r (Statement r))]
forall a. [a] -> [a] -> [a]
++ [MS (r (Statement r))]
ics [MS (r (Statement r))]
-> [MS (r (Statement r))] -> [MS (r (Statement r))]
forall a. [a] -> [a] -> [a]
++ [Maybe (MS (r (Statement r)))] -> [MS (r (Statement r))]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (MS (r (Statement r)))]
varDef [Maybe (MS (r (Statement r)))]
-> [Maybe (MS (r (Statement r)))] -> [Maybe (MS (r (Statement r)))]
forall a. [a] -> [a] -> [a]
++ [Maybe (MS (r (Statement r)))
wo])
ImplementationType -> GenState (Maybe (SMethod r))
forall {r :: * -> *}.
OOProg r =>
ImplementationType
-> StateT DrasilState Identity (Maybe (MS (r (Method r))))
mainFunc (ImplementationType -> GenState (Maybe (SMethod r)))
-> ImplementationType -> GenState (Maybe (SMethod r))
forall a b. (a -> b) -> a -> b
$ DrasilState -> ImplementationType
implType DrasilState
g
getInputDecl :: (OOProg r) => GenState (Maybe (MSStatement r))
getInputDecl :: forall (r :: * -> *). OOProg r => GenState (Maybe (MSStatement r))
getInputDecl = do
DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
let scp :: r (Scope r)
scp = ScopeType -> r (Scope r)
forall (r :: * -> *). SharedProg r => ScopeType -> r (Scope r)
convScope (ScopeType -> r (Scope r)) -> ScopeType -> r (Scope r)
forall a b. (a -> b) -> a -> b
$ DrasilState -> ScopeType
currentScope DrasilState
g
VS (r (Variable r))
v_params <- CodeVarChunk -> StateT DrasilState Identity (VS (r (Variable r)))
forall (r :: * -> *).
OOProg r =>
CodeVarChunk -> GenState (SVariable r)
mkVar (QuantityDict -> CodeVarChunk
forall c. (Quantity c, MayHaveUnit c) => c -> CodeVarChunk
quantvar QuantityDict
inParams)
[CodeVarChunk]
constrParams <- GenState [CodeVarChunk]
getInConstructorParams
[VS (r (Value r))]
cps <- (CodeVarChunk -> StateT DrasilState Identity (VS (r (Value r))))
-> [CodeVarChunk] -> StateT DrasilState Identity [VS (r (Value r))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM CodeVarChunk -> StateT DrasilState Identity (VS (r (Value r)))
forall (r :: * -> *).
OOProg r =>
CodeVarChunk -> GenState (SValue r)
mkVal [CodeVarChunk]
constrParams
String
cname <- InternalConcept -> GenState String
genICName InternalConcept
InputParameters
let getDecl :: ([CodeVarChunk], [CodeVarChunk])
-> GenState (Maybe (MSStatement r))
getDecl ([],[]) = ([CodeVarChunk], [CodeVarChunk])
-> ConstantRepr
-> ConstantStructure
-> GenState (Maybe (MSStatement r))
constIns ((CodeVarChunk -> Bool)
-> [CodeVarChunk] -> ([CodeVarChunk], [CodeVarChunk])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ((String -> Map String String -> Bool)
-> Map String String -> String -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> Map String String -> Bool
forall k a. Ord k => k -> Map k a -> Bool
member (DrasilState -> Map String String
eMap DrasilState
g) (String -> Bool)
-> (CodeVarChunk -> String) -> CodeVarChunk -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
CodeVarChunk -> String
forall c. CodeIdea c => c -> String
codeName) ((CodeDefinition -> CodeVarChunk)
-> [CodeDefinition] -> [CodeVarChunk]
forall a b. (a -> b) -> [a] -> [b]
map CodeDefinition -> CodeVarChunk
forall c. (Quantity c, MayHaveUnit c) => c -> CodeVarChunk
quantvar ([CodeDefinition] -> [CodeVarChunk])
-> [CodeDefinition] -> [CodeVarChunk]
forall a b. (a -> b) -> a -> b
$ DrasilState -> CodeSpec
codeSpec DrasilState
g CodeSpec
-> Getting [CodeDefinition] CodeSpec [CodeDefinition]
-> [CodeDefinition]
forall s a. s -> Getting a s a -> a
^. Getting [CodeDefinition] CodeSpec [CodeDefinition]
forall c. HasOldCodeSpec c => Lens' c [CodeDefinition]
Lens' CodeSpec [CodeDefinition]
constantsO)) (DrasilState -> ConstantRepr
conRepr DrasilState
g)
(DrasilState -> ConstantStructure
conStruct DrasilState
g)
getDecl ([],[CodeVarChunk]
ins) = do
[VS (r (Variable r))]
vars <- (CodeVarChunk -> StateT DrasilState Identity (VS (r (Variable r))))
-> [CodeVarChunk]
-> StateT DrasilState Identity [VS (r (Variable r))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM CodeVarChunk -> StateT DrasilState Identity (VS (r (Variable r)))
forall (r :: * -> *).
OOProg r =>
CodeVarChunk -> GenState (SVariable r)
mkVar [CodeVarChunk]
ins
Maybe (MSStatement r) -> GenState (Maybe (MSStatement r))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MSStatement r) -> GenState (Maybe (MSStatement r)))
-> Maybe (MSStatement r) -> GenState (Maybe (MSStatement r))
forall a b. (a -> b) -> a -> b
$ MSStatement r -> Maybe (MSStatement r)
forall a. a -> Maybe a
Just (MSStatement r -> Maybe (MSStatement r))
-> MSStatement r -> Maybe (MSStatement r)
forall a b. (a -> b) -> a -> b
$ [MSStatement r] -> MSStatement r
forall (r :: * -> *).
StatementSym r =>
[MSStatement r] -> MSStatement r
multi ([MSStatement r] -> MSStatement r)
-> [MSStatement r] -> MSStatement r
forall a b. (a -> b) -> a -> b
$ (VS (r (Variable r)) -> MSStatement r)
-> [VS (r (Variable r))] -> [MSStatement r]
forall a b. (a -> b) -> [a] -> [b]
map (VS (r (Variable r)) -> r (Scope r) -> MSStatement r
forall (r :: * -> *).
DeclStatement r =>
SVariable r -> r (Scope r) -> MSStatement r
`varDec` r (Scope r)
scp) [VS (r (Variable r))]
vars
getDecl (CodeVarChunk
i:[CodeVarChunk]
_,[]) = Maybe (MSStatement r) -> GenState (Maybe (MSStatement r))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MSStatement r) -> GenState (Maybe (MSStatement r)))
-> Maybe (MSStatement r) -> GenState (Maybe (MSStatement r))
forall a b. (a -> b) -> a -> b
$ MSStatement r -> Maybe (MSStatement r)
forall a. a -> Maybe a
Just (MSStatement r -> Maybe (MSStatement r))
-> MSStatement r -> Maybe (MSStatement r)
forall a b. (a -> b) -> a -> b
$ (if DrasilState -> String
currentModule DrasilState
g String -> String -> Bool
forall a. Eq a => a -> a -> Bool
==
DrasilState -> Map String String
eMap DrasilState
g Map String String -> String -> String
forall k a. Ord k => Map k a -> k -> a
! CodeVarChunk -> String
forall c. CodeIdea c => c -> String
codeName CodeVarChunk
i then VS (r (Variable r))
-> r (Scope r) -> [VS (r (Value r))] -> MSStatement r
forall (r :: * -> *).
OODeclStatement r =>
SVariable r -> r (Scope r) -> [SValue r] -> MSStatement r
objDecNew
else String
-> VS (r (Variable r))
-> r (Scope r)
-> [VS (r (Value r))]
-> MSStatement r
forall (r :: * -> *).
OODeclStatement r =>
String -> SVariable r -> r (Scope r) -> [SValue r] -> MSStatement r
extObjDecNew String
cname) VS (r (Variable r))
v_params r (Scope r)
scp [VS (r (Value r))]
cps
getDecl ([CodeVarChunk], [CodeVarChunk])
_ = String -> GenState (Maybe (MSStatement r))
forall a. HasCallStack => String -> a
error (String
"Inputs or constants are only partially contained in "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"a class")
constIns :: ([CodeVarChunk], [CodeVarChunk])
-> ConstantRepr
-> ConstantStructure
-> GenState (Maybe (MSStatement r))
constIns ([],[]) ConstantRepr
_ ConstantStructure
_ = Maybe (MSStatement r) -> GenState (Maybe (MSStatement r))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MSStatement r)
forall a. Maybe a
Nothing
constIns ([CodeVarChunk], [CodeVarChunk])
cs ConstantRepr
Var ConstantStructure
WithInputs = ([CodeVarChunk], [CodeVarChunk])
-> GenState (Maybe (MSStatement r))
getDecl ([CodeVarChunk], [CodeVarChunk])
cs
constIns ([CodeVarChunk], [CodeVarChunk])
_ ConstantRepr
_ ConstantStructure
_ = Maybe (MSStatement r) -> GenState (Maybe (MSStatement r))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MSStatement r)
forall a. Maybe a
Nothing
([CodeVarChunk], [CodeVarChunk])
-> GenState (Maybe (MSStatement r))
getDecl ((CodeVarChunk -> Bool)
-> [CodeVarChunk] -> ([CodeVarChunk], [CodeVarChunk])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ((String -> Map String String -> Bool)
-> Map String String -> String -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> Map String String -> Bool
forall k a. Ord k => k -> Map k a -> Bool
member (DrasilState -> Map String String
eMap DrasilState
g) (String -> Bool)
-> (CodeVarChunk -> String) -> CodeVarChunk -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CodeVarChunk -> String
forall c. CodeIdea c => c -> String
codeName)
(DrasilState -> CodeSpec
codeSpec DrasilState
g CodeSpec
-> Getting [CodeVarChunk] CodeSpec [CodeVarChunk] -> [CodeVarChunk]
forall s a. s -> Getting a s a -> a
^. Getting [CodeVarChunk] CodeSpec [CodeVarChunk]
forall c. HasOldCodeSpec c => Lens' c [CodeVarChunk]
Lens' CodeSpec [CodeVarChunk]
inputsO))
initConsts :: (OOProg r) => GenState (Maybe (MSStatement r))
initConsts :: forall (r :: * -> *). OOProg r => GenState (Maybe (MSStatement r))
initConsts = do
DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
let scp :: r (Scope r)
scp = ScopeType -> r (Scope r)
forall (r :: * -> *). SharedProg r => ScopeType -> r (Scope r)
convScope (ScopeType -> r (Scope r)) -> ScopeType -> r (Scope r)
forall a b. (a -> b) -> a -> b
$ DrasilState -> ScopeType
currentScope DrasilState
g
VS (r (Variable r))
v_consts <- CodeVarChunk -> StateT DrasilState Identity (VS (r (Variable r)))
forall (r :: * -> *).
OOProg r =>
CodeVarChunk -> GenState (SVariable r)
mkVar (QuantityDict -> CodeVarChunk
forall c. (Quantity c, MayHaveUnit c) => c -> CodeVarChunk
quantvar QuantityDict
consts)
String
cname <- InternalConcept -> GenState String
genICName InternalConcept
Constants
let cs :: [CodeDefinition]
cs = DrasilState -> CodeSpec
codeSpec DrasilState
g CodeSpec
-> Getting [CodeDefinition] CodeSpec [CodeDefinition]
-> [CodeDefinition]
forall s a. s -> Getting a s a -> a
^. Getting [CodeDefinition] CodeSpec [CodeDefinition]
forall c. HasOldCodeSpec c => Lens' c [CodeDefinition]
Lens' CodeSpec [CodeDefinition]
constantsO
getDecl :: ConstantStructure -> Structure -> GenState (Maybe (MSStatement r))
getDecl (Store Structure
Unbundled) Structure
_ = GenState (Maybe (MSStatement r))
declVars
getDecl (Store Structure
Bundled) Structure
_ = (DrasilState -> Maybe (MSStatement r))
-> GenState (Maybe (MSStatement r))
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ([CodeDefinition] -> ConstantRepr -> Maybe (MSStatement r)
forall {c}.
CodeIdea c =>
[c] -> ConstantRepr -> Maybe (MSStatement r)
declObj [CodeDefinition]
cs (ConstantRepr -> Maybe (MSStatement r))
-> (DrasilState -> ConstantRepr)
-> DrasilState
-> Maybe (MSStatement r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DrasilState -> ConstantRepr
conRepr)
getDecl ConstantStructure
WithInputs Structure
Unbundled = GenState (Maybe (MSStatement r))
declVars
getDecl ConstantStructure
WithInputs Structure
Bundled = Maybe (MSStatement r) -> GenState (Maybe (MSStatement r))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MSStatement r)
forall a. Maybe a
Nothing
getDecl ConstantStructure
Inline Structure
_ = Maybe (MSStatement r) -> GenState (Maybe (MSStatement r))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MSStatement r)
forall a. Maybe a
Nothing
declVars :: GenState (Maybe (MSStatement r))
declVars = do
[VS (r (Variable r))]
vars <- (CodeDefinition
-> StateT DrasilState Identity (VS (r (Variable r))))
-> [CodeDefinition]
-> StateT DrasilState Identity [VS (r (Variable r))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (CodeVarChunk -> StateT DrasilState Identity (VS (r (Variable r)))
forall (r :: * -> *).
OOProg r =>
CodeVarChunk -> GenState (SVariable r)
mkVar (CodeVarChunk -> StateT DrasilState Identity (VS (r (Variable r))))
-> (CodeDefinition -> CodeVarChunk)
-> CodeDefinition
-> StateT DrasilState Identity (VS (r (Variable r)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CodeDefinition -> CodeVarChunk
forall c. (Quantity c, MayHaveUnit c) => c -> CodeVarChunk
quantvar) [CodeDefinition]
cs
[VS (r (Value r))]
vals <- (CodeDefinition -> StateT DrasilState Identity (VS (r (Value r))))
-> [CodeDefinition]
-> StateT DrasilState Identity [VS (r (Value r))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (CodeExpr -> StateT DrasilState Identity (VS (r (Value r)))
forall (r :: * -> *). OOProg r => CodeExpr -> GenState (SValue r)
convExpr (CodeExpr -> StateT DrasilState Identity (VS (r (Value r))))
-> (CodeDefinition -> CodeExpr)
-> CodeDefinition
-> StateT DrasilState Identity (VS (r (Value r)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CodeDefinition
-> Getting CodeExpr CodeDefinition CodeExpr -> CodeExpr
forall s a. s -> Getting a s a -> a
^. Getting CodeExpr CodeDefinition CodeExpr
forall c. DefiningCodeExpr c => Lens' c CodeExpr
Lens' CodeDefinition CodeExpr
codeExpr)) [CodeDefinition]
cs
[[MSStatement r]]
logs <- (VS (r (Variable r))
-> StateT DrasilState Identity [MSStatement r])
-> [VS (r (Variable r))]
-> StateT DrasilState Identity [[MSStatement r]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM VS (r (Variable r)) -> StateT DrasilState Identity [MSStatement r]
forall (r :: * -> *).
SharedProg r =>
SVariable r -> GenState [MSStatement r]
maybeLog [VS (r (Variable r))]
vars
Maybe (MSStatement r) -> GenState (Maybe (MSStatement r))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MSStatement r) -> GenState (Maybe (MSStatement r)))
-> Maybe (MSStatement r) -> GenState (Maybe (MSStatement r))
forall a b. (a -> b) -> a -> b
$ MSStatement r -> Maybe (MSStatement r)
forall a. a -> Maybe a
Just (MSStatement r -> Maybe (MSStatement r))
-> MSStatement r -> Maybe (MSStatement r)
forall a b. (a -> b) -> a -> b
$ [MSStatement r] -> MSStatement r
forall (r :: * -> *).
StatementSym r =>
[MSStatement r] -> MSStatement r
multi ([MSStatement r] -> MSStatement r)
-> [MSStatement r] -> MSStatement r
forall a b. (a -> b) -> a -> b
$
(VS (r (Variable r)) -> VS (r (Value r)) -> MSStatement r)
-> [VS (r (Variable r))] -> [VS (r (Value r))] -> [MSStatement r]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\VS (r (Variable r))
vr -> ConstantRepr
-> VS (r (Variable r))
-> r (Scope r)
-> VS (r (Value r))
-> MSStatement r
forall {r :: * -> *}.
DeclStatement r =>
ConstantRepr
-> VS (r (Variable r))
-> r (Scope r)
-> VS (r (Value r))
-> MS (r (Statement r))
defFunc (DrasilState -> ConstantRepr
conRepr DrasilState
g) VS (r (Variable r))
vr r (Scope r)
scp) [VS (r (Variable r))]
vars [VS (r (Value r))]
vals [MSStatement r] -> [MSStatement r] -> [MSStatement r]
forall a. [a] -> [a] -> [a]
++ [[MSStatement r]] -> [MSStatement r]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[MSStatement r]]
logs
defFunc :: ConstantRepr
-> VS (r (Variable r))
-> r (Scope r)
-> VS (r (Value r))
-> MS (r (Statement r))
defFunc ConstantRepr
Var = VS (r (Variable r))
-> r (Scope r) -> VS (r (Value r)) -> MS (r (Statement r))
forall (r :: * -> *).
DeclStatement r =>
SVariable r -> r (Scope r) -> SValue r -> MSStatement r
varDecDef
defFunc ConstantRepr
Const = VS (r (Variable r))
-> r (Scope r) -> VS (r (Value r)) -> MS (r (Statement r))
forall (r :: * -> *).
DeclStatement r =>
SVariable r -> r (Scope r) -> SValue r -> MSStatement r
constDecDef
declObj :: [c] -> ConstantRepr -> Maybe (MSStatement r)
declObj [] ConstantRepr
_ = Maybe (MSStatement r)
forall a. Maybe a
Nothing
declObj (c
c:[c]
_) ConstantRepr
Var = MSStatement r -> Maybe (MSStatement r)
forall a. a -> Maybe a
Just (MSStatement r -> Maybe (MSStatement r))
-> MSStatement r -> Maybe (MSStatement r)
forall a b. (a -> b) -> a -> b
$ (if DrasilState -> String
currentModule DrasilState
g String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== DrasilState -> Map String String
eMap DrasilState
g Map String String -> String -> String
forall k a. Ord k => Map k a -> k -> a
! c -> String
forall c. CodeIdea c => c -> String
codeName c
c
then VS (r (Variable r)) -> r (Scope r) -> MSStatement r
forall (r :: * -> *).
OODeclStatement r =>
SVariable r -> r (Scope r) -> MSStatement r
objDecNewNoParams else String -> VS (r (Variable r)) -> r (Scope r) -> MSStatement r
forall (r :: * -> *).
OODeclStatement r =>
String -> SVariable r -> r (Scope r) -> MSStatement r
extObjDecNewNoParams String
cname) VS (r (Variable r))
v_consts r (Scope r)
scp
declObj [c]
_ ConstantRepr
Const = Maybe (MSStatement r)
forall a. Maybe a
Nothing
ConstantStructure -> Structure -> GenState (Maybe (MSStatement r))
getDecl (DrasilState -> ConstantStructure
conStruct DrasilState
g) (DrasilState -> Structure
inStruct DrasilState
g)
initLogFileVar :: (SharedProg r) => [Logging] -> r (Scope r) -> [MSStatement r]
initLogFileVar :: forall (r :: * -> *).
SharedProg r =>
[Logging] -> r (Scope r) -> [MSStatement r]
initLogFileVar [Logging]
l r (Scope r)
scp = [SVariable r -> r (Scope r) -> MSStatement r
forall (r :: * -> *).
DeclStatement r =>
SVariable r -> r (Scope r) -> MSStatement r
varDec SVariable r
forall (r :: * -> *). SharedProg r => SVariable r
varLogFile r (Scope r)
scp | Logging
LogVar Logging -> [Logging] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Logging]
l]
genInputMod :: (OOProg r) => GenState [OO.SFile r]
genInputMod :: forall (r :: * -> *). OOProg r => GenState [SFile r]
genInputMod = do
String
ipDesc <- GenState [String] -> GenState String
modDesc GenState [String]
inputParametersDesc
String
cname <- InternalConcept -> GenState String
genICName InternalConcept
InputParameters
let genMod :: (OOProg r) => Maybe (SClass r) ->
GenState (OO.SFile r)
genMod :: forall (r :: * -> *).
OOProg r =>
Maybe (SClass r) -> GenState (SFile r)
genMod Maybe (SClass r)
Nothing = String
-> String
-> [GenState (Maybe (SMethod r))]
-> [GenState (Maybe (SClass r))]
-> StateT
DrasilState Identity (StateT FileState Identity (r (File r)))
forall (r :: * -> *).
OOProg r =>
String
-> String
-> [GenState (Maybe (SMethod r))]
-> [GenState (Maybe (SClass r))]
-> GenState (SFile r)
genModule String
cname String
ipDesc [VisibilityTag -> GenState (Maybe (SMethod r))
forall (r :: * -> *).
OOProg r =>
VisibilityTag -> GenState (Maybe (SMethod r))
genInputFormat VisibilityTag
Pub,
VisibilityTag -> GenState (Maybe (SMethod r))
forall (r :: * -> *).
OOProg r =>
VisibilityTag -> GenState (Maybe (SMethod r))
genInputDerived VisibilityTag
Pub, VisibilityTag -> GenState (Maybe (SMethod r))
forall (r :: * -> *).
OOProg r =>
VisibilityTag -> GenState (Maybe (SMethod r))
genInputConstraints VisibilityTag
Pub] []
genMod Maybe (SClass r)
_ = String
-> String
-> [GenState (Maybe (SMethod r))]
-> [GenState (Maybe (SClass r))]
-> StateT
DrasilState Identity (StateT FileState Identity (r (File r)))
forall (r :: * -> *).
OOProg r =>
String
-> String
-> [GenState (Maybe (SMethod r))]
-> [GenState (Maybe (SClass r))]
-> GenState (SFile r)
genModule String
cname String
ipDesc [] [ClassType -> GenState (Maybe (SClass r))
forall (r :: * -> *).
OOProg r =>
ClassType -> GenState (Maybe (SClass r))
genInputClass ClassType
Primary]
Maybe (CS (r (Class r)))
ic <- ClassType -> StateT DrasilState Identity (Maybe (CS (r (Class r))))
forall (r :: * -> *).
OOProg r =>
ClassType -> GenState (Maybe (SClass r))
genInputClass ClassType
Primary
State DrasilState (SFile r) -> GenState [SFile r]
forall a b. State a b -> State a [b]
liftS (State DrasilState (SFile r) -> GenState [SFile r])
-> State DrasilState (SFile r) -> GenState [SFile r]
forall a b. (a -> b) -> a -> b
$ Maybe (CS (r (Class r))) -> State DrasilState (SFile r)
forall (r :: * -> *).
OOProg r =>
Maybe (SClass r) -> GenState (SFile r)
genMod Maybe (CS (r (Class r)))
ic
constVarFunc :: (OOProg r) => ConstantRepr ->
(SVariable r -> SValue r -> CSStateVar r)
constVarFunc :: forall (r :: * -> *).
OOProg r =>
ConstantRepr -> SVariable r -> SValue r -> CSStateVar r
constVarFunc ConstantRepr
Var = r (Visibility r)
-> r (Permanence r)
-> StateT ValueState Identity (r (Variable r))
-> StateT ValueState Identity (r (Value r))
-> StateT ClassState Identity (r (StateVar r))
forall (r :: * -> *).
StateVarSym r =>
r (Visibility r)
-> r (Permanence r) -> SVariable r -> SValue r -> CSStateVar r
stateVarDef r (Visibility r)
forall (r :: * -> *). VisibilitySym r => r (Visibility r)
public r (Permanence r)
forall (r :: * -> *). PermanenceSym r => r (Permanence r)
dynamic
constVarFunc ConstantRepr
Const = r (Visibility r)
-> StateT ValueState Identity (r (Variable r))
-> StateT ValueState Identity (r (Value r))
-> StateT ClassState Identity (r (StateVar r))
forall (r :: * -> *).
StateVarSym r =>
r (Visibility r) -> SVariable r -> SValue r -> CSStateVar r
constVar r (Visibility r)
forall (r :: * -> *). VisibilitySym r => r (Visibility r)
public
genInputClass :: (OOProg r) => ClassType ->
GenState (Maybe (SClass r))
genInputClass :: forall (r :: * -> *).
OOProg r =>
ClassType -> GenState (Maybe (SClass r))
genInputClass ClassType
scp = do
DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
(DrasilState -> DrasilState) -> StateT DrasilState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\DrasilState
st -> DrasilState
st {currentScope = Local})
String
cname <- InternalConcept -> GenState String
genICName InternalConcept
InputParameters
let ins :: [CodeVarChunk]
ins = DrasilState -> CodeSpec
codeSpec DrasilState
g CodeSpec
-> Getting [CodeVarChunk] CodeSpec [CodeVarChunk] -> [CodeVarChunk]
forall s a. s -> Getting a s a -> a
^. Getting [CodeVarChunk] CodeSpec [CodeVarChunk]
forall c. HasOldCodeSpec c => Lens' c [CodeVarChunk]
Lens' CodeSpec [CodeVarChunk]
inputsO
cs :: [CodeDefinition]
cs = DrasilState -> CodeSpec
codeSpec DrasilState
g CodeSpec
-> Getting [CodeDefinition] CodeSpec [CodeDefinition]
-> [CodeDefinition]
forall s a. s -> Getting a s a -> a
^. Getting [CodeDefinition] CodeSpec [CodeDefinition]
forall c. HasOldCodeSpec c => Lens' c [CodeDefinition]
Lens' CodeSpec [CodeDefinition]
constantsO
filt :: (CodeIdea c) => [c] -> [c]
filt :: forall c. CodeIdea c => [c] -> [c]
filt = (c -> Bool) -> [c] -> [c]
forall a. (a -> Bool) -> [a] -> [a]
filter ((String -> Maybe String
forall a. a -> Maybe a
Just String
cname Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
==) (Maybe String -> Bool) -> (c -> Maybe String) -> c -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Map String String -> Maybe String)
-> Map String String -> String -> Maybe String
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> Map String String -> Maybe String
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (DrasilState -> Map String String
clsMap DrasilState
g) (String -> Maybe String) -> (c -> String) -> c -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> String
forall c. CodeIdea c => c -> String
codeName)
constructors :: (OOProg r) => GenState [SMethod r]
constructors :: forall (r :: * -> *). OOProg r => GenState [SMethod r]
constructors = if String
cname String -> Set String -> Bool
forall a. Eq a => a -> Set a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` DrasilState -> Set String
defSet DrasilState
g
then [[MS (r (Method r))]] -> [MS (r (Method r))]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[MS (r (Method r))]] -> [MS (r (Method r))])
-> StateT DrasilState Identity [[MS (r (Method r))]]
-> StateT DrasilState Identity [MS (r (Method r))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (StateT DrasilState Identity (Maybe (MS (r (Method r))))
-> StateT DrasilState Identity [MS (r (Method r))])
-> [StateT DrasilState Identity (Maybe (MS (r (Method r))))]
-> StateT DrasilState Identity [[MS (r (Method r))]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((Maybe (MS (r (Method r))) -> [MS (r (Method r))])
-> StateT DrasilState Identity (Maybe (MS (r (Method r))))
-> StateT DrasilState Identity [MS (r (Method r))]
forall a b.
(a -> b)
-> StateT DrasilState Identity a -> StateT DrasilState Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe (MS (r (Method r))) -> [MS (r (Method r))]
forall a. Maybe a -> [a]
maybeToList) [StateT DrasilState Identity (Maybe (MS (r (Method r))))
forall (r :: * -> *). OOProg r => GenState (Maybe (SMethod r))
genInputConstructor]
else [MS (r (Method r))]
-> StateT DrasilState Identity [MS (r (Method r))]
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return []
methods :: (OOProg r) => GenState [SMethod r]
methods :: forall (r :: * -> *). OOProg r => GenState [SMethod r]
methods = if String
cname String -> Set String -> Bool
forall a. Eq a => a -> Set a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` DrasilState -> Set String
defSet DrasilState
g
then [[MS (r (Method r))]] -> [MS (r (Method r))]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[MS (r (Method r))]] -> [MS (r (Method r))])
-> StateT DrasilState Identity [[MS (r (Method r))]]
-> StateT DrasilState Identity [MS (r (Method r))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (StateT DrasilState Identity (Maybe (MS (r (Method r))))
-> StateT DrasilState Identity [MS (r (Method r))])
-> [StateT DrasilState Identity (Maybe (MS (r (Method r))))]
-> StateT DrasilState Identity [[MS (r (Method r))]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((Maybe (MS (r (Method r))) -> [MS (r (Method r))])
-> StateT DrasilState Identity (Maybe (MS (r (Method r))))
-> StateT DrasilState Identity [MS (r (Method r))]
forall a b.
(a -> b)
-> StateT DrasilState Identity a -> StateT DrasilState Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe (MS (r (Method r))) -> [MS (r (Method r))]
forall a. Maybe a -> [a]
maybeToList) [VisibilityTag
-> StateT DrasilState Identity (Maybe (MS (r (Method r))))
forall (r :: * -> *).
OOProg r =>
VisibilityTag -> GenState (Maybe (SMethod r))
genInputFormat VisibilityTag
Priv,
VisibilityTag
-> StateT DrasilState Identity (Maybe (MS (r (Method r))))
forall (r :: * -> *).
OOProg r =>
VisibilityTag -> GenState (Maybe (SMethod r))
genInputDerived VisibilityTag
Priv, VisibilityTag
-> StateT DrasilState Identity (Maybe (MS (r (Method r))))
forall (r :: * -> *).
OOProg r =>
VisibilityTag -> GenState (Maybe (SMethod r))
genInputConstraints VisibilityTag
Priv]
else [MS (r (Method r))]
-> StateT DrasilState Identity [MS (r (Method r))]
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return []
genClass :: (OOProg r) => [CodeVarChunk] -> [CodeDefinition] ->
GenState (Maybe (SClass r))
genClass :: forall (r :: * -> *).
OOProg r =>
[CodeVarChunk] -> [CodeDefinition] -> GenState (Maybe (SClass r))
genClass [] [] = Maybe (CS (r (Class r)))
-> StateT DrasilState Identity (Maybe (CS (r (Class r))))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (CS (r (Class r)))
forall a. Maybe a
Nothing
genClass [CodeVarChunk]
inps [CodeDefinition]
csts = do
[VS (r (Value r))]
vals <- (CodeDefinition -> StateT DrasilState Identity (VS (r (Value r))))
-> [CodeDefinition]
-> StateT DrasilState Identity [VS (r (Value r))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (CodeExpr -> StateT DrasilState Identity (VS (r (Value r)))
forall (r :: * -> *). OOProg r => CodeExpr -> GenState (SValue r)
convExpr (CodeExpr -> StateT DrasilState Identity (VS (r (Value r))))
-> (CodeDefinition -> CodeExpr)
-> CodeDefinition
-> StateT DrasilState Identity (VS (r (Value r)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CodeDefinition
-> Getting CodeExpr CodeDefinition CodeExpr -> CodeExpr
forall s a. s -> Getting a s a -> a
^. Getting CodeExpr CodeDefinition CodeExpr
forall c. DefiningCodeExpr c => Lens' c CodeExpr
Lens' CodeDefinition CodeExpr
codeExpr)) [CodeDefinition]
csts
[CS (r (StateVar r))]
inputVars <- (CodeVarChunk -> StateT DrasilState Identity (CS (r (StateVar r))))
-> [CodeVarChunk]
-> StateT DrasilState Identity [CS (r (StateVar r))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\CodeVarChunk
x -> (CodeType -> CS (r (StateVar r)))
-> StateT DrasilState Identity CodeType
-> StateT DrasilState Identity (CS (r (StateVar r)))
forall a b.
(a -> b)
-> StateT DrasilState Identity a -> StateT DrasilState Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SVariable r -> CS (r (StateVar r))
forall (r :: * -> *). StateVarSym r => SVariable r -> CSStateVar r
pubDVar (SVariable r -> CS (r (StateVar r)))
-> (CodeType -> SVariable r) -> CodeType -> CS (r (StateVar r))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
String -> VS (r (Type r)) -> SVariable r
forall (r :: * -> *).
VariableSym r =>
String -> VSType r -> SVariable r
var (CodeVarChunk -> String
forall c. CodeIdea c => c -> String
codeName CodeVarChunk
x) (VS (r (Type r)) -> SVariable r)
-> (CodeType -> VS (r (Type r))) -> CodeType -> SVariable r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CodeType -> VS (r (Type r))
forall (r :: * -> *). OOTypeSym r => CodeType -> VSType r
convTypeOO) (CodeVarChunk -> StateT DrasilState Identity CodeType
forall c. HasSpace c => c -> StateT DrasilState Identity CodeType
codeType CodeVarChunk
x)) [CodeVarChunk]
inps
[CS (r (StateVar r))]
constVars <- (CodeDefinition
-> VS (r (Value r))
-> StateT DrasilState Identity (CS (r (StateVar r))))
-> [CodeDefinition]
-> [VS (r (Value r))]
-> StateT DrasilState Identity [CS (r (StateVar r))]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (\CodeDefinition
c VS (r (Value r))
vl -> (CodeType -> CS (r (StateVar r)))
-> StateT DrasilState Identity CodeType
-> StateT DrasilState Identity (CS (r (StateVar r)))
forall a b.
(a -> b)
-> StateT DrasilState Identity a -> StateT DrasilState Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\CodeType
t -> ConstantRepr
-> SVariable r -> VS (r (Value r)) -> CS (r (StateVar r))
forall (r :: * -> *).
OOProg r =>
ConstantRepr -> SVariable r -> SValue r -> CSStateVar r
constVarFunc (DrasilState -> ConstantRepr
conRepr DrasilState
g)
(String -> VS (r (Type r)) -> SVariable r
forall (r :: * -> *).
VariableSym r =>
String -> VSType r -> SVariable r
var (CodeDefinition -> String
forall c. CodeIdea c => c -> String
codeName CodeDefinition
c) (CodeType -> VS (r (Type r))
forall (r :: * -> *). OOTypeSym r => CodeType -> VSType r
convTypeOO CodeType
t)) VS (r (Value r))
vl) (CodeDefinition -> StateT DrasilState Identity CodeType
forall c. HasSpace c => c -> StateT DrasilState Identity CodeType
codeType CodeDefinition
c))
[CodeDefinition]
csts [VS (r (Value r))]
vals
let getFunc :: ClassType
-> String
-> Maybe String
-> String
-> [CSStateVar r]
-> GenState [SMethod r]
-> GenState [SMethod r]
-> GenState (SClass r)
getFunc ClassType
Primary = String
-> Maybe String
-> String
-> [CSStateVar r]
-> GenState [SMethod r]
-> GenState [SMethod r]
-> GenState (SClass r)
forall (r :: * -> *).
OOProg r =>
String
-> Maybe String
-> String
-> [CSStateVar r]
-> GenState [SMethod r]
-> GenState [SMethod r]
-> GenState (SClass r)
primaryClass
getFunc ClassType
Auxiliary = String
-> Maybe String
-> String
-> [CSStateVar r]
-> GenState [SMethod r]
-> GenState [SMethod r]
-> GenState (SClass r)
forall (r :: * -> *).
OOProg r =>
String
-> Maybe String
-> String
-> [CSStateVar r]
-> GenState [SMethod r]
-> GenState [SMethod r]
-> GenState (SClass r)
auxClass
f :: String
-> Maybe String
-> String
-> [CS (r (StateVar r))]
-> GenState [MS (r (Method r))]
-> GenState [MS (r (Method r))]
-> GenState (CS (r (Class r)))
f = ClassType
-> String
-> Maybe String
-> String
-> [CS (r (StateVar r))]
-> GenState [MS (r (Method r))]
-> GenState [MS (r (Method r))]
-> GenState (CS (r (Class r)))
forall {r :: * -> *}.
OOProg r =>
ClassType
-> String
-> Maybe String
-> String
-> [CSStateVar r]
-> GenState [SMethod r]
-> GenState [SMethod r]
-> GenState (SClass r)
getFunc ClassType
scp
String
icDesc <- GenState String
inputClassDesc
CS (r (Class r))
c <- String
-> Maybe String
-> String
-> [CS (r (StateVar r))]
-> GenState [MS (r (Method r))]
-> GenState [MS (r (Method r))]
-> GenState (CS (r (Class r)))
f String
cname Maybe String
forall a. Maybe a
Nothing String
icDesc ([CS (r (StateVar r))]
inputVars [CS (r (StateVar r))]
-> [CS (r (StateVar r))] -> [CS (r (StateVar r))]
forall a. [a] -> [a] -> [a]
++ [CS (r (StateVar r))]
constVars) GenState [MS (r (Method r))]
forall (r :: * -> *). OOProg r => GenState [SMethod r]
constructors GenState [MS (r (Method r))]
forall (r :: * -> *). OOProg r => GenState [SMethod r]
methods
Maybe (CS (r (Class r)))
-> StateT DrasilState Identity (Maybe (CS (r (Class r))))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (CS (r (Class r)))
-> StateT DrasilState Identity (Maybe (CS (r (Class r)))))
-> Maybe (CS (r (Class r)))
-> StateT DrasilState Identity (Maybe (CS (r (Class r))))
forall a b. (a -> b) -> a -> b
$ CS (r (Class r)) -> Maybe (CS (r (Class r)))
forall a. a -> Maybe a
Just CS (r (Class r))
c
[CodeVarChunk] -> [CodeDefinition] -> GenState (Maybe (SClass r))
forall (r :: * -> *).
OOProg r =>
[CodeVarChunk] -> [CodeDefinition] -> GenState (Maybe (SClass r))
genClass ([CodeVarChunk] -> [CodeVarChunk]
forall c. CodeIdea c => [c] -> [c]
filt [CodeVarChunk]
ins) ([CodeDefinition] -> [CodeDefinition]
forall c. CodeIdea c => [c] -> [c]
filt [CodeDefinition]
cs)
genInputConstructor :: (OOProg r) => GenState (Maybe (SMethod r))
genInputConstructor :: forall (r :: * -> *). OOProg r => GenState (Maybe (SMethod r))
genInputConstructor = do
DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
String
ipName <- InternalConcept -> GenState String
genICName InternalConcept
InputParameters
String
giName <- InternalConcept -> GenState String
genICName InternalConcept
GetInput
String
dvName <- InternalConcept -> GenState String
genICName InternalConcept
DerivedValuesFn
String
icName <- InternalConcept -> GenState String
genICName InternalConcept
InputConstraintsFn
let ds :: Set String
ds = DrasilState -> Set String
defSet DrasilState
g
genCtor :: Bool -> StateT DrasilState Identity (Maybe (MS (r (Method r))))
genCtor Bool
False = Maybe (MS (r (Method r)))
-> StateT DrasilState Identity (Maybe (MS (r (Method r))))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MS (r (Method r)))
forall a. Maybe a
Nothing
genCtor Bool
True = do
String
cdesc <- GenState String
inputConstructorDesc
[CodeVarChunk]
cparams <- GenState [CodeVarChunk]
getInConstructorParams
[MS (r (Statement r))]
ics <- GenState [MS (r (Statement r))]
forall (r :: * -> *). OOProg r => GenState [MSStatement r]
genAllInputCalls
MS (r (Method r))
ctor <- String
-> String
-> [ParameterChunk]
-> [MSBlock r]
-> StateT DrasilState Identity (MS (r (Method r)))
forall (r :: * -> *).
OOProg r =>
String
-> String
-> [ParameterChunk]
-> [MSBlock r]
-> GenState (SMethod r)
genConstructor String
ipName String
cdesc ((CodeVarChunk -> ParameterChunk)
-> [CodeVarChunk] -> [ParameterChunk]
forall a b. (a -> b) -> [a] -> [b]
map CodeVarChunk -> ParameterChunk
forall c. CodeIdea c => c -> ParameterChunk
pcAuto [CodeVarChunk]
cparams)
[[MS (r (Statement r))] -> MSBlock r
forall (r :: * -> *). BlockSym r => [MSStatement r] -> MSBlock r
block [MS (r (Statement r))]
ics]
Maybe (MS (r (Method r)))
-> StateT DrasilState Identity (Maybe (MS (r (Method r))))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MS (r (Method r)))
-> StateT DrasilState Identity (Maybe (MS (r (Method r)))))
-> Maybe (MS (r (Method r)))
-> StateT DrasilState Identity (Maybe (MS (r (Method r))))
forall a b. (a -> b) -> a -> b
$ MS (r (Method r)) -> Maybe (MS (r (Method r)))
forall a. a -> Maybe a
Just MS (r (Method r))
ctor
Bool -> GenState (Maybe (SMethod r))
forall {r :: * -> *}.
OOProg r =>
Bool -> StateT DrasilState Identity (Maybe (MS (r (Method r))))
genCtor (Bool -> GenState (Maybe (SMethod r)))
-> Bool -> GenState (Maybe (SMethod r))
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String -> Set String -> Bool
forall a. Eq a => a -> Set a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Set String
ds) [String
giName,
String
dvName, String
icName]
genInputDerived :: (OOProg r) => VisibilityTag ->
GenState (Maybe (SMethod r))
genInputDerived :: forall (r :: * -> *).
OOProg r =>
VisibilityTag -> GenState (Maybe (SMethod r))
genInputDerived VisibilityTag
s = do
DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
(DrasilState -> DrasilState) -> StateT DrasilState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\DrasilState
st -> DrasilState
st {currentScope = Local})
String
dvName <- InternalConcept -> GenState String
genICName InternalConcept
DerivedValuesFn
let dvals :: [CodeDefinition]
dvals = DrasilState -> CodeSpec
codeSpec DrasilState
g CodeSpec
-> Getting [CodeDefinition] CodeSpec [CodeDefinition]
-> [CodeDefinition]
forall s a. s -> Getting a s a -> a
^. Getting [CodeDefinition] CodeSpec [CodeDefinition]
forall c. HasOldCodeSpec c => Lens' c [CodeDefinition]
Lens' CodeSpec [CodeDefinition]
derivedInputsO
getFunc :: VisibilityTag
-> String
-> String
-> [CodeVarChunk]
-> [CodeVarChunk]
-> [MSBlock r]
-> GenState (SMethod r)
getFunc VisibilityTag
Pub = String
-> String
-> [CodeVarChunk]
-> [CodeVarChunk]
-> [MSBlock r]
-> GenState (SMethod r)
forall (r :: * -> *).
OOProg r =>
String
-> String
-> [CodeVarChunk]
-> [CodeVarChunk]
-> [MSBlock r]
-> GenState (SMethod r)
publicInOutFunc
getFunc VisibilityTag
Priv = String
-> String
-> [CodeVarChunk]
-> [CodeVarChunk]
-> [MSBlock r]
-> GenState (SMethod r)
forall (r :: * -> *).
OOProg r =>
String
-> String
-> [CodeVarChunk]
-> [CodeVarChunk]
-> [MSBlock r]
-> GenState (SMethod r)
privateInOutMethod
genDerived :: (OOProg r) => Bool -> GenState
(Maybe (SMethod r))
genDerived :: forall {r :: * -> *}.
OOProg r =>
Bool -> StateT DrasilState Identity (Maybe (MS (r (Method r))))
genDerived Bool
False = Maybe (MS (r (Method r)))
-> StateT DrasilState Identity (Maybe (MS (r (Method r))))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MS (r (Method r)))
forall a. Maybe a
Nothing
genDerived Bool
_ = do
[CodeVarChunk]
ins <- GenState [CodeVarChunk]
getDerivedIns
[CodeVarChunk]
outs <- GenState [CodeVarChunk]
getDerivedOuts
[MS (r (Block r))]
bod <- (CodeDefinition -> StateT DrasilState Identity (MS (r (Block r))))
-> [CodeDefinition]
-> StateT DrasilState Identity [MS (r (Block r))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\CodeDefinition
x -> CalcType
-> CodeDefinition
-> CodeExpr
-> StateT DrasilState Identity (MS (r (Block r)))
forall (r :: * -> *).
OOProg r =>
CalcType -> CodeDefinition -> CodeExpr -> GenState (MSBlock r)
genCalcBlock CalcType
CalcAssign CodeDefinition
x (CodeDefinition
x CodeDefinition
-> Getting CodeExpr CodeDefinition CodeExpr -> CodeExpr
forall s a. s -> Getting a s a -> a
^. Getting CodeExpr CodeDefinition CodeExpr
forall c. DefiningCodeExpr c => Lens' c CodeExpr
Lens' CodeDefinition CodeExpr
codeExpr)) [CodeDefinition]
dvals
String
desc <- GenState String
dvFuncDesc
MS (r (Method r))
mthd <- VisibilityTag
-> String
-> String
-> [CodeVarChunk]
-> [CodeVarChunk]
-> [MS (r (Block r))]
-> StateT DrasilState Identity (MS (r (Method r)))
forall {r :: * -> *}.
OOProg r =>
VisibilityTag
-> String
-> String
-> [CodeVarChunk]
-> [CodeVarChunk]
-> [MSBlock r]
-> GenState (SMethod r)
getFunc VisibilityTag
s String
dvName String
desc [CodeVarChunk]
ins [CodeVarChunk]
outs [MS (r (Block r))]
bod
Maybe (MS (r (Method r)))
-> StateT DrasilState Identity (Maybe (MS (r (Method r))))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MS (r (Method r)))
-> StateT DrasilState Identity (Maybe (MS (r (Method r)))))
-> Maybe (MS (r (Method r)))
-> StateT DrasilState Identity (Maybe (MS (r (Method r))))
forall a b. (a -> b) -> a -> b
$ MS (r (Method r)) -> Maybe (MS (r (Method r)))
forall a. a -> Maybe a
Just MS (r (Method r))
mthd
Bool -> GenState (Maybe (SMethod r))
forall {r :: * -> *}.
OOProg r =>
Bool -> StateT DrasilState Identity (Maybe (MS (r (Method r))))
genDerived (Bool -> GenState (Maybe (SMethod r)))
-> Bool -> GenState (Maybe (SMethod r))
forall a b. (a -> b) -> a -> b
$ String
dvName String -> Set String -> Bool
forall a. Eq a => a -> Set a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` DrasilState -> Set String
defSet DrasilState
g
genInputConstraints :: (OOProg r) => VisibilityTag ->
GenState (Maybe (SMethod r))
genInputConstraints :: forall (r :: * -> *).
OOProg r =>
VisibilityTag -> GenState (Maybe (SMethod r))
genInputConstraints VisibilityTag
s = do
DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
(DrasilState -> DrasilState) -> StateT DrasilState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\DrasilState
st -> DrasilState
st {currentScope = Local})
String
icName <- InternalConcept -> GenState String
genICName InternalConcept
InputConstraintsFn
let cm :: ConstraintCEMap
cm = DrasilState -> CodeSpec
codeSpec DrasilState
g CodeSpec
-> Getting ConstraintCEMap CodeSpec ConstraintCEMap
-> ConstraintCEMap
forall s a. s -> Getting a s a -> a
^. Getting ConstraintCEMap CodeSpec ConstraintCEMap
forall c. HasOldCodeSpec c => Lens' c ConstraintCEMap
Lens' CodeSpec ConstraintCEMap
cMapO
getFunc :: VisibilityTag
-> String
-> VSType r
-> String
-> [ParameterChunk]
-> Maybe String
-> [MSBlock r]
-> GenState (SMethod r)
getFunc VisibilityTag
Pub = String
-> VSType r
-> String
-> [ParameterChunk]
-> Maybe String
-> [MSBlock r]
-> GenState (SMethod r)
forall (r :: * -> *).
OOProg r =>
String
-> VSType r
-> String
-> [ParameterChunk]
-> Maybe String
-> [MSBlock r]
-> GenState (SMethod r)
publicFunc
getFunc VisibilityTag
Priv = String
-> VSType r
-> String
-> [ParameterChunk]
-> Maybe String
-> [MSBlock r]
-> GenState (SMethod r)
forall (r :: * -> *).
OOProg r =>
String
-> VSType r
-> String
-> [ParameterChunk]
-> Maybe String
-> [MSBlock r]
-> GenState (SMethod r)
privateMethod
genConstraints :: (OOProg r) => Bool -> GenState
(Maybe (SMethod r))
genConstraints :: forall {r :: * -> *}.
OOProg r =>
Bool -> StateT DrasilState Identity (Maybe (MS (r (Method r))))
genConstraints Bool
False = Maybe (MS (r (Method r)))
-> StateT DrasilState Identity (Maybe (MS (r (Method r))))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MS (r (Method r)))
forall a. Maybe a
Nothing
genConstraints Bool
_ = do
[CodeVarChunk]
parms <- GenState [CodeVarChunk]
getConstraintParams
let varsList :: [CodeVarChunk]
varsList = (CodeVarChunk -> Bool) -> [CodeVarChunk] -> [CodeVarChunk]
forall a. (a -> Bool) -> [a] -> [a]
filter (\CodeVarChunk
i -> UID -> ConstraintCEMap -> Bool
forall k a. Ord k => k -> Map k a -> Bool
member (CodeVarChunk
i CodeVarChunk -> Getting UID CodeVarChunk UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID CodeVarChunk UID
forall c. HasUID c => Getter c UID
Getter CodeVarChunk UID
uid) ConstraintCEMap
cm) (DrasilState -> CodeSpec
codeSpec DrasilState
g CodeSpec
-> Getting [CodeVarChunk] CodeSpec [CodeVarChunk] -> [CodeVarChunk]
forall s a. s -> Getting a s a -> a
^. Getting [CodeVarChunk] CodeSpec [CodeVarChunk]
forall c. HasOldCodeSpec c => Lens' c [CodeVarChunk]
Lens' CodeSpec [CodeVarChunk]
inputsO)
sfwrCs :: [(CodeVarChunk, [ConstraintCE])]
sfwrCs = (CodeVarChunk -> (CodeVarChunk, [ConstraintCE]))
-> [CodeVarChunk] -> [(CodeVarChunk, [ConstraintCE])]
forall a b. (a -> b) -> [a] -> [b]
map (ConstraintCEMap -> CodeVarChunk -> (CodeVarChunk, [ConstraintCE])
forall q. HasUID q => ConstraintCEMap -> q -> (q, [ConstraintCE])
sfwrLookup ConstraintCEMap
cm) [CodeVarChunk]
varsList
physCs :: [(CodeVarChunk, [ConstraintCE])]
physCs = (CodeVarChunk -> (CodeVarChunk, [ConstraintCE]))
-> [CodeVarChunk] -> [(CodeVarChunk, [ConstraintCE])]
forall a b. (a -> b) -> [a] -> [b]
map (ConstraintCEMap -> CodeVarChunk -> (CodeVarChunk, [ConstraintCE])
forall q. HasUID q => ConstraintCEMap -> q -> (q, [ConstraintCE])
physLookup ConstraintCEMap
cm) [CodeVarChunk]
varsList
[MS (r (Statement r))]
sf <- [(CodeVarChunk, [ConstraintCE])]
-> StateT DrasilState Identity [MS (r (Statement r))]
forall (r :: * -> *).
OOProg r =>
[(CodeVarChunk, [ConstraintCE])] -> GenState [MSStatement r]
sfwrCBody [(CodeVarChunk, [ConstraintCE])]
sfwrCs
[MS (r (Statement r))]
ph <- [(CodeVarChunk, [ConstraintCE])]
-> StateT DrasilState Identity [MS (r (Statement r))]
forall (r :: * -> *).
OOProg r =>
[(CodeVarChunk, [ConstraintCE])] -> GenState [MSStatement r]
physCBody [(CodeVarChunk, [ConstraintCE])]
physCs
String
desc <- GenState String
inConsFuncDesc
MS (r (Method r))
mthd <- VisibilityTag
-> String
-> VS (r (Type r))
-> String
-> [ParameterChunk]
-> Maybe String
-> [MS (r (Block r))]
-> StateT DrasilState Identity (MS (r (Method r)))
forall {r :: * -> *}.
OOProg r =>
VisibilityTag
-> String
-> VSType r
-> String
-> [ParameterChunk]
-> Maybe String
-> [MSBlock r]
-> GenState (SMethod r)
getFunc VisibilityTag
s String
icName VS (r (Type r))
forall (r :: * -> *). TypeSym r => VSType r
void String
desc ((CodeVarChunk -> ParameterChunk)
-> [CodeVarChunk] -> [ParameterChunk]
forall a b. (a -> b) -> [a] -> [b]
map CodeVarChunk -> ParameterChunk
forall c. CodeIdea c => c -> ParameterChunk
pcAuto [CodeVarChunk]
parms)
Maybe String
forall a. Maybe a
Nothing [[MS (r (Statement r))] -> MS (r (Block r))
forall (r :: * -> *). BlockSym r => [MSStatement r] -> MSBlock r
block [MS (r (Statement r))]
sf, [MS (r (Statement r))] -> MS (r (Block r))
forall (r :: * -> *). BlockSym r => [MSStatement r] -> MSBlock r
block [MS (r (Statement r))]
ph]
Maybe (MS (r (Method r)))
-> StateT DrasilState Identity (Maybe (MS (r (Method r))))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MS (r (Method r)))
-> StateT DrasilState Identity (Maybe (MS (r (Method r)))))
-> Maybe (MS (r (Method r)))
-> StateT DrasilState Identity (Maybe (MS (r (Method r))))
forall a b. (a -> b) -> a -> b
$ MS (r (Method r)) -> Maybe (MS (r (Method r)))
forall a. a -> Maybe a
Just MS (r (Method r))
mthd
Bool -> GenState (Maybe (SMethod r))
forall {r :: * -> *}.
OOProg r =>
Bool -> StateT DrasilState Identity (Maybe (MS (r (Method r))))
genConstraints (Bool -> GenState (Maybe (SMethod r)))
-> Bool -> GenState (Maybe (SMethod r))
forall a b. (a -> b) -> a -> b
$ String
icName String -> Set String -> Bool
forall a. Eq a => a -> Set a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` DrasilState -> Set String
defSet DrasilState
g
sfwrCBody :: (OOProg r) => [(CodeVarChunk, [ConstraintCE])] ->
GenState [MSStatement r]
sfwrCBody :: forall (r :: * -> *).
OOProg r =>
[(CodeVarChunk, [ConstraintCE])] -> GenState [MSStatement r]
sfwrCBody [(CodeVarChunk, [ConstraintCE])]
cs = do
DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
let cb :: ConstraintBehaviour
cb = DrasilState -> ConstraintBehaviour
onSfwrC DrasilState
g
ConstraintBehaviour
-> [(CodeVarChunk, [ConstraintCE])] -> GenState [MSStatement r]
forall (r :: * -> *).
OOProg r =>
ConstraintBehaviour
-> [(CodeVarChunk, [ConstraintCE])] -> GenState [MSStatement r]
chooseConstr ConstraintBehaviour
cb [(CodeVarChunk, [ConstraintCE])]
cs
physCBody :: (OOProg r) => [(CodeVarChunk, [ConstraintCE])] ->
GenState [MSStatement r]
physCBody :: forall (r :: * -> *).
OOProg r =>
[(CodeVarChunk, [ConstraintCE])] -> GenState [MSStatement r]
physCBody [(CodeVarChunk, [ConstraintCE])]
cs = do
DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
let cb :: ConstraintBehaviour
cb = DrasilState -> ConstraintBehaviour
onPhysC DrasilState
g
ConstraintBehaviour
-> [(CodeVarChunk, [ConstraintCE])] -> GenState [MSStatement r]
forall (r :: * -> *).
OOProg r =>
ConstraintBehaviour
-> [(CodeVarChunk, [ConstraintCE])] -> GenState [MSStatement r]
chooseConstr ConstraintBehaviour
cb [(CodeVarChunk, [ConstraintCE])]
cs
chooseConstr :: (OOProg r) => ConstraintBehaviour ->
[(CodeVarChunk, [ConstraintCE])] -> GenState [MSStatement r]
chooseConstr :: forall (r :: * -> *).
OOProg r =>
ConstraintBehaviour
-> [(CodeVarChunk, [ConstraintCE])] -> GenState [MSStatement r]
chooseConstr ConstraintBehaviour
cb [(CodeVarChunk, [ConstraintCE])]
cs = do
let ch :: [(CodeVarChunk, ConstraintCE)]
ch = ((CodeVarChunk, [ConstraintCE]) -> [(CodeVarChunk, ConstraintCE)])
-> [(CodeVarChunk, [ConstraintCE])]
-> [(CodeVarChunk, ConstraintCE)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(CodeVarChunk
s, [ConstraintCE]
ns) -> [(CodeVarChunk
s, ConstraintCE
n) | ConstraintCE
n <- [ConstraintCE]
ns]) [(CodeVarChunk, [ConstraintCE])]
cs
[MSStatement r]
varDecs <- ((CodeVarChunk, ConstraintCE)
-> StateT DrasilState Identity (MSStatement r))
-> [(CodeVarChunk, ConstraintCE)] -> GenState [MSStatement r]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\case
(CodeVarChunk
q, Elem ConstraintReason
_ CodeExpr
e) -> CodeVarChunk
-> CodeExpr -> StateT DrasilState Identity (MSStatement r)
forall (r :: * -> *).
OOProg r =>
CodeVarChunk -> CodeExpr -> GenState (MSStatement r)
constrVarDec CodeVarChunk
q CodeExpr
e
(CodeVarChunk, ConstraintCE)
_ -> MSStatement r -> StateT DrasilState Identity (MSStatement r)
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return MSStatement r
forall (r :: * -> *). StatementSym r => MSStatement r
emptyStmt) [(CodeVarChunk, ConstraintCE)]
ch
[[VS (r (Value r))]]
conds <- ((CodeVarChunk, [ConstraintCE])
-> StateT DrasilState Identity [VS (r (Value r))])
-> [(CodeVarChunk, [ConstraintCE])]
-> StateT DrasilState Identity [[VS (r (Value r))]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\(CodeVarChunk
q,[ConstraintCE]
cns) -> (ConstraintCE -> StateT DrasilState Identity (VS (r (Value r))))
-> [ConstraintCE] -> StateT DrasilState Identity [VS (r (Value r))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (CodeExpr -> StateT DrasilState Identity (VS (r (Value r)))
forall (r :: * -> *). OOProg r => CodeExpr -> GenState (SValue r)
convExpr (CodeExpr -> StateT DrasilState Identity (VS (r (Value r))))
-> (ConstraintCE -> CodeExpr)
-> ConstraintCE
-> StateT DrasilState Identity (VS (r (Value r)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CodeVarChunk -> ConstraintCE -> CodeExpr
forall c. (HasUID c, HasSymbol c) => c -> ConstraintCE -> CodeExpr
renderC CodeVarChunk
q) [ConstraintCE]
cns) [(CodeVarChunk, [ConstraintCE])]
cs
[[MS (r (Body r))]]
bods <- ((CodeVarChunk, [ConstraintCE])
-> StateT DrasilState Identity [MS (r (Body r))])
-> [(CodeVarChunk, [ConstraintCE])]
-> StateT DrasilState Identity [[MS (r (Body r))]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ConstraintBehaviour
-> (CodeVarChunk, [ConstraintCE])
-> StateT DrasilState Identity [MS (r (Body r))]
forall {r :: * -> *}.
OOProg r =>
ConstraintBehaviour
-> (CodeVarChunk, [ConstraintCE]) -> GenState [MS (r (Body r))]
chooseCB ConstraintBehaviour
cb) [(CodeVarChunk, [ConstraintCE])]
cs
let bodies :: [MSStatement r]
bodies = [[MSStatement r]] -> [MSStatement r]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[MSStatement r]] -> [MSStatement r])
-> [[MSStatement r]] -> [MSStatement r]
forall a b. (a -> b) -> a -> b
$ ([VS (r (Value r))] -> [MS (r (Body r))] -> [MSStatement r])
-> [[VS (r (Value r))]] -> [[MS (r (Body r))]] -> [[MSStatement r]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ((VS (r (Value r)) -> MS (r (Body r)) -> MSStatement r)
-> [VS (r (Value r))] -> [MS (r (Body r))] -> [MSStatement r]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\VS (r (Value r))
cond MS (r (Body r))
bod -> [(VS (r (Value r)), MS (r (Body r)))] -> MSStatement r
forall (r :: * -> *).
ControlStatement r =>
[(SValue r, MSBody r)] -> MSStatement r
ifNoElse [(VS (r (Value r)) -> VS (r (Value r))
forall (r :: * -> *). BooleanExpression r => SValue r -> SValue r
(?!) VS (r (Value r))
cond, MS (r (Body r))
bod)])) [[VS (r (Value r))]]
conds [[MS (r (Body r))]]
bods
[MSStatement r] -> GenState [MSStatement r]
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([MSStatement r] -> GenState [MSStatement r])
-> [MSStatement r] -> GenState [MSStatement r]
forall a b. (a -> b) -> a -> b
$ [MSStatement r] -> [MSStatement r] -> [MSStatement r]
forall a. [a] -> [a] -> [a]
interleave [MSStatement r]
varDecs [MSStatement r]
bodies
where chooseCB :: ConstraintBehaviour
-> (CodeVarChunk, [ConstraintCE]) -> GenState [MS (r (Body r))]
chooseCB ConstraintBehaviour
Warning = (CodeVarChunk, [ConstraintCE]) -> GenState [MS (r (Body r))]
forall (r :: * -> *).
OOProg r =>
(CodeVarChunk, [ConstraintCE]) -> GenState [MSBody r]
constrWarn
chooseCB ConstraintBehaviour
Exception = (CodeVarChunk, [ConstraintCE]) -> GenState [MS (r (Body r))]
forall (r :: * -> *).
OOProg r =>
(CodeVarChunk, [ConstraintCE]) -> GenState [MSBody r]
constrExc
constrWarn :: (OOProg r) => (CodeVarChunk, [ConstraintCE]) ->
GenState [MSBody r]
constrWarn :: forall (r :: * -> *).
OOProg r =>
(CodeVarChunk, [ConstraintCE]) -> GenState [MSBody r]
constrWarn (CodeVarChunk, [ConstraintCE])
c = do
let q :: CodeVarChunk
q = (CodeVarChunk, [ConstraintCE]) -> CodeVarChunk
forall a b. (a, b) -> a
fst (CodeVarChunk, [ConstraintCE])
c
cs :: [ConstraintCE]
cs = (CodeVarChunk, [ConstraintCE]) -> [ConstraintCE]
forall a b. (a, b) -> b
snd (CodeVarChunk, [ConstraintCE])
c
[[MS (r (Statement r))]]
msgs <- (ConstraintCE
-> StateT DrasilState Identity [MS (r (Statement r))])
-> [ConstraintCE]
-> StateT DrasilState Identity [[MS (r (Statement r))]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (CodeVarChunk
-> String
-> ConstraintCE
-> StateT DrasilState Identity [MS (r (Statement r))]
forall (r :: * -> *).
OOProg r =>
CodeVarChunk -> String -> ConstraintCE -> GenState [MSStatement r]
constraintViolatedMsg CodeVarChunk
q String
"suggested") [ConstraintCE]
cs
[MSBody r] -> GenState [MSBody r]
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([MSBody r] -> GenState [MSBody r])
-> [MSBody r] -> GenState [MSBody r]
forall a b. (a -> b) -> a -> b
$ ([MS (r (Statement r))] -> MSBody r)
-> [[MS (r (Statement r))]] -> [MSBody r]
forall a b. (a -> b) -> [a] -> [b]
map ([MS (r (Statement r))] -> MSBody r
forall (r :: * -> *). BodySym r => [MSStatement r] -> MSBody r
bodyStatements ([MS (r (Statement r))] -> MSBody r)
-> ([MS (r (Statement r))] -> [MS (r (Statement r))])
-> [MS (r (Statement r))]
-> MSBody r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> MS (r (Statement r))
forall (r :: * -> *). IOStatement r => String -> MSStatement r
printStr String
"Warning: " MS (r (Statement r))
-> [MS (r (Statement r))] -> [MS (r (Statement r))]
forall a. a -> [a] -> [a]
:)) [[MS (r (Statement r))]]
msgs
constrExc :: (OOProg r) => (CodeVarChunk, [ConstraintCE]) ->
GenState [MSBody r]
constrExc :: forall (r :: * -> *).
OOProg r =>
(CodeVarChunk, [ConstraintCE]) -> GenState [MSBody r]
constrExc (CodeVarChunk, [ConstraintCE])
c = do
let q :: CodeVarChunk
q = (CodeVarChunk, [ConstraintCE]) -> CodeVarChunk
forall a b. (a, b) -> a
fst (CodeVarChunk, [ConstraintCE])
c
cs :: [ConstraintCE]
cs = (CodeVarChunk, [ConstraintCE]) -> [ConstraintCE]
forall a b. (a, b) -> b
snd (CodeVarChunk, [ConstraintCE])
c
[[MS (r (Statement r))]]
msgs <- (ConstraintCE
-> StateT DrasilState Identity [MS (r (Statement r))])
-> [ConstraintCE]
-> StateT DrasilState Identity [[MS (r (Statement r))]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (CodeVarChunk
-> String
-> ConstraintCE
-> StateT DrasilState Identity [MS (r (Statement r))]
forall (r :: * -> *).
OOProg r =>
CodeVarChunk -> String -> ConstraintCE -> GenState [MSStatement r]
constraintViolatedMsg CodeVarChunk
q String
"expected") [ConstraintCE]
cs
[MSBody r] -> GenState [MSBody r]
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([MSBody r] -> GenState [MSBody r])
-> [MSBody r] -> GenState [MSBody r]
forall a b. (a -> b) -> a -> b
$ ([MS (r (Statement r))] -> MSBody r)
-> [[MS (r (Statement r))]] -> [MSBody r]
forall a b. (a -> b) -> [a] -> [b]
map ([MS (r (Statement r))] -> MSBody r
forall (r :: * -> *). BodySym r => [MSStatement r] -> MSBody r
bodyStatements ([MS (r (Statement r))] -> MSBody r)
-> ([MS (r (Statement r))] -> [MS (r (Statement r))])
-> [MS (r (Statement r))]
-> MSBody r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([MS (r (Statement r))]
-> [MS (r (Statement r))] -> [MS (r (Statement r))]
forall a. [a] -> [a] -> [a]
++ [String -> MS (r (Statement r))
forall (r :: * -> *). ControlStatement r => String -> MSStatement r
throw String
"InputError"])) [[MS (r (Statement r))]]
msgs
constrVarDec :: (OOProg r) => CodeVarChunk -> CodeExpr ->
GenState (MSStatement r)
constrVarDec :: forall (r :: * -> *).
OOProg r =>
CodeVarChunk -> CodeExpr -> GenState (MSStatement r)
constrVarDec CodeVarChunk
v CodeExpr
e = do
VS (r (Value r))
lb <- CodeExpr -> StateT DrasilState Identity (VS (r (Value r)))
forall (r :: * -> *). OOProg r => CodeExpr -> GenState (SValue r)
convExpr CodeExpr
e
CodeType
t <- CodeVarChunk -> StateT DrasilState Identity CodeType
forall c. HasSpace c => c -> StateT DrasilState Identity CodeType
codeType CodeVarChunk
v
let mkValue :: SVariable r
mkValue = String -> VSType r -> SVariable r
forall (r :: * -> *).
VariableSym r =>
String -> VSType r -> SVariable r
var (String
"set_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ CodeVarChunk -> String
forall x. HasSymbol x => x -> String
showHasSymbImpl CodeVarChunk
v) (VSType r -> VSType r
forall (r :: * -> *). TypeSym r => VSType r -> VSType r
setType (CodeType -> VSType r
forall (r :: * -> *). TypeSym r => CodeType -> VSType r
convType CodeType
t))
MSStatement r -> GenState (MSStatement r)
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (SVariable r -> r (Scope r) -> VS (r (Value r)) -> MSStatement r
forall (r :: * -> *).
DeclStatement r =>
SVariable r -> r (Scope r) -> SValue r -> MSStatement r
setDecDef SVariable r
mkValue r (Scope r)
forall (r :: * -> *). ScopeSym r => r (Scope r)
local VS (r (Value r))
lb)
constraintViolatedMsg :: (OOProg r) => CodeVarChunk -> String ->
ConstraintCE -> GenState [MSStatement r]
constraintViolatedMsg :: forall (r :: * -> *).
OOProg r =>
CodeVarChunk -> String -> ConstraintCE -> GenState [MSStatement r]
constraintViolatedMsg CodeVarChunk
q String
s ConstraintCE
c = do
[MSStatement r]
pc <- String -> ConstraintCE -> GenState [MSStatement r]
forall (r :: * -> *).
OOProg r =>
String -> ConstraintCE -> GenState [MSStatement r]
printConstraint (CodeVarChunk -> String
forall x. HasSymbol x => x -> String
showHasSymbImpl CodeVarChunk
q) ConstraintCE
c
VS (r (Value r))
v <- CodeVarChunk -> StateT DrasilState Identity (VS (r (Value r)))
forall (r :: * -> *).
OOProg r =>
CodeVarChunk -> GenState (SValue r)
mkVal (CodeVarChunk -> CodeVarChunk
forall c. (Quantity c, MayHaveUnit c) => c -> CodeVarChunk
quantvar CodeVarChunk
q)
[MSStatement r] -> GenState [MSStatement r]
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([MSStatement r] -> GenState [MSStatement r])
-> [MSStatement r] -> GenState [MSStatement r]
forall a b. (a -> b) -> a -> b
$ [String -> MSStatement r
forall (r :: * -> *). IOStatement r => String -> MSStatement r
printStr (String -> MSStatement r) -> String -> MSStatement r
forall a b. (a -> b) -> a -> b
$ CodeVarChunk -> String
forall c. CodeIdea c => c -> String
codeName CodeVarChunk
q String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" has value ",
VS (r (Value r)) -> MSStatement r
forall (r :: * -> *). IOStatement r => SValue r -> MSStatement r
print VS (r (Value r))
v,
String -> MSStatement r
forall (r :: * -> *). IOStatement r => String -> MSStatement r
printStr (String -> MSStatement r) -> String -> MSStatement r
forall a b. (a -> b) -> a -> b
$ String
", but is " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" to be "] [MSStatement r] -> [MSStatement r] -> [MSStatement r]
forall a. [a] -> [a] -> [a]
++ [MSStatement r]
pc
printConstraint :: (OOProg r) => String -> ConstraintCE ->
GenState [MSStatement r]
printConstraint :: forall (r :: * -> *).
OOProg r =>
String -> ConstraintCE -> GenState [MSStatement r]
printConstraint String
v ConstraintCE
c = do
DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
let db :: ChunkDB
db = DrasilState -> CodeSpec
codeSpec DrasilState
g CodeSpec -> Getting ChunkDB CodeSpec ChunkDB -> ChunkDB
forall s a. s -> Getting a s a -> a
^. Getting ChunkDB CodeSpec ChunkDB
forall c. HasOldCodeSpec c => Lens' c ChunkDB
Lens' CodeSpec ChunkDB
sysinfodbO
printConstraint' :: (OOProg r) => String -> ConstraintCE -> GenState
[MSStatement r]
printConstraint' :: forall (r :: * -> *).
OOProg r =>
String -> ConstraintCE -> GenState [MSStatement r]
printConstraint' String
_ (Range ConstraintReason
_ (Bounded (Inclusive
_, CodeExpr
e1) (Inclusive
_, CodeExpr
e2))) = do
VS (r (Value r))
lb <- CodeExpr -> StateT DrasilState Identity (VS (r (Value r)))
forall (r :: * -> *). OOProg r => CodeExpr -> GenState (SValue r)
convExpr CodeExpr
e1
VS (r (Value r))
ub <- CodeExpr -> StateT DrasilState Identity (VS (r (Value r)))
forall (r :: * -> *). OOProg r => CodeExpr -> GenState (SValue r)
convExpr CodeExpr
e2
[MSStatement r] -> GenState [MSStatement r]
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([MSStatement r] -> GenState [MSStatement r])
-> [MSStatement r] -> GenState [MSStatement r]
forall a b. (a -> b) -> a -> b
$ [String -> MSStatement r
forall (r :: * -> *). IOStatement r => String -> MSStatement r
printStr String
"between ", VS (r (Value r)) -> MSStatement r
forall (r :: * -> *). IOStatement r => SValue r -> MSStatement r
print VS (r (Value r))
lb] [MSStatement r] -> [MSStatement r] -> [MSStatement r]
forall a. [a] -> [a] -> [a]
++ CodeExpr -> ChunkDB -> [MSStatement r]
forall (r :: * -> *).
SharedProg r =>
CodeExpr -> ChunkDB -> [MSStatement r]
printExpr CodeExpr
e1 ChunkDB
db [MSStatement r] -> [MSStatement r] -> [MSStatement r]
forall a. [a] -> [a] -> [a]
++
[String -> MSStatement r
forall (r :: * -> *). IOStatement r => String -> MSStatement r
printStr String
" and ", VS (r (Value r)) -> MSStatement r
forall (r :: * -> *). IOStatement r => SValue r -> MSStatement r
print VS (r (Value r))
ub] [MSStatement r] -> [MSStatement r] -> [MSStatement r]
forall a. [a] -> [a] -> [a]
++ CodeExpr -> ChunkDB -> [MSStatement r]
forall (r :: * -> *).
SharedProg r =>
CodeExpr -> ChunkDB -> [MSStatement r]
printExpr CodeExpr
e2 ChunkDB
db [MSStatement r] -> [MSStatement r] -> [MSStatement r]
forall a. [a] -> [a] -> [a]
++ [String -> MSStatement r
forall (r :: * -> *). IOStatement r => String -> MSStatement r
printStrLn String
"."]
printConstraint' String
_ (Range ConstraintReason
_ (UpTo (Inclusive
_, CodeExpr
e))) = do
VS (r (Value r))
ub <- CodeExpr -> StateT DrasilState Identity (VS (r (Value r)))
forall (r :: * -> *). OOProg r => CodeExpr -> GenState (SValue r)
convExpr CodeExpr
e
[MSStatement r] -> GenState [MSStatement r]
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([MSStatement r] -> GenState [MSStatement r])
-> [MSStatement r] -> GenState [MSStatement r]
forall a b. (a -> b) -> a -> b
$ [String -> MSStatement r
forall (r :: * -> *). IOStatement r => String -> MSStatement r
printStr String
"below ", VS (r (Value r)) -> MSStatement r
forall (r :: * -> *). IOStatement r => SValue r -> MSStatement r
print VS (r (Value r))
ub] [MSStatement r] -> [MSStatement r] -> [MSStatement r]
forall a. [a] -> [a] -> [a]
++ CodeExpr -> ChunkDB -> [MSStatement r]
forall (r :: * -> *).
SharedProg r =>
CodeExpr -> ChunkDB -> [MSStatement r]
printExpr CodeExpr
e ChunkDB
db [MSStatement r] -> [MSStatement r] -> [MSStatement r]
forall a. [a] -> [a] -> [a]
++
[String -> MSStatement r
forall (r :: * -> *). IOStatement r => String -> MSStatement r
printStrLn String
"."]
printConstraint' String
_ (Range ConstraintReason
_ (UpFrom (Inclusive
_, CodeExpr
e))) = do
VS (r (Value r))
lb <- CodeExpr -> StateT DrasilState Identity (VS (r (Value r)))
forall (r :: * -> *). OOProg r => CodeExpr -> GenState (SValue r)
convExpr CodeExpr
e
[MSStatement r] -> GenState [MSStatement r]
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([MSStatement r] -> GenState [MSStatement r])
-> [MSStatement r] -> GenState [MSStatement r]
forall a b. (a -> b) -> a -> b
$ [String -> MSStatement r
forall (r :: * -> *). IOStatement r => String -> MSStatement r
printStr String
"above ", VS (r (Value r)) -> MSStatement r
forall (r :: * -> *). IOStatement r => SValue r -> MSStatement r
print VS (r (Value r))
lb] [MSStatement r] -> [MSStatement r] -> [MSStatement r]
forall a. [a] -> [a] -> [a]
++ CodeExpr -> ChunkDB -> [MSStatement r]
forall (r :: * -> *).
SharedProg r =>
CodeExpr -> ChunkDB -> [MSStatement r]
printExpr CodeExpr
e ChunkDB
db [MSStatement r] -> [MSStatement r] -> [MSStatement r]
forall a. [a] -> [a] -> [a]
++ [String -> MSStatement r
forall (r :: * -> *). IOStatement r => String -> MSStatement r
printStrLn String
"."]
printConstraint' String
name (Elem ConstraintReason
_ CodeExpr
e) = do
VS (r (Value r))
lb <- CodeExpr -> StateT DrasilState Identity (VS (r (Value r)))
forall (r :: * -> *). OOProg r => CodeExpr -> GenState (SValue r)
convExpr (String -> CodeExpr -> CodeExpr
Variable (String
"set_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name) CodeExpr
e)
[MSStatement r] -> GenState [MSStatement r]
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([MSStatement r] -> GenState [MSStatement r])
-> [MSStatement r] -> GenState [MSStatement r]
forall a b. (a -> b) -> a -> b
$ [String -> MSStatement r
forall (r :: * -> *). IOStatement r => String -> MSStatement r
printStr String
"an element of the set ", VS (r (Value r)) -> MSStatement r
forall (r :: * -> *). IOStatement r => SValue r -> MSStatement r
print VS (r (Value r))
lb] [MSStatement r] -> [MSStatement r] -> [MSStatement r]
forall a. [a] -> [a] -> [a]
++ [String -> MSStatement r
forall (r :: * -> *). IOStatement r => String -> MSStatement r
printStrLn String
"."]
String -> ConstraintCE -> GenState [MSStatement r]
forall (r :: * -> *).
OOProg r =>
String -> ConstraintCE -> GenState [MSStatement r]
printConstraint' String
v ConstraintCE
c
printExpr :: (SharedProg r) => CodeExpr -> ChunkDB -> [MSStatement r]
printExpr :: forall (r :: * -> *).
SharedProg r =>
CodeExpr -> ChunkDB -> [MSStatement r]
printExpr Lit{} ChunkDB
_ = []
printExpr CodeExpr
e ChunkDB
db = [String -> MS (r (Statement r))
forall (r :: * -> *). IOStatement r => String -> MSStatement r
printStr (String -> MS (r (Statement r))) -> String -> MS (r (Statement r))
forall a b. (a -> b) -> a -> b
$ String
" (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Doc -> String
render (ChunkDB -> Stage -> SingleLine -> CodeExpr -> Doc
codeExprDoc ChunkDB
db Stage
Implementation SingleLine
OneLine CodeExpr
e) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"]
genInputFormat :: (OOProg r) => VisibilityTag ->
GenState (Maybe (SMethod r))
genInputFormat :: forall (r :: * -> *).
OOProg r =>
VisibilityTag -> GenState (Maybe (SMethod r))
genInputFormat VisibilityTag
s = do
DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
(DrasilState -> DrasilState) -> StateT DrasilState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\DrasilState
st -> DrasilState
st {currentScope = Local})
DataDesc
dd <- GenState DataDesc
genDataDesc
String
giName <- InternalConcept -> GenState String
genICName InternalConcept
GetInput
let getFunc :: VisibilityTag
-> String
-> String
-> [CodeVarChunk]
-> [CodeVarChunk]
-> [MSBlock r]
-> GenState (SMethod r)
getFunc VisibilityTag
Pub = String
-> String
-> [CodeVarChunk]
-> [CodeVarChunk]
-> [MSBlock r]
-> GenState (SMethod r)
forall (r :: * -> *).
OOProg r =>
String
-> String
-> [CodeVarChunk]
-> [CodeVarChunk]
-> [MSBlock r]
-> GenState (SMethod r)
publicInOutFunc
getFunc VisibilityTag
Priv = String
-> String
-> [CodeVarChunk]
-> [CodeVarChunk]
-> [MSBlock r]
-> GenState (SMethod r)
forall (r :: * -> *).
OOProg r =>
String
-> String
-> [CodeVarChunk]
-> [CodeVarChunk]
-> [MSBlock r]
-> GenState (SMethod r)
privateInOutMethod
genInFormat :: (OOProg r) => Bool -> GenState
(Maybe (SMethod r))
genInFormat :: forall {r :: * -> *}.
OOProg r =>
Bool -> StateT DrasilState Identity (Maybe (MS (r (Method r))))
genInFormat Bool
False = Maybe (MS (r (Method r)))
-> StateT DrasilState Identity (Maybe (MS (r (Method r))))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MS (r (Method r)))
forall a. Maybe a
Nothing
genInFormat Bool
_ = do
[CodeVarChunk]
ins <- GenState [CodeVarChunk]
getInputFormatIns
[CodeVarChunk]
outs <- GenState [CodeVarChunk]
getInputFormatOuts
[MS (r (Block r))]
bod <- DataDesc -> StateT DrasilState Identity [MS (r (Block r))]
forall (r :: * -> *). OOProg r => DataDesc -> GenState [MSBlock r]
readData DataDesc
dd
String
desc <- GenState String
inFmtFuncDesc
MS (r (Method r))
mthd <- VisibilityTag
-> String
-> String
-> [CodeVarChunk]
-> [CodeVarChunk]
-> [MS (r (Block r))]
-> StateT DrasilState Identity (MS (r (Method r)))
forall {r :: * -> *}.
OOProg r =>
VisibilityTag
-> String
-> String
-> [CodeVarChunk]
-> [CodeVarChunk]
-> [MSBlock r]
-> GenState (SMethod r)
getFunc VisibilityTag
s String
giName String
desc [CodeVarChunk]
ins [CodeVarChunk]
outs [MS (r (Block r))]
bod
Maybe (MS (r (Method r)))
-> StateT DrasilState Identity (Maybe (MS (r (Method r))))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MS (r (Method r)))
-> StateT DrasilState Identity (Maybe (MS (r (Method r)))))
-> Maybe (MS (r (Method r)))
-> StateT DrasilState Identity (Maybe (MS (r (Method r))))
forall a b. (a -> b) -> a -> b
$ MS (r (Method r)) -> Maybe (MS (r (Method r)))
forall a. a -> Maybe a
Just MS (r (Method r))
mthd
Bool -> GenState (Maybe (SMethod r))
forall {r :: * -> *}.
OOProg r =>
Bool -> StateT DrasilState Identity (Maybe (MS (r (Method r))))
genInFormat (Bool -> GenState (Maybe (SMethod r)))
-> Bool -> GenState (Maybe (SMethod r))
forall a b. (a -> b) -> a -> b
$ String
giName String -> Set String -> Bool
forall a. Eq a => a -> Set a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` DrasilState -> Set String
defSet DrasilState
g
genDataDesc :: GenState DataDesc
genDataDesc :: GenState DataDesc
genDataDesc = do
DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
DataDesc -> GenState DataDesc
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (DataDesc -> GenState DataDesc) -> DataDesc -> GenState DataDesc
forall a b. (a -> b) -> a -> b
$ Data
junkLine Data -> DataDesc -> DataDesc
forall a. a -> [a] -> [a]
:
Data -> DataDesc -> DataDesc
forall a. a -> [a] -> [a]
intersperse Data
junkLine ((CodeVarChunk -> Data) -> [CodeVarChunk] -> DataDesc
forall a b. (a -> b) -> [a] -> [b]
map CodeVarChunk -> Data
singleton (DrasilState -> CodeSpec
codeSpec DrasilState
g CodeSpec
-> Getting [CodeVarChunk] CodeSpec [CodeVarChunk] -> [CodeVarChunk]
forall s a. s -> Getting a s a -> a
^. Getting [CodeVarChunk] CodeSpec [CodeVarChunk]
forall c. HasOldCodeSpec c => Lens' c [CodeVarChunk]
Lens' CodeSpec [CodeVarChunk]
extInputsO))
genSampleInput :: (AuxiliarySym r) => GenState (Maybe (r (Auxiliary r)))
genSampleInput :: forall (r :: * -> *).
AuxiliarySym r =>
GenState (Maybe (r (Auxiliary r)))
genSampleInput = do
DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
DataDesc
dd <- GenState DataDesc
genDataDesc
if [AuxFile] -> Bool
hasSampleInput (DrasilState -> [AuxFile]
auxiliaries DrasilState
g) then Maybe (r (Auxiliary r)) -> GenState (Maybe (r (Auxiliary r)))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (r (Auxiliary r)) -> GenState (Maybe (r (Auxiliary r))))
-> (r (Auxiliary r) -> Maybe (r (Auxiliary r)))
-> r (Auxiliary r)
-> GenState (Maybe (r (Auxiliary r)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r (Auxiliary r) -> Maybe (r (Auxiliary r))
forall a. a -> Maybe a
Just (r (Auxiliary r) -> GenState (Maybe (r (Auxiliary r))))
-> r (Auxiliary r) -> GenState (Maybe (r (Auxiliary r)))
forall a b. (a -> b) -> a -> b
$ ChunkDB -> DataDesc -> [Expr] -> r (Auxiliary r)
forall (r :: * -> *).
AuxiliarySym r =>
ChunkDB -> DataDesc -> [Expr] -> r (Auxiliary r)
sampleInput
(DrasilState -> CodeSpec
codeSpec DrasilState
g CodeSpec -> Getting ChunkDB CodeSpec ChunkDB -> ChunkDB
forall s a. s -> Getting a s a -> a
^. Getting ChunkDB CodeSpec ChunkDB
forall c. HasOldCodeSpec c => Lens' c ChunkDB
Lens' CodeSpec ChunkDB
sysinfodbO) DataDesc
dd (DrasilState -> [Expr]
sampleData DrasilState
g) else Maybe (r (Auxiliary r)) -> GenState (Maybe (r (Auxiliary r)))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (r (Auxiliary r))
forall a. Maybe a
Nothing
genConstMod :: (OOProg r) => GenState [OO.SFile r]
genConstMod :: forall (r :: * -> *). OOProg r => GenState [SFile r]
genConstMod = do
String
cDesc <- GenState [String] -> GenState String
modDesc (GenState [String] -> GenState String)
-> GenState [String] -> GenState String
forall a b. (a -> b) -> a -> b
$ GenState String -> GenState [String]
forall a b. State a b -> State a [b]
liftS GenState String
constModDesc
String
cName <- InternalConcept -> GenState String
genICName InternalConcept
Constants
State DrasilState (SFile r) -> GenState [SFile r]
forall a b. State a b -> State a [b]
liftS (State DrasilState (SFile r) -> GenState [SFile r])
-> State DrasilState (SFile r) -> GenState [SFile r]
forall a b. (a -> b) -> a -> b
$ String
-> String
-> [GenState (Maybe (SMethod r))]
-> [GenState (Maybe (SClass r))]
-> State DrasilState (SFile r)
forall (r :: * -> *).
OOProg r =>
String
-> String
-> [GenState (Maybe (SMethod r))]
-> [GenState (Maybe (SClass r))]
-> GenState (SFile r)
genModule String
cName String
cDesc [] [ClassType -> GenState (Maybe (SClass r))
forall (r :: * -> *).
OOProg r =>
ClassType -> GenState (Maybe (SClass r))
genConstClass ClassType
Primary]
genConstClass :: (OOProg r) => ClassType ->
GenState (Maybe (SClass r))
genConstClass :: forall (r :: * -> *).
OOProg r =>
ClassType -> GenState (Maybe (SClass r))
genConstClass ClassType
scp = do
DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
(DrasilState -> DrasilState) -> StateT DrasilState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\DrasilState
st -> DrasilState
st {currentScope = Local})
String
cname <- InternalConcept -> GenState String
genICName InternalConcept
Constants
let cs :: [CodeDefinition]
cs = DrasilState -> CodeSpec
codeSpec DrasilState
g CodeSpec
-> Getting [CodeDefinition] CodeSpec [CodeDefinition]
-> [CodeDefinition]
forall s a. s -> Getting a s a -> a
^. Getting [CodeDefinition] CodeSpec [CodeDefinition]
forall c. HasOldCodeSpec c => Lens' c [CodeDefinition]
Lens' CodeSpec [CodeDefinition]
constantsO
genClass :: (OOProg r) => [CodeDefinition] -> GenState
(Maybe (SClass r))
genClass :: forall (r :: * -> *).
OOProg r =>
[CodeDefinition] -> GenState (Maybe (SClass r))
genClass [] = Maybe (CS (r (Class r)))
-> StateT DrasilState Identity (Maybe (CS (r (Class r))))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (CS (r (Class r)))
forall a. Maybe a
Nothing
genClass [CodeDefinition]
vs = do
[VS (r (Value r))]
vals <- (CodeDefinition -> StateT DrasilState Identity (VS (r (Value r))))
-> [CodeDefinition]
-> StateT DrasilState Identity [VS (r (Value r))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (CodeExpr -> StateT DrasilState Identity (VS (r (Value r)))
forall (r :: * -> *). OOProg r => CodeExpr -> GenState (SValue r)
convExpr (CodeExpr -> StateT DrasilState Identity (VS (r (Value r))))
-> (CodeDefinition -> CodeExpr)
-> CodeDefinition
-> StateT DrasilState Identity (VS (r (Value r)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CodeDefinition
-> Getting CodeExpr CodeDefinition CodeExpr -> CodeExpr
forall s a. s -> Getting a s a -> a
^. Getting CodeExpr CodeDefinition CodeExpr
forall c. DefiningCodeExpr c => Lens' c CodeExpr
Lens' CodeDefinition CodeExpr
codeExpr)) [CodeDefinition]
vs
[VS (r (Variable r))]
vars <- (CodeDefinition
-> StateT DrasilState Identity (VS (r (Variable r))))
-> [CodeDefinition]
-> StateT DrasilState Identity [VS (r (Variable r))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\CodeDefinition
x -> (CodeType -> VS (r (Variable r)))
-> StateT DrasilState Identity CodeType
-> StateT DrasilState Identity (VS (r (Variable r)))
forall a b.
(a -> b)
-> StateT DrasilState Identity a -> StateT DrasilState Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> VS (r (Type r)) -> VS (r (Variable r))
forall (r :: * -> *).
VariableSym r =>
String -> VSType r -> SVariable r
var (CodeDefinition -> String
forall c. CodeIdea c => c -> String
codeName CodeDefinition
x) (VS (r (Type r)) -> VS (r (Variable r)))
-> (CodeType -> VS (r (Type r))) -> CodeType -> VS (r (Variable r))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CodeType -> VS (r (Type r))
forall (r :: * -> *). OOTypeSym r => CodeType -> VSType r
convTypeOO)
(CodeDefinition -> StateT DrasilState Identity CodeType
forall c. HasSpace c => c -> StateT DrasilState Identity CodeType
codeType CodeDefinition
x)) [CodeDefinition]
vs
let constVars :: [CS (r (StateVar r))]
constVars = (VS (r (Variable r)) -> VS (r (Value r)) -> CS (r (StateVar r)))
-> [VS (r (Variable r))]
-> [VS (r (Value r))]
-> [CS (r (StateVar r))]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (ConstantRepr
-> VS (r (Variable r)) -> VS (r (Value r)) -> CS (r (StateVar r))
forall (r :: * -> *).
OOProg r =>
ConstantRepr -> SVariable r -> SValue r -> CSStateVar r
constVarFunc (DrasilState -> ConstantRepr
conRepr DrasilState
g)) [VS (r (Variable r))]
vars [VS (r (Value r))]
vals
getFunc :: ClassType
-> String
-> Maybe String
-> String
-> [CSStateVar r]
-> GenState [SMethod r]
-> GenState [SMethod r]
-> GenState (SClass r)
getFunc ClassType
Primary = String
-> Maybe String
-> String
-> [CSStateVar r]
-> GenState [SMethod r]
-> GenState [SMethod r]
-> GenState (SClass r)
forall (r :: * -> *).
OOProg r =>
String
-> Maybe String
-> String
-> [CSStateVar r]
-> GenState [SMethod r]
-> GenState [SMethod r]
-> GenState (SClass r)
primaryClass
getFunc ClassType
Auxiliary = String
-> Maybe String
-> String
-> [CSStateVar r]
-> GenState [SMethod r]
-> GenState [SMethod r]
-> GenState (SClass r)
forall (r :: * -> *).
OOProg r =>
String
-> Maybe String
-> String
-> [CSStateVar r]
-> GenState [SMethod r]
-> GenState [SMethod r]
-> GenState (SClass r)
auxClass
f :: String
-> Maybe String
-> String
-> [CS (r (StateVar r))]
-> GenState [MS (r (Method r))]
-> GenState [MS (r (Method r))]
-> GenState (CS (r (Class r)))
f = ClassType
-> String
-> Maybe String
-> String
-> [CS (r (StateVar r))]
-> GenState [MS (r (Method r))]
-> GenState [MS (r (Method r))]
-> GenState (CS (r (Class r)))
forall {r :: * -> *}.
OOProg r =>
ClassType
-> String
-> Maybe String
-> String
-> [CSStateVar r]
-> GenState [SMethod r]
-> GenState [SMethod r]
-> GenState (SClass r)
getFunc ClassType
scp
String
cDesc <- GenState String
constClassDesc
CS (r (Class r))
cls <- String
-> Maybe String
-> String
-> [CS (r (StateVar r))]
-> GenState [MS (r (Method r))]
-> GenState [MS (r (Method r))]
-> GenState (CS (r (Class r)))
f String
cname Maybe String
forall a. Maybe a
Nothing String
cDesc [CS (r (StateVar r))]
constVars ([MS (r (Method r))] -> GenState [MS (r (Method r))]
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return []) ([MS (r (Method r))] -> GenState [MS (r (Method r))]
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return [])
Maybe (CS (r (Class r)))
-> StateT DrasilState Identity (Maybe (CS (r (Class r))))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (CS (r (Class r)))
-> StateT DrasilState Identity (Maybe (CS (r (Class r)))))
-> Maybe (CS (r (Class r)))
-> StateT DrasilState Identity (Maybe (CS (r (Class r))))
forall a b. (a -> b) -> a -> b
$ CS (r (Class r)) -> Maybe (CS (r (Class r)))
forall a. a -> Maybe a
Just CS (r (Class r))
cls
[CodeDefinition] -> GenState (Maybe (SClass r))
forall (r :: * -> *).
OOProg r =>
[CodeDefinition] -> GenState (Maybe (SClass r))
genClass ([CodeDefinition] -> GenState (Maybe (SClass r)))
-> [CodeDefinition] -> GenState (Maybe (SClass r))
forall a b. (a -> b) -> a -> b
$ (CodeDefinition -> Bool) -> [CodeDefinition] -> [CodeDefinition]
forall a. (a -> Bool) -> [a] -> [a]
filter ((String -> Map String String -> Bool)
-> Map String String -> String -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> Map String String -> Bool
forall k a. Ord k => k -> Map k a -> Bool
member ((String -> Bool) -> Map String String -> Map String String
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (String
cname String -> String -> Bool
forall a. Eq a => a -> a -> Bool
==) (DrasilState -> Map String String
clsMap DrasilState
g))
(String -> Bool)
-> (CodeDefinition -> String) -> CodeDefinition -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CodeDefinition -> String
forall c. CodeIdea c => c -> String
codeName) [CodeDefinition]
cs
genCalcMod :: (OOProg r) => GenState (OO.SFile r)
genCalcMod :: forall (r :: * -> *). OOProg r => GenState (SFile r)
genCalcMod = do
DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
String
cName <- InternalConcept -> GenState String
genICName InternalConcept
Calculations
let elmap :: ExtLibMap
elmap = DrasilState -> ExtLibMap
extLibMap DrasilState
g
String
-> String
-> [String]
-> [GenState (Maybe (SMethod r))]
-> [GenState (Maybe (SClass r))]
-> GenState (SFile r)
forall (r :: * -> *).
OOProg r =>
String
-> String
-> [String]
-> [GenState (Maybe (SMethod r))]
-> [GenState (Maybe (SClass r))]
-> GenState (SFile r)
genModuleWithImports String
cName String
calcModDesc ((ExtLibState -> [String]) -> [ExtLibState] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (ExtLibState -> Getting [String] ExtLibState [String] -> [String]
forall s a. s -> Getting a s a -> a
^. Getting [String] ExtLibState [String]
Lens' ExtLibState [String]
imports) ([ExtLibState] -> [String]) -> [ExtLibState] -> [String]
forall a b. (a -> b) -> a -> b
$
ExtLibMap -> [ExtLibState]
forall k a. Map k a -> [a]
elems ExtLibMap
elmap) ((CodeDefinition -> GenState (Maybe (SMethod r)))
-> [CodeDefinition] -> [GenState (Maybe (SMethod r))]
forall a b. (a -> b) -> [a] -> [b]
map ((SMethod r -> Maybe (SMethod r))
-> StateT DrasilState Identity (SMethod r)
-> GenState (Maybe (SMethod r))
forall a b.
(a -> b)
-> StateT DrasilState Identity a -> StateT DrasilState Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SMethod r -> Maybe (SMethod r)
forall a. a -> Maybe a
Just (StateT DrasilState Identity (SMethod r)
-> GenState (Maybe (SMethod r)))
-> (CodeDefinition -> StateT DrasilState Identity (SMethod r))
-> CodeDefinition
-> GenState (Maybe (SMethod r))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CodeDefinition -> StateT DrasilState Identity (SMethod r)
forall (r :: * -> *).
OOProg r =>
CodeDefinition -> GenState (SMethod r)
genCalcFunc) (DrasilState -> CodeSpec
codeSpec DrasilState
g CodeSpec
-> Getting [CodeDefinition] CodeSpec [CodeDefinition]
-> [CodeDefinition]
forall s a. s -> Getting a s a -> a
^. Getting [CodeDefinition] CodeSpec [CodeDefinition]
forall c. HasOldCodeSpec c => Lens' c [CodeDefinition]
Lens' CodeSpec [CodeDefinition]
execOrderO)) []
genCalcFunc :: (OOProg r) => CodeDefinition ->
GenState (SMethod r)
genCalcFunc :: forall (r :: * -> *).
OOProg r =>
CodeDefinition -> GenState (SMethod r)
genCalcFunc CodeDefinition
cdef = do
DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
(DrasilState -> DrasilState) -> StateT DrasilState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\DrasilState
st -> DrasilState
st {currentScope = Local})
[CodeVarChunk]
parms <- CodeDefinition -> GenState [CodeVarChunk]
getCalcParams CodeDefinition
cdef
let nm :: String
nm = CodeDefinition -> String
forall c. CodeIdea c => c -> String
codeName CodeDefinition
cdef
CodeType
tp <- CodeDefinition -> StateT DrasilState Identity CodeType
forall c. HasSpace c => c -> StateT DrasilState Identity CodeType
codeType CodeDefinition
cdef
VS (r (Variable r))
v <- CodeVarChunk -> StateT DrasilState Identity (VS (r (Variable r)))
forall (r :: * -> *).
OOProg r =>
CodeVarChunk -> GenState (SVariable r)
mkVar (CodeDefinition -> CodeVarChunk
forall c. (Quantity c, MayHaveUnit c) => c -> CodeVarChunk
quantvar CodeDefinition
cdef)
[MS (r (Block r))]
blcks <- case CodeDefinition
cdef CodeDefinition
-> Getting DefinitionType CodeDefinition DefinitionType
-> DefinitionType
forall s a. s -> Getting a s a -> a
^. Getting DefinitionType CodeDefinition DefinitionType
Lens' CodeDefinition DefinitionType
defType
of DefinitionType
Definition -> State DrasilState (MS (r (Block r)))
-> StateT DrasilState Identity [MS (r (Block r))]
forall a b. State a b -> State a [b]
liftS (State DrasilState (MS (r (Block r)))
-> StateT DrasilState Identity [MS (r (Block r))])
-> State DrasilState (MS (r (Block r)))
-> StateT DrasilState Identity [MS (r (Block r))]
forall a b. (a -> b) -> a -> b
$ CalcType
-> CodeDefinition
-> CodeExpr
-> State DrasilState (MS (r (Block r)))
forall (r :: * -> *).
OOProg r =>
CalcType -> CodeDefinition -> CodeExpr -> GenState (MSBlock r)
genCalcBlock CalcType
CalcReturn CodeDefinition
cdef
(CodeDefinition
cdef CodeDefinition
-> Getting CodeExpr CodeDefinition CodeExpr -> CodeExpr
forall s a. s -> Getting a s a -> a
^. Getting CodeExpr CodeDefinition CodeExpr
forall c. DefiningCodeExpr c => Lens' c CodeExpr
Lens' CodeDefinition CodeExpr
codeExpr)
DefinitionType
ODE -> StateT DrasilState Identity [MS (r (Block r))]
-> (ExtLibState -> StateT DrasilState Identity [MS (r (Block r))])
-> Maybe ExtLibState
-> StateT DrasilState Identity [MS (r (Block r))]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> StateT DrasilState Identity [MS (r (Block r))]
forall a. HasCallStack => String -> a
error (String -> StateT DrasilState Identity [MS (r (Block r))])
-> String -> StateT DrasilState Identity [MS (r (Block r))]
forall a b. (a -> b) -> a -> b
$ String
nm String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" missing from ExtLibMap")
(\ExtLibState
el -> do
[MS (r (Statement r))]
defStmts <- (FuncStmt -> StateT DrasilState Identity (MS (r (Statement r))))
-> [FuncStmt] -> StateT DrasilState Identity [MS (r (Statement r))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM FuncStmt -> StateT DrasilState Identity (MS (r (Statement r)))
forall (r :: * -> *).
OOProg r =>
FuncStmt -> GenState (MSStatement r)
convStmt (ExtLibState
el ExtLibState
-> Getting [FuncStmt] ExtLibState [FuncStmt] -> [FuncStmt]
forall s a. s -> Getting a s a -> a
^. Getting [FuncStmt] ExtLibState [FuncStmt]
Lens' ExtLibState [FuncStmt]
defs)
[MS (r (Statement r))]
stepStmts <- (FuncStmt -> StateT DrasilState Identity (MS (r (Statement r))))
-> [FuncStmt] -> StateT DrasilState Identity [MS (r (Statement r))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM FuncStmt -> StateT DrasilState Identity (MS (r (Statement r)))
forall (r :: * -> *).
OOProg r =>
FuncStmt -> GenState (MSStatement r)
convStmt (ExtLibState
el ExtLibState
-> Getting [FuncStmt] ExtLibState [FuncStmt] -> [FuncStmt]
forall s a. s -> Getting a s a -> a
^. Getting [FuncStmt] ExtLibState [FuncStmt]
Lens' ExtLibState [FuncStmt]
steps)
[MS (r (Block r))]
-> StateT DrasilState Identity [MS (r (Block r))]
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return [[MS (r (Statement r))] -> MS (r (Block r))
forall (r :: * -> *). BlockSym r => [MSStatement r] -> MSBlock r
block (VS (r (Variable r)) -> r (Scope r) -> MS (r (Statement r))
forall (r :: * -> *).
DeclStatement r =>
SVariable r -> r (Scope r) -> MSStatement r
varDec VS (r (Variable r))
v r (Scope r)
forall (r :: * -> *). ScopeSym r => r (Scope r)
local MS (r (Statement r))
-> [MS (r (Statement r))] -> [MS (r (Statement r))]
forall a. a -> [a] -> [a]
: [MS (r (Statement r))]
defStmts),
[MS (r (Statement r))] -> MS (r (Block r))
forall (r :: * -> *). BlockSym r => [MSStatement r] -> MSBlock r
block [MS (r (Statement r))]
stepStmts,
[MS (r (Statement r))] -> MS (r (Block r))
forall (r :: * -> *). BlockSym r => [MSStatement r] -> MSBlock r
block [SValue r -> MS (r (Statement r))
forall (r :: * -> *).
ControlStatement r =>
SValue r -> MSStatement r
returnStmt (SValue r -> MS (r (Statement r)))
-> SValue r -> MS (r (Statement r))
forall a b. (a -> b) -> a -> b
$ VS (r (Variable r)) -> SValue r
forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
valueOf VS (r (Variable r))
v]])
(String -> ExtLibMap -> Maybe ExtLibState
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
nm (DrasilState -> ExtLibMap
extLibMap DrasilState
g))
String
desc <- CodeDefinition -> GenState String
forall c. CodeIdea c => c -> GenState String
getComment CodeDefinition
cdef
String
-> VSType r
-> String
-> [ParameterChunk]
-> Maybe String
-> [MS (r (Block r))]
-> GenState (SMethod r)
forall (r :: * -> *).
OOProg r =>
String
-> VSType r
-> String
-> [ParameterChunk]
-> Maybe String
-> [MSBlock r]
-> GenState (SMethod r)
publicFunc
String
nm
(CodeType -> VSType r
forall (r :: * -> *). OOTypeSym r => CodeType -> VSType r
convTypeOO CodeType
tp)
(String
"Calculates " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
desc)
((CodeVarChunk -> ParameterChunk)
-> [CodeVarChunk] -> [ParameterChunk]
forall a b. (a -> b) -> [a] -> [b]
map CodeVarChunk -> ParameterChunk
forall c. CodeIdea c => c -> ParameterChunk
pcAuto [CodeVarChunk]
parms)
(String -> Maybe String
forall a. a -> Maybe a
Just String
desc)
[MS (r (Block r))]
blcks
data CalcType = CalcAssign | CalcReturn deriving CalcType -> CalcType -> Bool
(CalcType -> CalcType -> Bool)
-> (CalcType -> CalcType -> Bool) -> Eq CalcType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CalcType -> CalcType -> Bool
== :: CalcType -> CalcType -> Bool
$c/= :: CalcType -> CalcType -> Bool
/= :: CalcType -> CalcType -> Bool
Eq
genCalcBlock :: (OOProg r) => CalcType -> CodeDefinition -> CodeExpr ->
GenState (MSBlock r)
genCalcBlock :: forall (r :: * -> *).
OOProg r =>
CalcType -> CodeDefinition -> CodeExpr -> GenState (MSBlock r)
genCalcBlock CalcType
t CodeDefinition
v (Case Completeness
c [(CodeExpr, CodeExpr)]
e) = CalcType
-> CodeDefinition
-> Completeness
-> [(CodeExpr, CodeExpr)]
-> StateT
DrasilState Identity (StateT MethodState Identity (r (Block r)))
forall (r :: * -> *).
OOProg r =>
CalcType
-> CodeDefinition
-> Completeness
-> [(CodeExpr, CodeExpr)]
-> GenState (MSBlock r)
genCaseBlock CalcType
t CodeDefinition
v Completeness
c [(CodeExpr, CodeExpr)]
e
genCalcBlock CalcType
CalcAssign CodeDefinition
v CodeExpr
e = do
VS (r (Variable r))
vv <- CodeVarChunk -> StateT DrasilState Identity (VS (r (Variable r)))
forall (r :: * -> *).
OOProg r =>
CodeVarChunk -> GenState (SVariable r)
mkVar (CodeDefinition -> CodeVarChunk
forall c. (Quantity c, MayHaveUnit c) => c -> CodeVarChunk
quantvar CodeDefinition
v)
VS (r (Value r))
ee <- CodeExpr -> StateT DrasilState Identity (VS (r (Value r)))
forall (r :: * -> *). OOProg r => CodeExpr -> GenState (SValue r)
convExpr CodeExpr
e
[MS (r (Statement r))]
l <- VS (r (Variable r))
-> StateT DrasilState Identity [MS (r (Statement r))]
forall (r :: * -> *).
SharedProg r =>
SVariable r -> GenState [MSStatement r]
maybeLog VS (r (Variable r))
vv
StateT MethodState Identity (r (Block r))
-> StateT
DrasilState Identity (StateT MethodState Identity (r (Block r)))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (StateT MethodState Identity (r (Block r))
-> StateT
DrasilState Identity (StateT MethodState Identity (r (Block r))))
-> StateT MethodState Identity (r (Block r))
-> StateT
DrasilState Identity (StateT MethodState Identity (r (Block r)))
forall a b. (a -> b) -> a -> b
$ [MS (r (Statement r))] -> StateT MethodState Identity (r (Block r))
forall (r :: * -> *). BlockSym r => [MSStatement r] -> MSBlock r
block ([MS (r (Statement r))]
-> StateT MethodState Identity (r (Block r)))
-> [MS (r (Statement r))]
-> StateT MethodState Identity (r (Block r))
forall a b. (a -> b) -> a -> b
$ VS (r (Variable r)) -> VS (r (Value r)) -> MS (r (Statement r))
forall (r :: * -> *).
AssignStatement r =>
SVariable r -> SValue r -> MSStatement r
assign VS (r (Variable r))
vv VS (r (Value r))
ee MS (r (Statement r))
-> [MS (r (Statement r))] -> [MS (r (Statement r))]
forall a. a -> [a] -> [a]
: [MS (r (Statement r))]
l
genCalcBlock CalcType
CalcReturn CodeDefinition
_ CodeExpr
e = [MS (r (Statement r))] -> StateT MethodState Identity (r (Block r))
forall (r :: * -> *). BlockSym r => [MSStatement r] -> MSBlock r
block ([MS (r (Statement r))]
-> StateT MethodState Identity (r (Block r)))
-> StateT DrasilState Identity [MS (r (Statement r))]
-> StateT
DrasilState Identity (StateT MethodState Identity (r (Block r)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> State DrasilState (MS (r (Statement r)))
-> StateT DrasilState Identity [MS (r (Statement r))]
forall a b. State a b -> State a [b]
liftS (VS (r (Value r)) -> MS (r (Statement r))
forall (r :: * -> *).
ControlStatement r =>
SValue r -> MSStatement r
returnStmt (VS (r (Value r)) -> MS (r (Statement r)))
-> StateT DrasilState Identity (VS (r (Value r)))
-> State DrasilState (MS (r (Statement r)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CodeExpr -> StateT DrasilState Identity (VS (r (Value r)))
forall (r :: * -> *). OOProg r => CodeExpr -> GenState (SValue r)
convExpr CodeExpr
e)
genCaseBlock :: (OOProg r) => CalcType -> CodeDefinition -> Completeness
-> [(CodeExpr, CodeExpr)] -> GenState (MSBlock r)
genCaseBlock :: forall (r :: * -> *).
OOProg r =>
CalcType
-> CodeDefinition
-> Completeness
-> [(CodeExpr, CodeExpr)]
-> GenState (MSBlock r)
genCaseBlock CalcType
_ CodeDefinition
_ Completeness
_ [] = String -> GenState (MSBlock r)
forall a. HasCallStack => String -> a
error (String -> GenState (MSBlock r)) -> String -> GenState (MSBlock r)
forall a b. (a -> b) -> a -> b
$ String
"Case expression with no cases encountered" String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
" in code generator"
genCaseBlock CalcType
t CodeDefinition
v Completeness
c [(CodeExpr, CodeExpr)]
cs = do
[(VS (r (Value r)), MS (r (Body r)))]
ifs <- ((CodeExpr, CodeExpr)
-> StateT DrasilState Identity (VS (r (Value r)), MS (r (Body r))))
-> [(CodeExpr, CodeExpr)]
-> StateT
DrasilState Identity [(VS (r (Value r)), MS (r (Body r)))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\(CodeExpr
e,CodeExpr
r) -> (VS (r (Value r))
-> MS (r (Body r)) -> (VS (r (Value r)), MS (r (Body r))))
-> StateT DrasilState Identity (VS (r (Value r)))
-> StateT DrasilState Identity (MS (r (Body r)))
-> StateT DrasilState Identity (VS (r (Value r)), MS (r (Body r)))
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) (CodeExpr -> StateT DrasilState Identity (VS (r (Value r)))
forall (r :: * -> *). OOProg r => CodeExpr -> GenState (SValue r)
convExpr CodeExpr
r) (CodeExpr -> StateT DrasilState Identity (MS (r (Body r)))
forall {r :: * -> *}.
OOProg r =>
CodeExpr -> StateT DrasilState Identity (MS (r (Body r)))
calcBody CodeExpr
e)) (Completeness -> [(CodeExpr, CodeExpr)]
ifEs Completeness
c)
MS (r (Body r))
els <- Completeness -> StateT DrasilState Identity (MS (r (Body r)))
forall {r :: * -> *}.
OOProg r =>
Completeness -> StateT DrasilState Identity (MS (r (Body r)))
elseE Completeness
c
MSBlock r -> GenState (MSBlock r)
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (MSBlock r -> GenState (MSBlock r))
-> MSBlock r -> GenState (MSBlock r)
forall a b. (a -> b) -> a -> b
$ [MSStatement r] -> MSBlock r
forall (r :: * -> *). BlockSym r => [MSStatement r] -> MSBlock r
block [[(VS (r (Value r)), MS (r (Body r)))]
-> MS (r (Body r)) -> MSStatement r
forall (r :: * -> *).
ControlStatement r =>
[(SValue r, MSBody r)] -> MSBody r -> MSStatement r
ifCond [(VS (r (Value r)), MS (r (Body r)))]
ifs MS (r (Body r))
els]
where calcBody :: CodeExpr -> StateT DrasilState Identity (MS (r (Body r)))
calcBody CodeExpr
e = ([MS (r (Block r))] -> MS (r (Body r)))
-> StateT DrasilState Identity [MS (r (Block r))]
-> StateT DrasilState Identity (MS (r (Body r)))
forall a b.
(a -> b)
-> StateT DrasilState Identity a -> StateT DrasilState Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [MS (r (Block r))] -> MS (r (Body r))
forall (r :: * -> *). BodySym r => [MSBlock r] -> MSBody r
body (StateT DrasilState Identity [MS (r (Block r))]
-> StateT DrasilState Identity (MS (r (Body r))))
-> StateT DrasilState Identity [MS (r (Block r))]
-> StateT DrasilState Identity (MS (r (Body r)))
forall a b. (a -> b) -> a -> b
$ State DrasilState (MS (r (Block r)))
-> StateT DrasilState Identity [MS (r (Block r))]
forall a b. State a b -> State a [b]
liftS (State DrasilState (MS (r (Block r)))
-> StateT DrasilState Identity [MS (r (Block r))])
-> State DrasilState (MS (r (Block r)))
-> StateT DrasilState Identity [MS (r (Block r))]
forall a b. (a -> b) -> a -> b
$ CalcType
-> CodeDefinition
-> CodeExpr
-> State DrasilState (MS (r (Block r)))
forall (r :: * -> *).
OOProg r =>
CalcType -> CodeDefinition -> CodeExpr -> GenState (MSBlock r)
genCalcBlock CalcType
t CodeDefinition
v CodeExpr
e
ifEs :: Completeness -> [(CodeExpr, CodeExpr)]
ifEs Completeness
Complete = [(CodeExpr, CodeExpr)] -> [(CodeExpr, CodeExpr)]
forall a. HasCallStack => [a] -> [a]
init [(CodeExpr, CodeExpr)]
cs
ifEs Completeness
Incomplete = [(CodeExpr, CodeExpr)]
cs
elseE :: Completeness -> StateT DrasilState Identity (MS (r (Body r)))
elseE Completeness
Complete = CodeExpr -> StateT DrasilState Identity (MS (r (Body r)))
forall {r :: * -> *}.
OOProg r =>
CodeExpr -> StateT DrasilState Identity (MS (r (Body r)))
calcBody (CodeExpr -> StateT DrasilState Identity (MS (r (Body r))))
-> CodeExpr -> StateT DrasilState Identity (MS (r (Body r)))
forall a b. (a -> b) -> a -> b
$ (CodeExpr, CodeExpr) -> CodeExpr
forall a b. (a, b) -> a
fst ((CodeExpr, CodeExpr) -> CodeExpr)
-> (CodeExpr, CodeExpr) -> CodeExpr
forall a b. (a -> b) -> a -> b
$ [(CodeExpr, CodeExpr)] -> (CodeExpr, CodeExpr)
forall a. HasCallStack => [a] -> a
last [(CodeExpr, CodeExpr)]
cs
elseE Completeness
Incomplete = MS (r (Body r)) -> StateT DrasilState Identity (MS (r (Body r)))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (MS (r (Body r)) -> StateT DrasilState Identity (MS (r (Body r))))
-> MS (r (Body r)) -> StateT DrasilState Identity (MS (r (Body r)))
forall a b. (a -> b) -> a -> b
$ MSStatement r -> MS (r (Body r))
forall (r :: * -> *). BodySym r => MSStatement r -> MSBody r
oneLiner (MSStatement r -> MS (r (Body r)))
-> MSStatement r -> MS (r (Body r))
forall a b. (a -> b) -> a -> b
$ String -> MSStatement r
forall (r :: * -> *). ControlStatement r => String -> MSStatement r
throw (String -> MSStatement r) -> String -> MSStatement r
forall a b. (a -> b) -> a -> b
$
String
"Undefined case encountered in function " String -> String -> String
forall a. [a] -> [a] -> [a]
++ CodeDefinition -> String
forall c. CodeIdea c => c -> String
codeName CodeDefinition
v
genOutputMod :: (OOProg r) => GenState [OO.SFile r]
genOutputMod :: forall (r :: * -> *). OOProg r => GenState [SFile r]
genOutputMod = do
String
ofName <- InternalConcept -> GenState String
genICName InternalConcept
OutputFormat
String
ofDesc <- GenState [String] -> GenState String
modDesc (GenState [String] -> GenState String)
-> GenState [String] -> GenState String
forall a b. (a -> b) -> a -> b
$ GenState String -> GenState [String]
forall a b. State a b -> State a [b]
liftS GenState String
outputFormatDesc
State DrasilState (SFile r) -> GenState [SFile r]
forall a b. State a b -> State a [b]
liftS (State DrasilState (SFile r) -> GenState [SFile r])
-> State DrasilState (SFile r) -> GenState [SFile r]
forall a b. (a -> b) -> a -> b
$ String
-> String
-> [GenState (Maybe (SMethod r))]
-> [GenState (Maybe (SClass r))]
-> State DrasilState (SFile r)
forall (r :: * -> *).
OOProg r =>
String
-> String
-> [GenState (Maybe (SMethod r))]
-> [GenState (Maybe (SClass r))]
-> GenState (SFile r)
genModule String
ofName String
ofDesc [GenState (Maybe (SMethod r))
forall (r :: * -> *). OOProg r => GenState (Maybe (SMethod r))
genOutputFormat] []
genOutputFormat :: (OOProg r) => GenState (Maybe (SMethod r))
genOutputFormat :: forall (r :: * -> *). OOProg r => GenState (Maybe (SMethod r))
genOutputFormat = do
DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
(DrasilState -> DrasilState) -> StateT DrasilState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\DrasilState
st -> DrasilState
st {currentScope = Local})
String
woName <- InternalConcept -> GenState String
genICName InternalConcept
WriteOutput
let genOutput :: (OOProg r) => Maybe String -> GenState (Maybe (SMethod r))
genOutput :: forall (r :: * -> *).
OOProg r =>
Maybe String -> GenState (Maybe (SMethod r))
genOutput Maybe String
Nothing = Maybe (MS (r (Method r)))
-> StateT DrasilState Identity (Maybe (MS (r (Method r))))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MS (r (Method r)))
forall a. Maybe a
Nothing
genOutput (Just String
_) = do
let l_outfile :: String
l_outfile = String
"outputfile"
var_outfile :: SVariable r
var_outfile = String -> VSType r -> SVariable r
forall (r :: * -> *).
VariableSym r =>
String -> VSType r -> SVariable r
var String
l_outfile VSType r
forall (r :: * -> *). TypeSym r => VSType r
outfile
v_outfile :: SValue r
v_outfile = SVariable r -> SValue r
forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
valueOf SVariable r
var_outfile
[CodeVarChunk]
parms <- GenState [CodeVarChunk]
getOutputParams
[[MS (r (Statement r))]]
outp <- (CodeVarChunk
-> StateT DrasilState Identity [MS (r (Statement r))])
-> [CodeVarChunk]
-> StateT DrasilState Identity [[MS (r (Statement r))]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\CodeVarChunk
x -> do
SValue r
v <- CodeVarChunk -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *).
OOProg r =>
CodeVarChunk -> GenState (SValue r)
mkVal CodeVarChunk
x
[MS (r (Statement r))]
-> StateT DrasilState Identity [MS (r (Statement r))]
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return [ SValue r -> String -> MS (r (Statement r))
forall (r :: * -> *).
IOStatement r =>
SValue r -> String -> MSStatement r
printFileStr SValue r
v_outfile (CodeVarChunk -> String
forall c. CodeIdea c => c -> String
codeName CodeVarChunk
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" = "),
SValue r -> SValue r -> MS (r (Statement r))
forall (r :: * -> *).
IOStatement r =>
SValue r -> SValue r -> MSStatement r
printFileLn SValue r
v_outfile SValue r
v
] ) (DrasilState -> CodeSpec
codeSpec DrasilState
g CodeSpec
-> Getting [CodeVarChunk] CodeSpec [CodeVarChunk] -> [CodeVarChunk]
forall s a. s -> Getting a s a -> a
^. Getting [CodeVarChunk] CodeSpec [CodeVarChunk]
forall c. HasOldCodeSpec c => Lens' c [CodeVarChunk]
Lens' CodeSpec [CodeVarChunk]
outputsO)
String
desc <- GenState String
woFuncDesc
MS (r (Method r))
mthd <- String
-> VSType r
-> String
-> [ParameterChunk]
-> Maybe String
-> [MSBlock r]
-> StateT DrasilState Identity (MS (r (Method r)))
forall (r :: * -> *).
OOProg r =>
String
-> VSType r
-> String
-> [ParameterChunk]
-> Maybe String
-> [MSBlock r]
-> GenState (SMethod r)
publicFunc String
woName VSType r
forall (r :: * -> *). TypeSym r => VSType r
void String
desc ((CodeVarChunk -> ParameterChunk)
-> [CodeVarChunk] -> [ParameterChunk]
forall a b. (a -> b) -> [a] -> [b]
map CodeVarChunk -> ParameterChunk
forall c. CodeIdea c => c -> ParameterChunk
pcAuto [CodeVarChunk]
parms) Maybe String
forall a. Maybe a
Nothing
[[MS (r (Statement r))] -> MSBlock r
forall (r :: * -> *). BlockSym r => [MSStatement r] -> MSBlock r
block ([MS (r (Statement r))] -> MSBlock r)
-> [MS (r (Statement r))] -> MSBlock r
forall a b. (a -> b) -> a -> b
$ [
SVariable r -> r (Scope r) -> MS (r (Statement r))
forall (r :: * -> *).
DeclStatement r =>
SVariable r -> r (Scope r) -> MSStatement r
varDec SVariable r
var_outfile r (Scope r)
forall (r :: * -> *). ScopeSym r => r (Scope r)
local,
SVariable r -> SValue r -> MS (r (Statement r))
forall (r :: * -> *).
IOStatement r =>
SVariable r -> SValue r -> MSStatement r
openFileW SVariable r
var_outfile (String -> SValue r
forall (r :: * -> *). Literal r => String -> SValue r
litString String
"output.txt") ] [MS (r (Statement r))]
-> [MS (r (Statement r))] -> [MS (r (Statement r))]
forall a. [a] -> [a] -> [a]
++
[[MS (r (Statement r))]] -> [MS (r (Statement r))]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[MS (r (Statement r))]]
outp [MS (r (Statement r))]
-> [MS (r (Statement r))] -> [MS (r (Statement r))]
forall a. [a] -> [a] -> [a]
++ [ SValue r -> MS (r (Statement r))
forall (r :: * -> *). IOStatement r => SValue r -> MSStatement r
closeFile SValue r
v_outfile ]]
Maybe (MS (r (Method r)))
-> StateT DrasilState Identity (Maybe (MS (r (Method r))))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MS (r (Method r)))
-> StateT DrasilState Identity (Maybe (MS (r (Method r)))))
-> Maybe (MS (r (Method r)))
-> StateT DrasilState Identity (Maybe (MS (r (Method r))))
forall a b. (a -> b) -> a -> b
$ MS (r (Method r)) -> Maybe (MS (r (Method r)))
forall a. a -> Maybe a
Just MS (r (Method r))
mthd
Maybe String -> GenState (Maybe (SMethod r))
forall (r :: * -> *).
OOProg r =>
Maybe String -> GenState (Maybe (SMethod r))
genOutput (Maybe String -> GenState (Maybe (SMethod r)))
-> Maybe String -> GenState (Maybe (SMethod r))
forall a b. (a -> b) -> a -> b
$ String -> Map String String -> Maybe String
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
woName (DrasilState -> Map String String
eMap DrasilState
g)
genMainProc :: (ProcProg r) => GenState (Proc.SFile r)
genMainProc :: forall (r :: * -> *). ProcProg r => GenState (SFile r)
genMainProc = String
-> String
-> [GenState (Maybe (SMethod r))]
-> StateT
DrasilState Identity (StateT FileState Identity (r (File r)))
forall (r :: * -> *).
ProcProg r =>
String
-> String -> [GenState (Maybe (SMethod r))] -> GenState (SFile r)
genModuleProc String
"Control" String
"Controls the flow of the program"
[GenState (Maybe (SMethod r))
forall (r :: * -> *). SharedProg r => GenState (Maybe (SMethod r))
genMainFuncProc]
genMainFuncProc :: (SharedProg r) => GenState (Maybe (SMethod r))
genMainFuncProc :: forall (r :: * -> *). SharedProg r => GenState (Maybe (SMethod r))
genMainFuncProc = do
DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
let mainFunc :: ImplementationType
-> StateT DrasilState Identity (Maybe (MS (r (Method r))))
mainFunc ImplementationType
Library = Maybe (MS (r (Method r)))
-> StateT DrasilState Identity (Maybe (MS (r (Method r))))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MS (r (Method r)))
forall a. Maybe a
Nothing
mainFunc ImplementationType
Program = do
(DrasilState -> DrasilState) -> StateT DrasilState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\DrasilState
st -> DrasilState
st {currentScope = MainFn})
VS (r (Variable r))
v_filename <- CodeVarChunk -> StateT DrasilState Identity (VS (r (Variable r)))
forall (r :: * -> *).
SharedProg r =>
CodeVarChunk -> GenState (SVariable r)
mkVarProc (QuantityDict -> CodeVarChunk
forall c. (Quantity c, MayHaveUnit c) => c -> CodeVarChunk
quantvar QuantityDict
inFileName)
[MS (r (Statement r))]
logInFile <- VS (r (Variable r))
-> StateT DrasilState Identity [MS (r (Statement r))]
forall (r :: * -> *).
SharedProg r =>
SVariable r -> GenState [MSStatement r]
maybeLog VS (r (Variable r))
v_filename
Maybe (MS (r (Statement r)))
co <- GenState (Maybe (MS (r (Statement r))))
forall (r :: * -> *).
SharedProg r =>
GenState (Maybe (MSStatement r))
initConstsProc
Maybe (MS (r (Statement r)))
ip <- GenState (Maybe (MS (r (Statement r))))
forall (r :: * -> *).
SharedProg r =>
GenState (Maybe (MSStatement r))
getInputDeclProc
[MS (r (Statement r))]
ics <- StateT DrasilState Identity [MS (r (Statement r))]
forall (r :: * -> *). SharedProg r => GenState [MSStatement r]
genAllInputCallsProc
[Maybe (MS (r (Statement r)))]
varDef <- (CodeDefinition -> GenState (Maybe (MS (r (Statement r)))))
-> [CodeDefinition]
-> StateT DrasilState Identity [Maybe (MS (r (Statement r)))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM CodeDefinition -> GenState (Maybe (MS (r (Statement r))))
forall (r :: * -> *).
SharedProg r =>
CodeDefinition -> GenState (Maybe (MSStatement r))
genCalcCallProc (DrasilState -> CodeSpec
codeSpec DrasilState
g CodeSpec
-> Getting [CodeDefinition] CodeSpec [CodeDefinition]
-> [CodeDefinition]
forall s a. s -> Getting a s a -> a
^. Getting [CodeDefinition] CodeSpec [CodeDefinition]
forall c. HasOldCodeSpec c => Lens' c [CodeDefinition]
Lens' CodeSpec [CodeDefinition]
execOrderO)
Maybe (MS (r (Statement r)))
wo <- GenState (Maybe (MS (r (Statement r))))
forall (r :: * -> *).
SharedProg r =>
GenState (Maybe (MSStatement r))
genOutputCallProc
Maybe (MS (r (Method r)))
-> StateT DrasilState Identity (Maybe (MS (r (Method r))))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MS (r (Method r)))
-> StateT DrasilState Identity (Maybe (MS (r (Method r)))))
-> Maybe (MS (r (Method r)))
-> StateT DrasilState Identity (Maybe (MS (r (Method r))))
forall a b. (a -> b) -> a -> b
$ MS (r (Method r)) -> Maybe (MS (r (Method r)))
forall a. a -> Maybe a
Just (MS (r (Method r)) -> Maybe (MS (r (Method r))))
-> MS (r (Method r)) -> Maybe (MS (r (Method r)))
forall a b. (a -> b) -> a -> b
$ (if Comments
CommentFunc Comments -> [Comments] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` DrasilState -> [Comments]
commented DrasilState
g then MS (r (Body r)) -> MS (r (Method r))
forall (r :: * -> *). MethodSym r => MSBody r -> SMethod r
docMain else
MS (r (Body r)) -> MS (r (Method r))
forall (r :: * -> *). MethodSym r => MSBody r -> SMethod r
mainFunction) (MS (r (Body r)) -> MS (r (Method r)))
-> MS (r (Body r)) -> MS (r (Method r))
forall a b. (a -> b) -> a -> b
$ [MS (r (Statement r))] -> MS (r (Body r))
forall (r :: * -> *). BodySym r => [MSStatement r] -> MSBody r
bodyStatements ([MS (r (Statement r))] -> MS (r (Body r)))
-> [MS (r (Statement r))] -> MS (r (Body r))
forall a b. (a -> b) -> a -> b
$ [Logging] -> r (Scope r) -> [MS (r (Statement r))]
forall (r :: * -> *).
SharedProg r =>
[Logging] -> r (Scope r) -> [MSStatement r]
initLogFileVar (DrasilState -> [Logging]
logKind DrasilState
g) r (Scope r)
forall (r :: * -> *). ScopeSym r => r (Scope r)
mainFn
[MS (r (Statement r))]
-> [MS (r (Statement r))] -> [MS (r (Statement r))]
forall a. [a] -> [a] -> [a]
++ VS (r (Variable r))
-> r (Scope r) -> SValue r -> MS (r (Statement r))
forall (r :: * -> *).
DeclStatement r =>
SVariable r -> r (Scope r) -> SValue r -> MSStatement r
varDecDef VS (r (Variable r))
v_filename r (Scope r)
forall (r :: * -> *). ScopeSym r => r (Scope r)
mainFn (Integer -> SValue r
forall (r :: * -> *). CommandLineArgs r => Integer -> SValue r
arg Integer
0)
MS (r (Statement r))
-> [MS (r (Statement r))] -> [MS (r (Statement r))]
forall a. a -> [a] -> [a]
: [MS (r (Statement r))]
logInFile
[MS (r (Statement r))]
-> [MS (r (Statement r))] -> [MS (r (Statement r))]
forall a. [a] -> [a] -> [a]
++ [Maybe (MS (r (Statement r)))] -> [MS (r (Statement r))]
forall a. [Maybe a] -> [a]
catMaybes [Maybe (MS (r (Statement r)))
co, Maybe (MS (r (Statement r)))
ip] [MS (r (Statement r))]
-> [MS (r (Statement r))] -> [MS (r (Statement r))]
forall a. [a] -> [a] -> [a]
++ [MS (r (Statement r))]
ics [MS (r (Statement r))]
-> [MS (r (Statement r))] -> [MS (r (Statement r))]
forall a. [a] -> [a] -> [a]
++ [Maybe (MS (r (Statement r)))] -> [MS (r (Statement r))]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (MS (r (Statement r)))]
varDef [Maybe (MS (r (Statement r)))]
-> [Maybe (MS (r (Statement r)))] -> [Maybe (MS (r (Statement r)))]
forall a. [a] -> [a] -> [a]
++ [Maybe (MS (r (Statement r)))
wo])
ImplementationType -> GenState (Maybe (SMethod r))
forall {r :: * -> *}.
SharedProg r =>
ImplementationType
-> StateT DrasilState Identity (Maybe (MS (r (Method r))))
mainFunc (ImplementationType -> GenState (Maybe (SMethod r)))
-> ImplementationType -> GenState (Maybe (SMethod r))
forall a b. (a -> b) -> a -> b
$ DrasilState -> ImplementationType
implType DrasilState
g
initConstsProc :: (SharedProg r) => GenState (Maybe (MSStatement r))
initConstsProc :: forall (r :: * -> *).
SharedProg r =>
GenState (Maybe (MSStatement r))
initConstsProc = do
DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
let scp :: r (Scope r)
scp = ScopeType -> r (Scope r)
forall (r :: * -> *). SharedProg r => ScopeType -> r (Scope r)
convScope (ScopeType -> r (Scope r)) -> ScopeType -> r (Scope r)
forall a b. (a -> b) -> a -> b
$ DrasilState -> ScopeType
currentScope DrasilState
g
cs :: [CodeDefinition]
cs = DrasilState -> CodeSpec
codeSpec DrasilState
g CodeSpec
-> Getting [CodeDefinition] CodeSpec [CodeDefinition]
-> [CodeDefinition]
forall s a. s -> Getting a s a -> a
^. Getting [CodeDefinition] CodeSpec [CodeDefinition]
forall c. HasOldCodeSpec c => Lens' c [CodeDefinition]
Lens' CodeSpec [CodeDefinition]
constantsO
getDecl :: ConstantStructure -> Structure -> GenState (Maybe (MSStatement r))
getDecl (Store Structure
Unbundled) Structure
_ = GenState (Maybe (MSStatement r))
declVars
getDecl (Store Structure
Bundled) Structure
_ = String -> GenState (Maybe (MSStatement r))
forall a. HasCallStack => String -> a
error String
"initConstsProc: Procedural renderers do not support bundled constants."
getDecl ConstantStructure
WithInputs Structure
Unbundled = GenState (Maybe (MSStatement r))
declVars
getDecl ConstantStructure
WithInputs Structure
Bundled = Maybe (MSStatement r) -> GenState (Maybe (MSStatement r))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MSStatement r)
forall a. Maybe a
Nothing
getDecl ConstantStructure
Inline Structure
_ = Maybe (MSStatement r) -> GenState (Maybe (MSStatement r))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MSStatement r)
forall a. Maybe a
Nothing
declVars :: GenState (Maybe (MSStatement r))
declVars = do
[VS (r (Variable r))]
vars <- (CodeDefinition
-> StateT DrasilState Identity (VS (r (Variable r))))
-> [CodeDefinition]
-> StateT DrasilState Identity [VS (r (Variable r))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (CodeVarChunk -> StateT DrasilState Identity (VS (r (Variable r)))
forall (r :: * -> *).
SharedProg r =>
CodeVarChunk -> GenState (SVariable r)
mkVarProc (CodeVarChunk -> StateT DrasilState Identity (VS (r (Variable r))))
-> (CodeDefinition -> CodeVarChunk)
-> CodeDefinition
-> StateT DrasilState Identity (VS (r (Variable r)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CodeDefinition -> CodeVarChunk
forall c. (Quantity c, MayHaveUnit c) => c -> CodeVarChunk
quantvar) [CodeDefinition]
cs
[VS (r (Value r))]
vals <- (CodeDefinition -> StateT DrasilState Identity (VS (r (Value r))))
-> [CodeDefinition]
-> StateT DrasilState Identity [VS (r (Value r))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (CodeExpr -> StateT DrasilState Identity (VS (r (Value r)))
forall (r :: * -> *).
SharedProg r =>
CodeExpr -> GenState (SValue r)
convExprProc (CodeExpr -> StateT DrasilState Identity (VS (r (Value r))))
-> (CodeDefinition -> CodeExpr)
-> CodeDefinition
-> StateT DrasilState Identity (VS (r (Value r)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CodeDefinition
-> Getting CodeExpr CodeDefinition CodeExpr -> CodeExpr
forall s a. s -> Getting a s a -> a
^. Getting CodeExpr CodeDefinition CodeExpr
forall c. DefiningCodeExpr c => Lens' c CodeExpr
Lens' CodeDefinition CodeExpr
codeExpr)) [CodeDefinition]
cs
[[MSStatement r]]
logs <- (VS (r (Variable r))
-> StateT DrasilState Identity [MSStatement r])
-> [VS (r (Variable r))]
-> StateT DrasilState Identity [[MSStatement r]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM VS (r (Variable r)) -> StateT DrasilState Identity [MSStatement r]
forall (r :: * -> *).
SharedProg r =>
SVariable r -> GenState [MSStatement r]
maybeLog [VS (r (Variable r))]
vars
Maybe (MSStatement r) -> GenState (Maybe (MSStatement r))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MSStatement r) -> GenState (Maybe (MSStatement r)))
-> Maybe (MSStatement r) -> GenState (Maybe (MSStatement r))
forall a b. (a -> b) -> a -> b
$ MSStatement r -> Maybe (MSStatement r)
forall a. a -> Maybe a
Just (MSStatement r -> Maybe (MSStatement r))
-> MSStatement r -> Maybe (MSStatement r)
forall a b. (a -> b) -> a -> b
$ [MSStatement r] -> MSStatement r
forall (r :: * -> *).
StatementSym r =>
[MSStatement r] -> MSStatement r
multi ([MSStatement r] -> MSStatement r)
-> [MSStatement r] -> MSStatement r
forall a b. (a -> b) -> a -> b
$
(VS (r (Variable r)) -> VS (r (Value r)) -> MSStatement r)
-> [VS (r (Variable r))] -> [VS (r (Value r))] -> [MSStatement r]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\VS (r (Variable r))
vr -> ConstantRepr
-> VS (r (Variable r))
-> r (Scope r)
-> VS (r (Value r))
-> MSStatement r
forall {r :: * -> *}.
DeclStatement r =>
ConstantRepr
-> VS (r (Variable r))
-> r (Scope r)
-> VS (r (Value r))
-> MS (r (Statement r))
defFunc (DrasilState -> ConstantRepr
conRepr DrasilState
g) VS (r (Variable r))
vr r (Scope r)
scp) [VS (r (Variable r))]
vars [VS (r (Value r))]
vals [MSStatement r] -> [MSStatement r] -> [MSStatement r]
forall a. [a] -> [a] -> [a]
++ [[MSStatement r]] -> [MSStatement r]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[MSStatement r]]
logs
defFunc :: ConstantRepr
-> SVariable r -> r (Scope r) -> SValue r -> MSStatement r
defFunc ConstantRepr
Var = SVariable r -> r (Scope r) -> SValue r -> MSStatement r
forall (r :: * -> *).
DeclStatement r =>
SVariable r -> r (Scope r) -> SValue r -> MSStatement r
varDecDef
defFunc ConstantRepr
Const = SVariable r -> r (Scope r) -> SValue r -> MSStatement r
forall (r :: * -> *).
DeclStatement r =>
SVariable r -> r (Scope r) -> SValue r -> MSStatement r
constDecDef
ConstantStructure -> Structure -> GenState (Maybe (MSStatement r))
getDecl (DrasilState -> ConstantStructure
conStruct DrasilState
g) (DrasilState -> Structure
inStruct DrasilState
g)
checkConstClass :: GenState Bool
checkConstClass :: GenState Bool
checkConstClass = do
DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
String
cName <- InternalConcept -> GenState String
genICName InternalConcept
Constants
let cs :: [CodeDefinition]
cs = DrasilState -> CodeSpec
codeSpec DrasilState
g CodeSpec
-> Getting [CodeDefinition] CodeSpec [CodeDefinition]
-> [CodeDefinition]
forall s a. s -> Getting a s a -> a
^. Getting [CodeDefinition] CodeSpec [CodeDefinition]
forall c. HasOldCodeSpec c => Lens' c [CodeDefinition]
Lens' CodeSpec [CodeDefinition]
constantsO
checkClass :: [CodeDefinition] -> GenState Bool
checkClass :: [CodeDefinition] -> GenState Bool
checkClass [] = Bool -> GenState Bool
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
checkClass [CodeDefinition]
_ = Bool -> GenState Bool
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
[CodeDefinition] -> GenState Bool
checkClass ([CodeDefinition] -> GenState Bool)
-> [CodeDefinition] -> GenState Bool
forall a b. (a -> b) -> a -> b
$ (CodeDefinition -> Bool) -> [CodeDefinition] -> [CodeDefinition]
forall a. (a -> Bool) -> [a] -> [a]
filter ((String -> Map String String -> Bool)
-> Map String String -> String -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> Map String String -> Bool
forall k a. Ord k => k -> Map k a -> Bool
member ((String -> Bool) -> Map String String -> Map String String
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (String
cName String -> String -> Bool
forall a. Eq a => a -> a -> Bool
==) (DrasilState -> Map String String
clsMap DrasilState
g))
(String -> Bool)
-> (CodeDefinition -> String) -> CodeDefinition -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CodeDefinition -> String
forall c. CodeIdea c => c -> String
codeName) [CodeDefinition]
cs
genInputModProc :: (ProcProg r) => GenState [Proc.SFile r]
genInputModProc :: forall (r :: * -> *). ProcProg r => GenState [SFile r]
genInputModProc = do
String
ipDesc <- GenState [String] -> GenState String
modDesc GenState [String]
inputParametersDesc
String
cname <- InternalConcept -> GenState String
genICName InternalConcept
InputParameters
let genMod :: (ProcProg r) => Bool ->
GenState (Proc.SFile r)
genMod :: forall (r :: * -> *). ProcProg r => Bool -> GenState (SFile r)
genMod Bool
False = String
-> String
-> [GenState (Maybe (SMethod r))]
-> StateT
DrasilState Identity (StateT FileState Identity (r (File r)))
forall (r :: * -> *).
ProcProg r =>
String
-> String -> [GenState (Maybe (SMethod r))] -> GenState (SFile r)
genModuleProc String
cname String
ipDesc [VisibilityTag -> GenState (Maybe (SMethod r))
forall (r :: * -> *).
SharedProg r =>
VisibilityTag -> GenState (Maybe (SMethod r))
genInputFormatProc VisibilityTag
Pub,
VisibilityTag -> GenState (Maybe (SMethod r))
forall (r :: * -> *).
SharedProg r =>
VisibilityTag -> GenState (Maybe (SMethod r))
genInputDerivedProc VisibilityTag
Pub, VisibilityTag -> GenState (Maybe (SMethod r))
forall (r :: * -> *).
SharedProg r =>
VisibilityTag -> GenState (Maybe (SMethod r))
genInputConstraintsProc VisibilityTag
Pub]
genMod Bool
True = String
-> StateT
DrasilState Identity (StateT FileState Identity (r (File r)))
forall a. HasCallStack => String -> a
error String
"genInputModProc: Procedural renderers do not support bundled inputs"
Bool
ic <- GenState Bool
checkInputClass
State DrasilState (SFile r) -> GenState [SFile r]
forall a b. State a b -> State a [b]
liftS (State DrasilState (SFile r) -> GenState [SFile r])
-> State DrasilState (SFile r) -> GenState [SFile r]
forall a b. (a -> b) -> a -> b
$ Bool -> State DrasilState (SFile r)
forall (r :: * -> *). ProcProg r => Bool -> GenState (SFile r)
genMod Bool
ic
checkInputClass :: GenState Bool
checkInputClass :: GenState Bool
checkInputClass = do
DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
String
cname <- InternalConcept -> GenState String
genICName InternalConcept
InputParameters
let ins :: [CodeVarChunk]
ins = DrasilState -> CodeSpec
codeSpec DrasilState
g CodeSpec
-> Getting [CodeVarChunk] CodeSpec [CodeVarChunk] -> [CodeVarChunk]
forall s a. s -> Getting a s a -> a
^. Getting [CodeVarChunk] CodeSpec [CodeVarChunk]
forall c. HasOldCodeSpec c => Lens' c [CodeVarChunk]
Lens' CodeSpec [CodeVarChunk]
inputsO
cs :: [CodeDefinition]
cs = DrasilState -> CodeSpec
codeSpec DrasilState
g CodeSpec
-> Getting [CodeDefinition] CodeSpec [CodeDefinition]
-> [CodeDefinition]
forall s a. s -> Getting a s a -> a
^. Getting [CodeDefinition] CodeSpec [CodeDefinition]
forall c. HasOldCodeSpec c => Lens' c [CodeDefinition]
Lens' CodeSpec [CodeDefinition]
constantsO
filt :: (CodeIdea c) => [c] -> [c]
filt :: forall c. CodeIdea c => [c] -> [c]
filt = (c -> Bool) -> [c] -> [c]
forall a. (a -> Bool) -> [a] -> [a]
filter ((String -> Maybe String
forall a. a -> Maybe a
Just String
cname Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
==) (Maybe String -> Bool) -> (c -> Maybe String) -> c -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Map String String -> Maybe String)
-> Map String String -> String -> Maybe String
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> Map String String -> Maybe String
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (DrasilState -> Map String String
clsMap DrasilState
g) (String -> Maybe String) -> (c -> String) -> c -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> String
forall c. CodeIdea c => c -> String
codeName)
checkClass :: [CodeVarChunk] -> [CodeDefinition] -> GenState Bool
checkClass :: [CodeVarChunk] -> [CodeDefinition] -> GenState Bool
checkClass [] [] = Bool -> GenState Bool
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
checkClass [CodeVarChunk]
_ [CodeDefinition]
_ = Bool -> GenState Bool
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
[CodeVarChunk] -> [CodeDefinition] -> GenState Bool
checkClass ([CodeVarChunk] -> [CodeVarChunk]
forall c. CodeIdea c => [c] -> [c]
filt [CodeVarChunk]
ins) ([CodeDefinition] -> [CodeDefinition]
forall c. CodeIdea c => [c] -> [c]
filt [CodeDefinition]
cs)
getInputDeclProc :: (SharedProg r) => GenState (Maybe (MSStatement r))
getInputDeclProc :: forall (r :: * -> *).
SharedProg r =>
GenState (Maybe (MSStatement r))
getInputDeclProc = do
DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
let scp :: r (Scope r)
scp = ScopeType -> r (Scope r)
forall (r :: * -> *). SharedProg r => ScopeType -> r (Scope r)
convScope (ScopeType -> r (Scope r)) -> ScopeType -> r (Scope r)
forall a b. (a -> b) -> a -> b
$ DrasilState -> ScopeType
currentScope DrasilState
g
getDecl :: ([a], [CodeVarChunk]) -> GenState (Maybe (MSStatement r))
getDecl ([],[]) = Maybe (MSStatement r) -> GenState (Maybe (MSStatement r))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MSStatement r)
forall a. Maybe a
Nothing
getDecl ([],[CodeVarChunk]
ins) = do
[VS (r (Variable r))]
vars <- (CodeVarChunk -> StateT DrasilState Identity (VS (r (Variable r))))
-> [CodeVarChunk]
-> StateT DrasilState Identity [VS (r (Variable r))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM CodeVarChunk -> StateT DrasilState Identity (VS (r (Variable r)))
forall (r :: * -> *).
SharedProg r =>
CodeVarChunk -> GenState (SVariable r)
mkVarProc [CodeVarChunk]
ins
Maybe (MSStatement r) -> GenState (Maybe (MSStatement r))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MSStatement r) -> GenState (Maybe (MSStatement r)))
-> Maybe (MSStatement r) -> GenState (Maybe (MSStatement r))
forall a b. (a -> b) -> a -> b
$ MSStatement r -> Maybe (MSStatement r)
forall a. a -> Maybe a
Just (MSStatement r -> Maybe (MSStatement r))
-> MSStatement r -> Maybe (MSStatement r)
forall a b. (a -> b) -> a -> b
$ [MSStatement r] -> MSStatement r
forall (r :: * -> *).
StatementSym r =>
[MSStatement r] -> MSStatement r
multi ([MSStatement r] -> MSStatement r)
-> [MSStatement r] -> MSStatement r
forall a b. (a -> b) -> a -> b
$ (VS (r (Variable r)) -> MSStatement r)
-> [VS (r (Variable r))] -> [MSStatement r]
forall a b. (a -> b) -> [a] -> [b]
map (VS (r (Variable r)) -> r (Scope r) -> MSStatement r
forall (r :: * -> *).
DeclStatement r =>
SVariable r -> r (Scope r) -> MSStatement r
`varDec` r (Scope r)
scp) [VS (r (Variable r))]
vars
getDecl ([a], [CodeVarChunk])
_ = String -> GenState (Maybe (MSStatement r))
forall a. HasCallStack => String -> a
error String
"getInputDeclProc: Procedural renderers do not support bundled inputs"
([CodeVarChunk], [CodeVarChunk])
-> GenState (Maybe (MSStatement r))
forall {a}.
([a], [CodeVarChunk]) -> GenState (Maybe (MSStatement r))
getDecl ((CodeVarChunk -> Bool)
-> [CodeVarChunk] -> ([CodeVarChunk], [CodeVarChunk])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ((String -> Map String String -> Bool)
-> Map String String -> String -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> Map String String -> Bool
forall k a. Ord k => k -> Map k a -> Bool
member (DrasilState -> Map String String
eMap DrasilState
g) (String -> Bool)
-> (CodeVarChunk -> String) -> CodeVarChunk -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CodeVarChunk -> String
forall c. CodeIdea c => c -> String
codeName)
(DrasilState -> CodeSpec
codeSpec DrasilState
g CodeSpec
-> Getting [CodeVarChunk] CodeSpec [CodeVarChunk] -> [CodeVarChunk]
forall s a. s -> Getting a s a -> a
^. Getting [CodeVarChunk] CodeSpec [CodeVarChunk]
forall c. HasOldCodeSpec c => Lens' c [CodeVarChunk]
Lens' CodeSpec [CodeVarChunk]
inputsO))
genCalcModProc :: (ProcProg r) => GenState (Proc.SFile r)
genCalcModProc :: forall (r :: * -> *). ProcProg r => GenState (SFile r)
genCalcModProc = do
DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
String
cName <- InternalConcept -> GenState String
genICName InternalConcept
Calculations
let elmap :: ExtLibMap
elmap = DrasilState -> ExtLibMap
extLibMap DrasilState
g
String
-> String
-> [String]
-> [GenState (Maybe (SMethod r))]
-> GenState (SFile r)
forall (r :: * -> *).
ProcProg r =>
String
-> String
-> [String]
-> [GenState (Maybe (SMethod r))]
-> GenState (SFile r)
genModuleWithImportsProc String
cName String
calcModDesc ((ExtLibState -> [String]) -> [ExtLibState] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (ExtLibState -> Getting [String] ExtLibState [String] -> [String]
forall s a. s -> Getting a s a -> a
^. Getting [String] ExtLibState [String]
Lens' ExtLibState [String]
imports) ([ExtLibState] -> [String]) -> [ExtLibState] -> [String]
forall a b. (a -> b) -> a -> b
$
ExtLibMap -> [ExtLibState]
forall k a. Map k a -> [a]
elems ExtLibMap
elmap) ((CodeDefinition -> GenState (Maybe (SMethod r)))
-> [CodeDefinition] -> [GenState (Maybe (SMethod r))]
forall a b. (a -> b) -> [a] -> [b]
map ((SMethod r -> Maybe (SMethod r))
-> StateT DrasilState Identity (SMethod r)
-> GenState (Maybe (SMethod r))
forall a b.
(a -> b)
-> StateT DrasilState Identity a -> StateT DrasilState Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SMethod r -> Maybe (SMethod r)
forall a. a -> Maybe a
Just (StateT DrasilState Identity (SMethod r)
-> GenState (Maybe (SMethod r)))
-> (CodeDefinition -> StateT DrasilState Identity (SMethod r))
-> CodeDefinition
-> GenState (Maybe (SMethod r))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CodeDefinition -> StateT DrasilState Identity (SMethod r)
forall (r :: * -> *).
SharedProg r =>
CodeDefinition -> GenState (SMethod r)
genCalcFuncProc) (DrasilState -> CodeSpec
codeSpec DrasilState
g CodeSpec
-> Getting [CodeDefinition] CodeSpec [CodeDefinition]
-> [CodeDefinition]
forall s a. s -> Getting a s a -> a
^. Getting [CodeDefinition] CodeSpec [CodeDefinition]
forall c. HasOldCodeSpec c => Lens' c [CodeDefinition]
Lens' CodeSpec [CodeDefinition]
execOrderO))
genCalcFuncProc :: (SharedProg r) => CodeDefinition ->
GenState (SMethod r)
genCalcFuncProc :: forall (r :: * -> *).
SharedProg r =>
CodeDefinition -> GenState (SMethod r)
genCalcFuncProc CodeDefinition
cdef = do
DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
(DrasilState -> DrasilState) -> StateT DrasilState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\DrasilState
st -> DrasilState
st {currentScope = Local})
[CodeVarChunk]
parms <- CodeDefinition -> GenState [CodeVarChunk]
getCalcParams CodeDefinition
cdef
let nm :: String
nm = CodeDefinition -> String
forall c. CodeIdea c => c -> String
codeName CodeDefinition
cdef
CodeType
tp <- CodeDefinition -> StateT DrasilState Identity CodeType
forall c. HasSpace c => c -> StateT DrasilState Identity CodeType
codeType CodeDefinition
cdef
VS (r (Variable r))
v <- CodeVarChunk -> StateT DrasilState Identity (VS (r (Variable r)))
forall (r :: * -> *).
SharedProg r =>
CodeVarChunk -> GenState (SVariable r)
mkVarProc (CodeDefinition -> CodeVarChunk
forall c. (Quantity c, MayHaveUnit c) => c -> CodeVarChunk
quantvar CodeDefinition
cdef)
[MS (r (Block r))]
blcks <- case CodeDefinition
cdef CodeDefinition
-> Getting DefinitionType CodeDefinition DefinitionType
-> DefinitionType
forall s a. s -> Getting a s a -> a
^. Getting DefinitionType CodeDefinition DefinitionType
Lens' CodeDefinition DefinitionType
defType
of DefinitionType
Definition -> State DrasilState (MS (r (Block r)))
-> StateT DrasilState Identity [MS (r (Block r))]
forall a b. State a b -> State a [b]
liftS (State DrasilState (MS (r (Block r)))
-> StateT DrasilState Identity [MS (r (Block r))])
-> State DrasilState (MS (r (Block r)))
-> StateT DrasilState Identity [MS (r (Block r))]
forall a b. (a -> b) -> a -> b
$ CalcType
-> CodeDefinition
-> CodeExpr
-> State DrasilState (MS (r (Block r)))
forall (r :: * -> *).
SharedProg r =>
CalcType -> CodeDefinition -> CodeExpr -> GenState (MSBlock r)
genCalcBlockProc CalcType
CalcReturn CodeDefinition
cdef
(CodeDefinition
cdef CodeDefinition
-> Getting CodeExpr CodeDefinition CodeExpr -> CodeExpr
forall s a. s -> Getting a s a -> a
^. Getting CodeExpr CodeDefinition CodeExpr
forall c. DefiningCodeExpr c => Lens' c CodeExpr
Lens' CodeDefinition CodeExpr
codeExpr)
DefinitionType
ODE -> StateT DrasilState Identity [MS (r (Block r))]
-> (ExtLibState -> StateT DrasilState Identity [MS (r (Block r))])
-> Maybe ExtLibState
-> StateT DrasilState Identity [MS (r (Block r))]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> StateT DrasilState Identity [MS (r (Block r))]
forall a. HasCallStack => String -> a
error (String -> StateT DrasilState Identity [MS (r (Block r))])
-> String -> StateT DrasilState Identity [MS (r (Block r))]
forall a b. (a -> b) -> a -> b
$ String
nm String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" missing from ExtLibMap")
(\ExtLibState
el -> do
[MS (r (Statement r))]
defStmts <- (FuncStmt -> StateT DrasilState Identity (MS (r (Statement r))))
-> [FuncStmt] -> StateT DrasilState Identity [MS (r (Statement r))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM FuncStmt -> StateT DrasilState Identity (MS (r (Statement r)))
forall (r :: * -> *).
SharedProg r =>
FuncStmt -> GenState (MSStatement r)
convStmtProc (ExtLibState
el ExtLibState
-> Getting [FuncStmt] ExtLibState [FuncStmt] -> [FuncStmt]
forall s a. s -> Getting a s a -> a
^. Getting [FuncStmt] ExtLibState [FuncStmt]
Lens' ExtLibState [FuncStmt]
defs)
[MS (r (Statement r))]
stepStmts <- (FuncStmt -> StateT DrasilState Identity (MS (r (Statement r))))
-> [FuncStmt] -> StateT DrasilState Identity [MS (r (Statement r))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM FuncStmt -> StateT DrasilState Identity (MS (r (Statement r)))
forall (r :: * -> *).
SharedProg r =>
FuncStmt -> GenState (MSStatement r)
convStmtProc (ExtLibState
el ExtLibState
-> Getting [FuncStmt] ExtLibState [FuncStmt] -> [FuncStmt]
forall s a. s -> Getting a s a -> a
^. Getting [FuncStmt] ExtLibState [FuncStmt]
Lens' ExtLibState [FuncStmt]
steps)
[MS (r (Block r))]
-> StateT DrasilState Identity [MS (r (Block r))]
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return [[MS (r (Statement r))] -> MS (r (Block r))
forall (r :: * -> *). BlockSym r => [MSStatement r] -> MSBlock r
block (VS (r (Variable r)) -> r (Scope r) -> MS (r (Statement r))
forall (r :: * -> *).
DeclStatement r =>
SVariable r -> r (Scope r) -> MSStatement r
varDec VS (r (Variable r))
v r (Scope r)
forall (r :: * -> *). ScopeSym r => r (Scope r)
local MS (r (Statement r))
-> [MS (r (Statement r))] -> [MS (r (Statement r))]
forall a. a -> [a] -> [a]
: [MS (r (Statement r))]
defStmts),
[MS (r (Statement r))] -> MS (r (Block r))
forall (r :: * -> *). BlockSym r => [MSStatement r] -> MSBlock r
block [MS (r (Statement r))]
stepStmts,
[MS (r (Statement r))] -> MS (r (Block r))
forall (r :: * -> *). BlockSym r => [MSStatement r] -> MSBlock r
block [SValue r -> MS (r (Statement r))
forall (r :: * -> *).
ControlStatement r =>
SValue r -> MSStatement r
returnStmt (SValue r -> MS (r (Statement r)))
-> SValue r -> MS (r (Statement r))
forall a b. (a -> b) -> a -> b
$ VS (r (Variable r)) -> SValue r
forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
valueOf VS (r (Variable r))
v]])
(String -> ExtLibMap -> Maybe ExtLibState
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
nm (DrasilState -> ExtLibMap
extLibMap DrasilState
g))
String
desc <- CodeDefinition -> GenState String
forall c. CodeIdea c => c -> GenState String
getComment CodeDefinition
cdef
String
-> VSType r
-> String
-> [ParameterChunk]
-> Maybe String
-> [MS (r (Block r))]
-> GenState (SMethod r)
forall (r :: * -> *).
SharedProg r =>
String
-> VSType r
-> String
-> [ParameterChunk]
-> Maybe String
-> [MSBlock r]
-> GenState (SMethod r)
publicFuncProc
String
nm
(CodeType -> VSType r
forall (r :: * -> *). TypeSym r => CodeType -> VSType r
convType CodeType
tp)
(String
"Calculates " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
desc)
((CodeVarChunk -> ParameterChunk)
-> [CodeVarChunk] -> [ParameterChunk]
forall a b. (a -> b) -> [a] -> [b]
map CodeVarChunk -> ParameterChunk
forall c. CodeIdea c => c -> ParameterChunk
pcAuto [CodeVarChunk]
parms)
(String -> Maybe String
forall a. a -> Maybe a
Just String
desc)
[MS (r (Block r))]
blcks
genCalcBlockProc :: (SharedProg r) => CalcType -> CodeDefinition -> CodeExpr ->
GenState (MSBlock r)
genCalcBlockProc :: forall (r :: * -> *).
SharedProg r =>
CalcType -> CodeDefinition -> CodeExpr -> GenState (MSBlock r)
genCalcBlockProc CalcType
t CodeDefinition
v (Case Completeness
c [(CodeExpr, CodeExpr)]
e) = CalcType
-> CodeDefinition
-> Completeness
-> [(CodeExpr, CodeExpr)]
-> StateT
DrasilState Identity (StateT MethodState Identity (r (Block r)))
forall (r :: * -> *).
SharedProg r =>
CalcType
-> CodeDefinition
-> Completeness
-> [(CodeExpr, CodeExpr)]
-> GenState (MSBlock r)
genCaseBlockProc CalcType
t CodeDefinition
v Completeness
c [(CodeExpr, CodeExpr)]
e
genCalcBlockProc CalcType
CalcAssign CodeDefinition
v CodeExpr
e = do
VS (r (Variable r))
vv <- CodeVarChunk -> StateT DrasilState Identity (VS (r (Variable r)))
forall (r :: * -> *).
SharedProg r =>
CodeVarChunk -> GenState (SVariable r)
mkVarProc (CodeDefinition -> CodeVarChunk
forall c. (Quantity c, MayHaveUnit c) => c -> CodeVarChunk
quantvar CodeDefinition
v)
VS (r (Value r))
ee <- CodeExpr -> StateT DrasilState Identity (VS (r (Value r)))
forall (r :: * -> *).
SharedProg r =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
e
[MS (r (Statement r))]
l <- VS (r (Variable r))
-> StateT DrasilState Identity [MS (r (Statement r))]
forall (r :: * -> *).
SharedProg r =>
SVariable r -> GenState [MSStatement r]
maybeLog VS (r (Variable r))
vv
StateT MethodState Identity (r (Block r))
-> StateT
DrasilState Identity (StateT MethodState Identity (r (Block r)))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (StateT MethodState Identity (r (Block r))
-> StateT
DrasilState Identity (StateT MethodState Identity (r (Block r))))
-> StateT MethodState Identity (r (Block r))
-> StateT
DrasilState Identity (StateT MethodState Identity (r (Block r)))
forall a b. (a -> b) -> a -> b
$ [MS (r (Statement r))] -> StateT MethodState Identity (r (Block r))
forall (r :: * -> *). BlockSym r => [MSStatement r] -> MSBlock r
block ([MS (r (Statement r))]
-> StateT MethodState Identity (r (Block r)))
-> [MS (r (Statement r))]
-> StateT MethodState Identity (r (Block r))
forall a b. (a -> b) -> a -> b
$ VS (r (Variable r)) -> VS (r (Value r)) -> MS (r (Statement r))
forall (r :: * -> *).
AssignStatement r =>
SVariable r -> SValue r -> MSStatement r
assign VS (r (Variable r))
vv VS (r (Value r))
ee MS (r (Statement r))
-> [MS (r (Statement r))] -> [MS (r (Statement r))]
forall a. a -> [a] -> [a]
: [MS (r (Statement r))]
l
genCalcBlockProc CalcType
CalcReturn CodeDefinition
_ CodeExpr
e = [MS (r (Statement r))] -> StateT MethodState Identity (r (Block r))
forall (r :: * -> *). BlockSym r => [MSStatement r] -> MSBlock r
block ([MS (r (Statement r))]
-> StateT MethodState Identity (r (Block r)))
-> StateT DrasilState Identity [MS (r (Statement r))]
-> StateT
DrasilState Identity (StateT MethodState Identity (r (Block r)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> State DrasilState (MS (r (Statement r)))
-> StateT DrasilState Identity [MS (r (Statement r))]
forall a b. State a b -> State a [b]
liftS (VS (r (Value r)) -> MS (r (Statement r))
forall (r :: * -> *).
ControlStatement r =>
SValue r -> MSStatement r
returnStmt (VS (r (Value r)) -> MS (r (Statement r)))
-> StateT DrasilState Identity (VS (r (Value r)))
-> State DrasilState (MS (r (Statement r)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CodeExpr -> StateT DrasilState Identity (VS (r (Value r)))
forall (r :: * -> *).
SharedProg r =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
e)
genCaseBlockProc :: (SharedProg r) => CalcType -> CodeDefinition -> Completeness
-> [(CodeExpr, CodeExpr)] -> GenState (MSBlock r)
genCaseBlockProc :: forall (r :: * -> *).
SharedProg r =>
CalcType
-> CodeDefinition
-> Completeness
-> [(CodeExpr, CodeExpr)]
-> GenState (MSBlock r)
genCaseBlockProc CalcType
_ CodeDefinition
_ Completeness
_ [] = String -> GenState (MSBlock r)
forall a. HasCallStack => String -> a
error (String -> GenState (MSBlock r)) -> String -> GenState (MSBlock r)
forall a b. (a -> b) -> a -> b
$ String
"Case expression with no cases encountered" String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
" in code generator"
genCaseBlockProc CalcType
t CodeDefinition
v Completeness
c [(CodeExpr, CodeExpr)]
cs = do
[(VS (r (Value r)), MS (r (Body r)))]
ifs <- ((CodeExpr, CodeExpr)
-> StateT DrasilState Identity (VS (r (Value r)), MS (r (Body r))))
-> [(CodeExpr, CodeExpr)]
-> StateT
DrasilState Identity [(VS (r (Value r)), MS (r (Body r)))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\(CodeExpr
e,CodeExpr
r) -> (VS (r (Value r))
-> MS (r (Body r)) -> (VS (r (Value r)), MS (r (Body r))))
-> StateT DrasilState Identity (VS (r (Value r)))
-> StateT DrasilState Identity (MS (r (Body r)))
-> StateT DrasilState Identity (VS (r (Value r)), MS (r (Body r)))
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) (CodeExpr -> StateT DrasilState Identity (VS (r (Value r)))
forall (r :: * -> *).
SharedProg r =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
r) (CodeExpr -> StateT DrasilState Identity (MS (r (Body r)))
forall {r :: * -> *}.
SharedProg r =>
CodeExpr -> StateT DrasilState Identity (MS (r (Body r)))
calcBody CodeExpr
e)) (Completeness -> [(CodeExpr, CodeExpr)]
ifEs Completeness
c)
MS (r (Body r))
els <- Completeness -> StateT DrasilState Identity (MS (r (Body r)))
forall {r :: * -> *}.
SharedProg r =>
Completeness -> StateT DrasilState Identity (MS (r (Body r)))
elseE Completeness
c
MSBlock r -> GenState (MSBlock r)
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (MSBlock r -> GenState (MSBlock r))
-> MSBlock r -> GenState (MSBlock r)
forall a b. (a -> b) -> a -> b
$ [MSStatement r] -> MSBlock r
forall (r :: * -> *). BlockSym r => [MSStatement r] -> MSBlock r
block [[(VS (r (Value r)), MS (r (Body r)))]
-> MS (r (Body r)) -> MSStatement r
forall (r :: * -> *).
ControlStatement r =>
[(SValue r, MSBody r)] -> MSBody r -> MSStatement r
ifCond [(VS (r (Value r)), MS (r (Body r)))]
ifs MS (r (Body r))
els]
where calcBody :: CodeExpr -> StateT DrasilState Identity (MS (r (Body r)))
calcBody CodeExpr
e = ([MS (r (Block r))] -> MS (r (Body r)))
-> StateT DrasilState Identity [MS (r (Block r))]
-> StateT DrasilState Identity (MS (r (Body r)))
forall a b.
(a -> b)
-> StateT DrasilState Identity a -> StateT DrasilState Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [MS (r (Block r))] -> MS (r (Body r))
forall (r :: * -> *). BodySym r => [MSBlock r] -> MSBody r
body (StateT DrasilState Identity [MS (r (Block r))]
-> StateT DrasilState Identity (MS (r (Body r))))
-> StateT DrasilState Identity [MS (r (Block r))]
-> StateT DrasilState Identity (MS (r (Body r)))
forall a b. (a -> b) -> a -> b
$ State DrasilState (MS (r (Block r)))
-> StateT DrasilState Identity [MS (r (Block r))]
forall a b. State a b -> State a [b]
liftS (State DrasilState (MS (r (Block r)))
-> StateT DrasilState Identity [MS (r (Block r))])
-> State DrasilState (MS (r (Block r)))
-> StateT DrasilState Identity [MS (r (Block r))]
forall a b. (a -> b) -> a -> b
$ CalcType
-> CodeDefinition
-> CodeExpr
-> State DrasilState (MS (r (Block r)))
forall (r :: * -> *).
SharedProg r =>
CalcType -> CodeDefinition -> CodeExpr -> GenState (MSBlock r)
genCalcBlockProc CalcType
t CodeDefinition
v CodeExpr
e
ifEs :: Completeness -> [(CodeExpr, CodeExpr)]
ifEs Completeness
Complete = [(CodeExpr, CodeExpr)] -> [(CodeExpr, CodeExpr)]
forall a. HasCallStack => [a] -> [a]
init [(CodeExpr, CodeExpr)]
cs
ifEs Completeness
Incomplete = [(CodeExpr, CodeExpr)]
cs
elseE :: Completeness -> StateT DrasilState Identity (MS (r (Body r)))
elseE Completeness
Complete = CodeExpr -> StateT DrasilState Identity (MS (r (Body r)))
forall {r :: * -> *}.
SharedProg r =>
CodeExpr -> StateT DrasilState Identity (MS (r (Body r)))
calcBody (CodeExpr -> StateT DrasilState Identity (MS (r (Body r))))
-> CodeExpr -> StateT DrasilState Identity (MS (r (Body r)))
forall a b. (a -> b) -> a -> b
$ (CodeExpr, CodeExpr) -> CodeExpr
forall a b. (a, b) -> a
fst ((CodeExpr, CodeExpr) -> CodeExpr)
-> (CodeExpr, CodeExpr) -> CodeExpr
forall a b. (a -> b) -> a -> b
$ [(CodeExpr, CodeExpr)] -> (CodeExpr, CodeExpr)
forall a. HasCallStack => [a] -> a
last [(CodeExpr, CodeExpr)]
cs
elseE Completeness
Incomplete = MS (r (Body r)) -> StateT DrasilState Identity (MS (r (Body r)))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (MS (r (Body r)) -> StateT DrasilState Identity (MS (r (Body r))))
-> MS (r (Body r)) -> StateT DrasilState Identity (MS (r (Body r)))
forall a b. (a -> b) -> a -> b
$ MSStatement r -> MS (r (Body r))
forall (r :: * -> *). BodySym r => MSStatement r -> MSBody r
oneLiner (MSStatement r -> MS (r (Body r)))
-> MSStatement r -> MS (r (Body r))
forall a b. (a -> b) -> a -> b
$ String -> MSStatement r
forall (r :: * -> *). ControlStatement r => String -> MSStatement r
throw (String -> MSStatement r) -> String -> MSStatement r
forall a b. (a -> b) -> a -> b
$
String
"Undefined case encountered in function " String -> String -> String
forall a. [a] -> [a] -> [a]
++ CodeDefinition -> String
forall c. CodeIdea c => c -> String
codeName CodeDefinition
v
genInputFormatProc :: (SharedProg r) => VisibilityTag ->
GenState (Maybe (SMethod r))
genInputFormatProc :: forall (r :: * -> *).
SharedProg r =>
VisibilityTag -> GenState (Maybe (SMethod r))
genInputFormatProc VisibilityTag
s = do
DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
(DrasilState -> DrasilState) -> StateT DrasilState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\DrasilState
st -> DrasilState
st {currentScope = Local})
DataDesc
dd <- GenState DataDesc
genDataDesc
String
giName <- InternalConcept -> GenState String
genICName InternalConcept
GetInput
let getFunc :: VisibilityTag
-> String
-> String
-> [CodeVarChunk]
-> [CodeVarChunk]
-> [MSBlock r]
-> GenState (SMethod r)
getFunc VisibilityTag
Pub = String
-> String
-> [CodeVarChunk]
-> [CodeVarChunk]
-> [MSBlock r]
-> GenState (SMethod r)
forall (r :: * -> *).
SharedProg r =>
String
-> String
-> [CodeVarChunk]
-> [CodeVarChunk]
-> [MSBlock r]
-> GenState (SMethod r)
publicInOutFuncProc
getFunc VisibilityTag
Priv = String
-> String
-> [CodeVarChunk]
-> [CodeVarChunk]
-> [MSBlock r]
-> GenState (SMethod r)
forall (r :: * -> *).
SharedProg r =>
String
-> String
-> [CodeVarChunk]
-> [CodeVarChunk]
-> [MSBlock r]
-> GenState (SMethod r)
privateInOutFuncProc
genInFormat :: (SharedProg r) => Bool -> GenState
(Maybe (SMethod r))
genInFormat :: forall (r :: * -> *).
SharedProg r =>
Bool -> GenState (Maybe (SMethod r))
genInFormat Bool
False = Maybe (MS (r (Method r)))
-> StateT DrasilState Identity (Maybe (MS (r (Method r))))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MS (r (Method r)))
forall a. Maybe a
Nothing
genInFormat Bool
_ = do
[CodeVarChunk]
ins <- GenState [CodeVarChunk]
getInputFormatIns
[CodeVarChunk]
outs <- GenState [CodeVarChunk]
getInputFormatOuts
[MS (r (Block r))]
bod <- DataDesc -> StateT DrasilState Identity [MS (r (Block r))]
forall (r :: * -> *).
SharedProg r =>
DataDesc -> GenState [MSBlock r]
readDataProc DataDesc
dd
String
desc <- GenState String
inFmtFuncDesc
MS (r (Method r))
mthd <- VisibilityTag
-> String
-> String
-> [CodeVarChunk]
-> [CodeVarChunk]
-> [MS (r (Block r))]
-> StateT DrasilState Identity (MS (r (Method r)))
forall {r :: * -> *}.
SharedProg r =>
VisibilityTag
-> String
-> String
-> [CodeVarChunk]
-> [CodeVarChunk]
-> [MSBlock r]
-> GenState (SMethod r)
getFunc VisibilityTag
s String
giName String
desc [CodeVarChunk]
ins [CodeVarChunk]
outs [MS (r (Block r))]
bod
Maybe (MS (r (Method r)))
-> StateT DrasilState Identity (Maybe (MS (r (Method r))))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MS (r (Method r)))
-> StateT DrasilState Identity (Maybe (MS (r (Method r)))))
-> Maybe (MS (r (Method r)))
-> StateT DrasilState Identity (Maybe (MS (r (Method r))))
forall a b. (a -> b) -> a -> b
$ MS (r (Method r)) -> Maybe (MS (r (Method r)))
forall a. a -> Maybe a
Just MS (r (Method r))
mthd
Bool -> GenState (Maybe (SMethod r))
forall (r :: * -> *).
SharedProg r =>
Bool -> GenState (Maybe (SMethod r))
genInFormat (Bool -> GenState (Maybe (SMethod r)))
-> Bool -> GenState (Maybe (SMethod r))
forall a b. (a -> b) -> a -> b
$ String
giName String -> Set String -> Bool
forall a. Eq a => a -> Set a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` DrasilState -> Set String
defSet DrasilState
g
genInputDerivedProc :: (SharedProg r) => VisibilityTag ->
GenState (Maybe (SMethod r))
genInputDerivedProc :: forall (r :: * -> *).
SharedProg r =>
VisibilityTag -> GenState (Maybe (SMethod r))
genInputDerivedProc VisibilityTag
s = do
DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
(DrasilState -> DrasilState) -> StateT DrasilState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\DrasilState
st -> DrasilState
st {currentScope = Local})
String
dvName <- InternalConcept -> GenState String
genICName InternalConcept
DerivedValuesFn
let dvals :: [CodeDefinition]
dvals = DrasilState -> CodeSpec
codeSpec DrasilState
g CodeSpec
-> Getting [CodeDefinition] CodeSpec [CodeDefinition]
-> [CodeDefinition]
forall s a. s -> Getting a s a -> a
^. Getting [CodeDefinition] CodeSpec [CodeDefinition]
forall c. HasOldCodeSpec c => Lens' c [CodeDefinition]
Lens' CodeSpec [CodeDefinition]
derivedInputsO
getFunc :: VisibilityTag
-> String
-> String
-> [CodeVarChunk]
-> [CodeVarChunk]
-> [MSBlock r]
-> GenState (SMethod r)
getFunc VisibilityTag
Pub = String
-> String
-> [CodeVarChunk]
-> [CodeVarChunk]
-> [MSBlock r]
-> GenState (SMethod r)
forall (r :: * -> *).
SharedProg r =>
String
-> String
-> [CodeVarChunk]
-> [CodeVarChunk]
-> [MSBlock r]
-> GenState (SMethod r)
publicInOutFuncProc
getFunc VisibilityTag
Priv = String
-> String
-> [CodeVarChunk]
-> [CodeVarChunk]
-> [MSBlock r]
-> GenState (SMethod r)
forall (r :: * -> *).
SharedProg r =>
String
-> String
-> [CodeVarChunk]
-> [CodeVarChunk]
-> [MSBlock r]
-> GenState (SMethod r)
privateInOutFuncProc
genDerived :: (SharedProg r) => Bool -> GenState
(Maybe (SMethod r))
genDerived :: forall (r :: * -> *).
SharedProg r =>
Bool -> GenState (Maybe (SMethod r))
genDerived Bool
False = Maybe (MS (r (Method r)))
-> StateT DrasilState Identity (Maybe (MS (r (Method r))))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MS (r (Method r)))
forall a. Maybe a
Nothing
genDerived Bool
_ = do
[CodeVarChunk]
ins <- GenState [CodeVarChunk]
getDerivedIns
[CodeVarChunk]
outs <- GenState [CodeVarChunk]
getDerivedOuts
[MS (r (Block r))]
bod <- (CodeDefinition -> StateT DrasilState Identity (MS (r (Block r))))
-> [CodeDefinition]
-> StateT DrasilState Identity [MS (r (Block r))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\CodeDefinition
x -> CalcType
-> CodeDefinition
-> CodeExpr
-> StateT DrasilState Identity (MS (r (Block r)))
forall (r :: * -> *).
SharedProg r =>
CalcType -> CodeDefinition -> CodeExpr -> GenState (MSBlock r)
genCalcBlockProc CalcType
CalcAssign CodeDefinition
x (CodeDefinition
x CodeDefinition
-> Getting CodeExpr CodeDefinition CodeExpr -> CodeExpr
forall s a. s -> Getting a s a -> a
^. Getting CodeExpr CodeDefinition CodeExpr
forall c. DefiningCodeExpr c => Lens' c CodeExpr
Lens' CodeDefinition CodeExpr
codeExpr)) [CodeDefinition]
dvals
String
desc <- GenState String
dvFuncDesc
MS (r (Method r))
mthd <- VisibilityTag
-> String
-> String
-> [CodeVarChunk]
-> [CodeVarChunk]
-> [MS (r (Block r))]
-> StateT DrasilState Identity (MS (r (Method r)))
forall {r :: * -> *}.
SharedProg r =>
VisibilityTag
-> String
-> String
-> [CodeVarChunk]
-> [CodeVarChunk]
-> [MSBlock r]
-> GenState (SMethod r)
getFunc VisibilityTag
s String
dvName String
desc [CodeVarChunk]
ins [CodeVarChunk]
outs [MS (r (Block r))]
bod
Maybe (MS (r (Method r)))
-> StateT DrasilState Identity (Maybe (MS (r (Method r))))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MS (r (Method r)))
-> StateT DrasilState Identity (Maybe (MS (r (Method r)))))
-> Maybe (MS (r (Method r)))
-> StateT DrasilState Identity (Maybe (MS (r (Method r))))
forall a b. (a -> b) -> a -> b
$ MS (r (Method r)) -> Maybe (MS (r (Method r)))
forall a. a -> Maybe a
Just MS (r (Method r))
mthd
Bool -> GenState (Maybe (SMethod r))
forall (r :: * -> *).
SharedProg r =>
Bool -> GenState (Maybe (SMethod r))
genDerived (Bool -> GenState (Maybe (SMethod r)))
-> Bool -> GenState (Maybe (SMethod r))
forall a b. (a -> b) -> a -> b
$ String
dvName String -> Set String -> Bool
forall a. Eq a => a -> Set a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` DrasilState -> Set String
defSet DrasilState
g
genInputConstraintsProc :: (SharedProg r) => VisibilityTag ->
GenState (Maybe (SMethod r))
genInputConstraintsProc :: forall (r :: * -> *).
SharedProg r =>
VisibilityTag -> GenState (Maybe (SMethod r))
genInputConstraintsProc VisibilityTag
s = do
DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
(DrasilState -> DrasilState) -> StateT DrasilState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\DrasilState
st -> DrasilState
st {currentScope = Local})
String
icName <- InternalConcept -> GenState String
genICName InternalConcept
InputConstraintsFn
let cm :: ConstraintCEMap
cm = DrasilState -> CodeSpec
codeSpec DrasilState
g CodeSpec
-> Getting ConstraintCEMap CodeSpec ConstraintCEMap
-> ConstraintCEMap
forall s a. s -> Getting a s a -> a
^. Getting ConstraintCEMap CodeSpec ConstraintCEMap
forall c. HasOldCodeSpec c => Lens' c ConstraintCEMap
Lens' CodeSpec ConstraintCEMap
cMapO
getFunc :: VisibilityTag
-> String
-> VSType r
-> String
-> [ParameterChunk]
-> Maybe String
-> [MSBlock r]
-> GenState (SMethod r)
getFunc VisibilityTag
Pub = String
-> VSType r
-> String
-> [ParameterChunk]
-> Maybe String
-> [MSBlock r]
-> GenState (SMethod r)
forall (r :: * -> *).
SharedProg r =>
String
-> VSType r
-> String
-> [ParameterChunk]
-> Maybe String
-> [MSBlock r]
-> GenState (SMethod r)
publicFuncProc
getFunc VisibilityTag
Priv = String
-> VSType r
-> String
-> [ParameterChunk]
-> Maybe String
-> [MSBlock r]
-> GenState (SMethod r)
forall (r :: * -> *).
SharedProg r =>
String
-> VSType r
-> String
-> [ParameterChunk]
-> Maybe String
-> [MSBlock r]
-> GenState (SMethod r)
privateFuncProc
genConstraints :: (SharedProg r) => Bool -> GenState
(Maybe (SMethod r))
genConstraints :: forall (r :: * -> *).
SharedProg r =>
Bool -> GenState (Maybe (SMethod r))
genConstraints Bool
False = Maybe (MS (r (Method r)))
-> StateT DrasilState Identity (Maybe (MS (r (Method r))))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MS (r (Method r)))
forall a. Maybe a
Nothing
genConstraints Bool
_ = do
[CodeVarChunk]
parms <- GenState [CodeVarChunk]
getConstraintParams
let varsList :: [CodeVarChunk]
varsList = (CodeVarChunk -> Bool) -> [CodeVarChunk] -> [CodeVarChunk]
forall a. (a -> Bool) -> [a] -> [a]
filter (\CodeVarChunk
i -> UID -> ConstraintCEMap -> Bool
forall k a. Ord k => k -> Map k a -> Bool
member (CodeVarChunk
i CodeVarChunk -> Getting UID CodeVarChunk UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID CodeVarChunk UID
forall c. HasUID c => Getter c UID
Getter CodeVarChunk UID
uid) ConstraintCEMap
cm) (DrasilState -> CodeSpec
codeSpec DrasilState
g CodeSpec
-> Getting [CodeVarChunk] CodeSpec [CodeVarChunk] -> [CodeVarChunk]
forall s a. s -> Getting a s a -> a
^. Getting [CodeVarChunk] CodeSpec [CodeVarChunk]
forall c. HasOldCodeSpec c => Lens' c [CodeVarChunk]
Lens' CodeSpec [CodeVarChunk]
inputsO)
sfwrCs :: [(CodeVarChunk, [ConstraintCE])]
sfwrCs = (CodeVarChunk -> (CodeVarChunk, [ConstraintCE]))
-> [CodeVarChunk] -> [(CodeVarChunk, [ConstraintCE])]
forall a b. (a -> b) -> [a] -> [b]
map (ConstraintCEMap -> CodeVarChunk -> (CodeVarChunk, [ConstraintCE])
forall q. HasUID q => ConstraintCEMap -> q -> (q, [ConstraintCE])
sfwrLookup ConstraintCEMap
cm) [CodeVarChunk]
varsList
physCs :: [(CodeVarChunk, [ConstraintCE])]
physCs = (CodeVarChunk -> (CodeVarChunk, [ConstraintCE]))
-> [CodeVarChunk] -> [(CodeVarChunk, [ConstraintCE])]
forall a b. (a -> b) -> [a] -> [b]
map (ConstraintCEMap -> CodeVarChunk -> (CodeVarChunk, [ConstraintCE])
forall q. HasUID q => ConstraintCEMap -> q -> (q, [ConstraintCE])
physLookup ConstraintCEMap
cm) [CodeVarChunk]
varsList
[MS (r (Statement r))]
sf <- [(CodeVarChunk, [ConstraintCE])]
-> StateT DrasilState Identity [MS (r (Statement r))]
forall (r :: * -> *).
SharedProg r =>
[(CodeVarChunk, [ConstraintCE])] -> GenState [MSStatement r]
sfwrCBodyProc [(CodeVarChunk, [ConstraintCE])]
sfwrCs
[MS (r (Statement r))]
ph <- [(CodeVarChunk, [ConstraintCE])]
-> StateT DrasilState Identity [MS (r (Statement r))]
forall (r :: * -> *).
SharedProg r =>
[(CodeVarChunk, [ConstraintCE])] -> GenState [MSStatement r]
physCBodyProc [(CodeVarChunk, [ConstraintCE])]
physCs
String
desc <- GenState String
inConsFuncDesc
MS (r (Method r))
mthd <- VisibilityTag
-> String
-> VS (r (Type r))
-> String
-> [ParameterChunk]
-> Maybe String
-> [MS (r (Block r))]
-> StateT DrasilState Identity (MS (r (Method r)))
forall {r :: * -> *}.
SharedProg r =>
VisibilityTag
-> String
-> VSType r
-> String
-> [ParameterChunk]
-> Maybe String
-> [MSBlock r]
-> GenState (SMethod r)
getFunc VisibilityTag
s String
icName VS (r (Type r))
forall (r :: * -> *). TypeSym r => VSType r
void String
desc ((CodeVarChunk -> ParameterChunk)
-> [CodeVarChunk] -> [ParameterChunk]
forall a b. (a -> b) -> [a] -> [b]
map CodeVarChunk -> ParameterChunk
forall c. CodeIdea c => c -> ParameterChunk
pcAuto [CodeVarChunk]
parms)
Maybe String
forall a. Maybe a
Nothing [[MS (r (Statement r))] -> MS (r (Block r))
forall (r :: * -> *). BlockSym r => [MSStatement r] -> MSBlock r
block [MS (r (Statement r))]
sf, [MS (r (Statement r))] -> MS (r (Block r))
forall (r :: * -> *). BlockSym r => [MSStatement r] -> MSBlock r
block [MS (r (Statement r))]
ph]
Maybe (MS (r (Method r)))
-> StateT DrasilState Identity (Maybe (MS (r (Method r))))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MS (r (Method r)))
-> StateT DrasilState Identity (Maybe (MS (r (Method r)))))
-> Maybe (MS (r (Method r)))
-> StateT DrasilState Identity (Maybe (MS (r (Method r))))
forall a b. (a -> b) -> a -> b
$ MS (r (Method r)) -> Maybe (MS (r (Method r)))
forall a. a -> Maybe a
Just MS (r (Method r))
mthd
Bool -> GenState (Maybe (SMethod r))
forall (r :: * -> *).
SharedProg r =>
Bool -> GenState (Maybe (SMethod r))
genConstraints (Bool -> GenState (Maybe (SMethod r)))
-> Bool -> GenState (Maybe (SMethod r))
forall a b. (a -> b) -> a -> b
$ String
icName String -> Set String -> Bool
forall a. Eq a => a -> Set a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` DrasilState -> Set String
defSet DrasilState
g
sfwrCBodyProc :: (SharedProg r) => [(CodeVarChunk, [ConstraintCE])] ->
GenState [MSStatement r]
sfwrCBodyProc :: forall (r :: * -> *).
SharedProg r =>
[(CodeVarChunk, [ConstraintCE])] -> GenState [MSStatement r]
sfwrCBodyProc [(CodeVarChunk, [ConstraintCE])]
cs = do
DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
let cb :: ConstraintBehaviour
cb = DrasilState -> ConstraintBehaviour
onSfwrC DrasilState
g
ConstraintBehaviour
-> [(CodeVarChunk, [ConstraintCE])] -> GenState [MSStatement r]
forall (r :: * -> *).
SharedProg r =>
ConstraintBehaviour
-> [(CodeVarChunk, [ConstraintCE])] -> GenState [MSStatement r]
chooseConstrProc ConstraintBehaviour
cb [(CodeVarChunk, [ConstraintCE])]
cs
physCBodyProc :: (SharedProg r) => [(CodeVarChunk, [ConstraintCE])] ->
GenState [MSStatement r]
physCBodyProc :: forall (r :: * -> *).
SharedProg r =>
[(CodeVarChunk, [ConstraintCE])] -> GenState [MSStatement r]
physCBodyProc [(CodeVarChunk, [ConstraintCE])]
cs = do
DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
let cb :: ConstraintBehaviour
cb = DrasilState -> ConstraintBehaviour
onPhysC DrasilState
g
ConstraintBehaviour
-> [(CodeVarChunk, [ConstraintCE])] -> GenState [MSStatement r]
forall (r :: * -> *).
SharedProg r =>
ConstraintBehaviour
-> [(CodeVarChunk, [ConstraintCE])] -> GenState [MSStatement r]
chooseConstrProc ConstraintBehaviour
cb [(CodeVarChunk, [ConstraintCE])]
cs
chooseConstrProc :: (SharedProg r) => ConstraintBehaviour ->
[(CodeVarChunk, [ConstraintCE])] -> GenState [MSStatement r]
chooseConstrProc :: forall (r :: * -> *).
SharedProg r =>
ConstraintBehaviour
-> [(CodeVarChunk, [ConstraintCE])] -> GenState [MSStatement r]
chooseConstrProc ConstraintBehaviour
cb [(CodeVarChunk, [ConstraintCE])]
cs = do
[[VS (r (Value r))]]
conds <- ((CodeVarChunk, [ConstraintCE])
-> StateT DrasilState Identity [VS (r (Value r))])
-> [(CodeVarChunk, [ConstraintCE])]
-> StateT DrasilState Identity [[VS (r (Value r))]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\(CodeVarChunk
q,[ConstraintCE]
cns) -> (ConstraintCE -> StateT DrasilState Identity (VS (r (Value r))))
-> [ConstraintCE] -> StateT DrasilState Identity [VS (r (Value r))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (CodeExpr -> StateT DrasilState Identity (VS (r (Value r)))
forall (r :: * -> *).
SharedProg r =>
CodeExpr -> GenState (SValue r)
convExprProc (CodeExpr -> StateT DrasilState Identity (VS (r (Value r))))
-> (ConstraintCE -> CodeExpr)
-> ConstraintCE
-> StateT DrasilState Identity (VS (r (Value r)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CodeVarChunk -> ConstraintCE -> CodeExpr
forall c. (HasUID c, HasSymbol c) => c -> ConstraintCE -> CodeExpr
renderC CodeVarChunk
q) [ConstraintCE]
cns) [(CodeVarChunk, [ConstraintCE])]
cs
[[MS (r (Body r))]]
bods <- ((CodeVarChunk, [ConstraintCE])
-> StateT DrasilState Identity [MS (r (Body r))])
-> [(CodeVarChunk, [ConstraintCE])]
-> StateT DrasilState Identity [[MS (r (Body r))]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ConstraintBehaviour
-> (CodeVarChunk, [ConstraintCE])
-> StateT DrasilState Identity [MS (r (Body r))]
forall {r :: * -> *}.
SharedProg r =>
ConstraintBehaviour
-> (CodeVarChunk, [ConstraintCE]) -> GenState [MS (r (Body r))]
chooseCB ConstraintBehaviour
cb) [(CodeVarChunk, [ConstraintCE])]
cs
[MSStatement r] -> GenState [MSStatement r]
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([MSStatement r] -> GenState [MSStatement r])
-> [MSStatement r] -> GenState [MSStatement r]
forall a b. (a -> b) -> a -> b
$ [[MSStatement r]] -> [MSStatement r]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[MSStatement r]] -> [MSStatement r])
-> [[MSStatement r]] -> [MSStatement r]
forall a b. (a -> b) -> a -> b
$ ([VS (r (Value r))] -> [MS (r (Body r))] -> [MSStatement r])
-> [[VS (r (Value r))]] -> [[MS (r (Body r))]] -> [[MSStatement r]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ((VS (r (Value r)) -> MS (r (Body r)) -> MSStatement r)
-> [VS (r (Value r))] -> [MS (r (Body r))] -> [MSStatement r]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\VS (r (Value r))
cond MS (r (Body r))
bod -> [(VS (r (Value r)), MS (r (Body r)))] -> MSStatement r
forall (r :: * -> *).
ControlStatement r =>
[(SValue r, MSBody r)] -> MSStatement r
ifNoElse [(VS (r (Value r)) -> VS (r (Value r))
forall (r :: * -> *). BooleanExpression r => SValue r -> SValue r
(?!) VS (r (Value r))
cond, MS (r (Body r))
bod)]))
[[VS (r (Value r))]]
conds [[MS (r (Body r))]]
bods
where chooseCB :: ConstraintBehaviour
-> (CodeVarChunk, [ConstraintCE]) -> GenState [MS (r (Body r))]
chooseCB ConstraintBehaviour
Warning = (CodeVarChunk, [ConstraintCE]) -> GenState [MS (r (Body r))]
forall (r :: * -> *).
SharedProg r =>
(CodeVarChunk, [ConstraintCE]) -> GenState [MSBody r]
constrWarnProc
chooseCB ConstraintBehaviour
Exception = (CodeVarChunk, [ConstraintCE]) -> GenState [MS (r (Body r))]
forall (r :: * -> *).
SharedProg r =>
(CodeVarChunk, [ConstraintCE]) -> GenState [MSBody r]
constrExcProc
constrWarnProc :: (SharedProg r) => (CodeVarChunk, [ConstraintCE]) ->
GenState [MSBody r]
constrWarnProc :: forall (r :: * -> *).
SharedProg r =>
(CodeVarChunk, [ConstraintCE]) -> GenState [MSBody r]
constrWarnProc (CodeVarChunk, [ConstraintCE])
c = do
let q :: CodeVarChunk
q = (CodeVarChunk, [ConstraintCE]) -> CodeVarChunk
forall a b. (a, b) -> a
fst (CodeVarChunk, [ConstraintCE])
c
cs :: [ConstraintCE]
cs = (CodeVarChunk, [ConstraintCE]) -> [ConstraintCE]
forall a b. (a, b) -> b
snd (CodeVarChunk, [ConstraintCE])
c
[[MS (r (Statement r))]]
msgs <- (ConstraintCE
-> StateT DrasilState Identity [MS (r (Statement r))])
-> [ConstraintCE]
-> StateT DrasilState Identity [[MS (r (Statement r))]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (CodeVarChunk
-> String
-> ConstraintCE
-> StateT DrasilState Identity [MS (r (Statement r))]
forall (r :: * -> *).
SharedProg r =>
CodeVarChunk -> String -> ConstraintCE -> GenState [MSStatement r]
constraintViolatedMsgProc CodeVarChunk
q String
"suggested") [ConstraintCE]
cs
[MSBody r] -> GenState [MSBody r]
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([MSBody r] -> GenState [MSBody r])
-> [MSBody r] -> GenState [MSBody r]
forall a b. (a -> b) -> a -> b
$ ([MS (r (Statement r))] -> MSBody r)
-> [[MS (r (Statement r))]] -> [MSBody r]
forall a b. (a -> b) -> [a] -> [b]
map ([MS (r (Statement r))] -> MSBody r
forall (r :: * -> *). BodySym r => [MSStatement r] -> MSBody r
bodyStatements ([MS (r (Statement r))] -> MSBody r)
-> ([MS (r (Statement r))] -> [MS (r (Statement r))])
-> [MS (r (Statement r))]
-> MSBody r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> MS (r (Statement r))
forall (r :: * -> *). IOStatement r => String -> MSStatement r
printStr String
"Warning: " MS (r (Statement r))
-> [MS (r (Statement r))] -> [MS (r (Statement r))]
forall a. a -> [a] -> [a]
:)) [[MS (r (Statement r))]]
msgs
constrExcProc :: (SharedProg r) => (CodeVarChunk, [ConstraintCE]) ->
GenState [MSBody r]
constrExcProc :: forall (r :: * -> *).
SharedProg r =>
(CodeVarChunk, [ConstraintCE]) -> GenState [MSBody r]
constrExcProc (CodeVarChunk, [ConstraintCE])
c = do
let q :: CodeVarChunk
q = (CodeVarChunk, [ConstraintCE]) -> CodeVarChunk
forall a b. (a, b) -> a
fst (CodeVarChunk, [ConstraintCE])
c
cs :: [ConstraintCE]
cs = (CodeVarChunk, [ConstraintCE]) -> [ConstraintCE]
forall a b. (a, b) -> b
snd (CodeVarChunk, [ConstraintCE])
c
[[MS (r (Statement r))]]
msgs <- (ConstraintCE
-> StateT DrasilState Identity [MS (r (Statement r))])
-> [ConstraintCE]
-> StateT DrasilState Identity [[MS (r (Statement r))]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (CodeVarChunk
-> String
-> ConstraintCE
-> StateT DrasilState Identity [MS (r (Statement r))]
forall (r :: * -> *).
SharedProg r =>
CodeVarChunk -> String -> ConstraintCE -> GenState [MSStatement r]
constraintViolatedMsgProc CodeVarChunk
q String
"expected") [ConstraintCE]
cs
[MSBody r] -> GenState [MSBody r]
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([MSBody r] -> GenState [MSBody r])
-> [MSBody r] -> GenState [MSBody r]
forall a b. (a -> b) -> a -> b
$ ([MS (r (Statement r))] -> MSBody r)
-> [[MS (r (Statement r))]] -> [MSBody r]
forall a b. (a -> b) -> [a] -> [b]
map ([MS (r (Statement r))] -> MSBody r
forall (r :: * -> *). BodySym r => [MSStatement r] -> MSBody r
bodyStatements ([MS (r (Statement r))] -> MSBody r)
-> ([MS (r (Statement r))] -> [MS (r (Statement r))])
-> [MS (r (Statement r))]
-> MSBody r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([MS (r (Statement r))]
-> [MS (r (Statement r))] -> [MS (r (Statement r))]
forall a. [a] -> [a] -> [a]
++ [String -> MS (r (Statement r))
forall (r :: * -> *). ControlStatement r => String -> MSStatement r
throw String
"InputError"])) [[MS (r (Statement r))]]
msgs
constraintViolatedMsgProc :: (SharedProg r) => CodeVarChunk -> String ->
ConstraintCE -> GenState [MSStatement r]
constraintViolatedMsgProc :: forall (r :: * -> *).
SharedProg r =>
CodeVarChunk -> String -> ConstraintCE -> GenState [MSStatement r]
constraintViolatedMsgProc CodeVarChunk
q String
s ConstraintCE
c = do
[MSStatement r]
pc <- ConstraintCE -> GenState [MSStatement r]
forall (r :: * -> *).
SharedProg r =>
ConstraintCE -> GenState [MSStatement r]
printConstraintProc ConstraintCE
c
VS (r (Value r))
v <- CodeVarChunk -> StateT DrasilState Identity (VS (r (Value r)))
forall (r :: * -> *).
SharedProg r =>
CodeVarChunk -> GenState (SValue r)
mkValProc (CodeVarChunk -> CodeVarChunk
forall c. (Quantity c, MayHaveUnit c) => c -> CodeVarChunk
quantvar CodeVarChunk
q)
[MSStatement r] -> GenState [MSStatement r]
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([MSStatement r] -> GenState [MSStatement r])
-> [MSStatement r] -> GenState [MSStatement r]
forall a b. (a -> b) -> a -> b
$ [String -> MSStatement r
forall (r :: * -> *). IOStatement r => String -> MSStatement r
printStr (String -> MSStatement r) -> String -> MSStatement r
forall a b. (a -> b) -> a -> b
$ CodeVarChunk -> String
forall c. CodeIdea c => c -> String
codeName CodeVarChunk
q String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" has value ",
VS (r (Value r)) -> MSStatement r
forall (r :: * -> *). IOStatement r => SValue r -> MSStatement r
print VS (r (Value r))
v,
String -> MSStatement r
forall (r :: * -> *). IOStatement r => String -> MSStatement r
printStr (String -> MSStatement r) -> String -> MSStatement r
forall a b. (a -> b) -> a -> b
$ String
", but is " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" to be "] [MSStatement r] -> [MSStatement r] -> [MSStatement r]
forall a. [a] -> [a] -> [a]
++ [MSStatement r]
pc
printConstraintProc :: (SharedProg r) => ConstraintCE ->
GenState [MSStatement r]
printConstraintProc :: forall (r :: * -> *).
SharedProg r =>
ConstraintCE -> GenState [MSStatement r]
printConstraintProc ConstraintCE
c = do
DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
let db :: ChunkDB
db = DrasilState -> CodeSpec
codeSpec DrasilState
g CodeSpec -> Getting ChunkDB CodeSpec ChunkDB -> ChunkDB
forall s a. s -> Getting a s a -> a
^. Getting ChunkDB CodeSpec ChunkDB
forall c. HasOldCodeSpec c => Lens' c ChunkDB
Lens' CodeSpec ChunkDB
sysinfodbO
printConstraint' :: (SharedProg r) => ConstraintCE -> GenState
[MSStatement r]
printConstraint' :: forall (r :: * -> *).
SharedProg r =>
ConstraintCE -> GenState [MSStatement r]
printConstraint' (Range ConstraintReason
_ (Bounded (Inclusive
_, CodeExpr
e1) (Inclusive
_, CodeExpr
e2))) = do
VS (r (Value r))
lb <- CodeExpr -> StateT DrasilState Identity (VS (r (Value r)))
forall (r :: * -> *).
SharedProg r =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
e1
VS (r (Value r))
ub <- CodeExpr -> StateT DrasilState Identity (VS (r (Value r)))
forall (r :: * -> *).
SharedProg r =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
e2
[MSStatement r] -> GenState [MSStatement r]
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([MSStatement r] -> GenState [MSStatement r])
-> [MSStatement r] -> GenState [MSStatement r]
forall a b. (a -> b) -> a -> b
$ [String -> MSStatement r
forall (r :: * -> *). IOStatement r => String -> MSStatement r
printStr String
"between ", VS (r (Value r)) -> MSStatement r
forall (r :: * -> *). IOStatement r => SValue r -> MSStatement r
print VS (r (Value r))
lb] [MSStatement r] -> [MSStatement r] -> [MSStatement r]
forall a. [a] -> [a] -> [a]
++ CodeExpr -> ChunkDB -> [MSStatement r]
forall (r :: * -> *).
SharedProg r =>
CodeExpr -> ChunkDB -> [MSStatement r]
printExpr CodeExpr
e1 ChunkDB
db [MSStatement r] -> [MSStatement r] -> [MSStatement r]
forall a. [a] -> [a] -> [a]
++
[String -> MSStatement r
forall (r :: * -> *). IOStatement r => String -> MSStatement r
printStr String
" and ", VS (r (Value r)) -> MSStatement r
forall (r :: * -> *). IOStatement r => SValue r -> MSStatement r
print VS (r (Value r))
ub] [MSStatement r] -> [MSStatement r] -> [MSStatement r]
forall a. [a] -> [a] -> [a]
++ CodeExpr -> ChunkDB -> [MSStatement r]
forall (r :: * -> *).
SharedProg r =>
CodeExpr -> ChunkDB -> [MSStatement r]
printExpr CodeExpr
e2 ChunkDB
db [MSStatement r] -> [MSStatement r] -> [MSStatement r]
forall a. [a] -> [a] -> [a]
++ [String -> MSStatement r
forall (r :: * -> *). IOStatement r => String -> MSStatement r
printStrLn String
"."]
printConstraint' (Range ConstraintReason
_ (UpTo (Inclusive
_, CodeExpr
e))) = do
VS (r (Value r))
ub <- CodeExpr -> StateT DrasilState Identity (VS (r (Value r)))
forall (r :: * -> *).
SharedProg r =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
e
[MSStatement r] -> GenState [MSStatement r]
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([MSStatement r] -> GenState [MSStatement r])
-> [MSStatement r] -> GenState [MSStatement r]
forall a b. (a -> b) -> a -> b
$ [String -> MSStatement r
forall (r :: * -> *). IOStatement r => String -> MSStatement r
printStr String
"below ", VS (r (Value r)) -> MSStatement r
forall (r :: * -> *). IOStatement r => SValue r -> MSStatement r
print VS (r (Value r))
ub] [MSStatement r] -> [MSStatement r] -> [MSStatement r]
forall a. [a] -> [a] -> [a]
++ CodeExpr -> ChunkDB -> [MSStatement r]
forall (r :: * -> *).
SharedProg r =>
CodeExpr -> ChunkDB -> [MSStatement r]
printExpr CodeExpr
e ChunkDB
db [MSStatement r] -> [MSStatement r] -> [MSStatement r]
forall a. [a] -> [a] -> [a]
++
[String -> MSStatement r
forall (r :: * -> *). IOStatement r => String -> MSStatement r
printStrLn String
"."]
printConstraint' (Range ConstraintReason
_ (UpFrom (Inclusive
_, CodeExpr
e))) = do
VS (r (Value r))
lb <- CodeExpr -> StateT DrasilState Identity (VS (r (Value r)))
forall (r :: * -> *).
SharedProg r =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
e
[MSStatement r] -> GenState [MSStatement r]
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([MSStatement r] -> GenState [MSStatement r])
-> [MSStatement r] -> GenState [MSStatement r]
forall a b. (a -> b) -> a -> b
$ [String -> MSStatement r
forall (r :: * -> *). IOStatement r => String -> MSStatement r
printStr String
"above ", VS (r (Value r)) -> MSStatement r
forall (r :: * -> *). IOStatement r => SValue r -> MSStatement r
print VS (r (Value r))
lb] [MSStatement r] -> [MSStatement r] -> [MSStatement r]
forall a. [a] -> [a] -> [a]
++ CodeExpr -> ChunkDB -> [MSStatement r]
forall (r :: * -> *).
SharedProg r =>
CodeExpr -> ChunkDB -> [MSStatement r]
printExpr CodeExpr
e ChunkDB
db [MSStatement r] -> [MSStatement r] -> [MSStatement r]
forall a. [a] -> [a] -> [a]
++ [String -> MSStatement r
forall (r :: * -> *). IOStatement r => String -> MSStatement r
printStrLn String
"."]
printConstraint' (Elem ConstraintReason
_ CodeExpr
e) = do
VS (r (Value r))
lb <- CodeExpr -> StateT DrasilState Identity (VS (r (Value r)))
forall (r :: * -> *).
SharedProg r =>
CodeExpr -> GenState (SValue r)
convExprProc CodeExpr
e
[MSStatement r] -> GenState [MSStatement r]
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([MSStatement r] -> GenState [MSStatement r])
-> [MSStatement r] -> GenState [MSStatement r]
forall a b. (a -> b) -> a -> b
$ [String -> MSStatement r
forall (r :: * -> *). IOStatement r => String -> MSStatement r
printStr String
"an element of the set ", VS (r (Value r)) -> MSStatement r
forall (r :: * -> *). IOStatement r => SValue r -> MSStatement r
print VS (r (Value r))
lb] [MSStatement r] -> [MSStatement r] -> [MSStatement r]
forall a. [a] -> [a] -> [a]
++ [String -> MSStatement r
forall (r :: * -> *). IOStatement r => String -> MSStatement r
printStrLn String
"."]
ConstraintCE -> GenState [MSStatement r]
forall (r :: * -> *).
SharedProg r =>
ConstraintCE -> GenState [MSStatement r]
printConstraint' ConstraintCE
c
genOutputModProc :: (ProcProg r) => GenState [Proc.SFile r]
genOutputModProc :: forall (r :: * -> *). ProcProg r => GenState [SFile r]
genOutputModProc = do
String
ofName <- InternalConcept -> GenState String
genICName InternalConcept
OutputFormat
String
ofDesc <- GenState [String] -> GenState String
modDesc (GenState [String] -> GenState String)
-> GenState [String] -> GenState String
forall a b. (a -> b) -> a -> b
$ GenState String -> GenState [String]
forall a b. State a b -> State a [b]
liftS GenState String
outputFormatDesc
State DrasilState (SFile r) -> GenState [SFile r]
forall a b. State a b -> State a [b]
liftS (State DrasilState (SFile r) -> GenState [SFile r])
-> State DrasilState (SFile r) -> GenState [SFile r]
forall a b. (a -> b) -> a -> b
$ String
-> String
-> [GenState (Maybe (SMethod r))]
-> State DrasilState (SFile r)
forall (r :: * -> *).
ProcProg r =>
String
-> String -> [GenState (Maybe (SMethod r))] -> GenState (SFile r)
genModuleProc String
ofName String
ofDesc [GenState (Maybe (SMethod r))
forall (r :: * -> *). SharedProg r => GenState (Maybe (SMethod r))
genOutputFormatProc]
genOutputFormatProc :: (SharedProg r) => GenState (Maybe (SMethod r))
genOutputFormatProc :: forall (r :: * -> *). SharedProg r => GenState (Maybe (SMethod r))
genOutputFormatProc = do
DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
(DrasilState -> DrasilState) -> StateT DrasilState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\DrasilState
st -> DrasilState
st {currentScope = Local})
String
woName <- InternalConcept -> GenState String
genICName InternalConcept
WriteOutput
let genOutput :: (SharedProg r) => Maybe String -> GenState (Maybe (SMethod r))
genOutput :: forall (r :: * -> *).
SharedProg r =>
Maybe String -> GenState (Maybe (SMethod r))
genOutput Maybe String
Nothing = Maybe (MS (r (Method r)))
-> StateT DrasilState Identity (Maybe (MS (r (Method r))))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MS (r (Method r)))
forall a. Maybe a
Nothing
genOutput (Just String
_) = do
let l_outfile :: String
l_outfile = String
"outputfile"
var_outfile :: SVariable r
var_outfile = String -> VSType r -> SVariable r
forall (r :: * -> *).
VariableSym r =>
String -> VSType r -> SVariable r
var String
l_outfile VSType r
forall (r :: * -> *). TypeSym r => VSType r
outfile
v_outfile :: SValue r
v_outfile = SVariable r -> SValue r
forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
valueOf SVariable r
var_outfile
[CodeVarChunk]
parms <- GenState [CodeVarChunk]
getOutputParams
[[MS (r (Statement r))]]
outp <- (CodeVarChunk
-> StateT DrasilState Identity [MS (r (Statement r))])
-> [CodeVarChunk]
-> StateT DrasilState Identity [[MS (r (Statement r))]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\CodeVarChunk
x -> do
SValue r
v <- CodeVarChunk -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *).
SharedProg r =>
CodeVarChunk -> GenState (SValue r)
mkValProc CodeVarChunk
x
[MS (r (Statement r))]
-> StateT DrasilState Identity [MS (r (Statement r))]
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return [ SValue r -> String -> MS (r (Statement r))
forall (r :: * -> *).
IOStatement r =>
SValue r -> String -> MSStatement r
printFileStr SValue r
v_outfile (CodeVarChunk -> String
forall c. CodeIdea c => c -> String
codeName CodeVarChunk
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" = "),
SValue r -> SValue r -> MS (r (Statement r))
forall (r :: * -> *).
IOStatement r =>
SValue r -> SValue r -> MSStatement r
printFileLn SValue r
v_outfile SValue r
v
] ) (DrasilState -> CodeSpec
codeSpec DrasilState
g CodeSpec
-> Getting [CodeVarChunk] CodeSpec [CodeVarChunk] -> [CodeVarChunk]
forall s a. s -> Getting a s a -> a
^. Getting [CodeVarChunk] CodeSpec [CodeVarChunk]
forall c. HasOldCodeSpec c => Lens' c [CodeVarChunk]
Lens' CodeSpec [CodeVarChunk]
outputsO)
String
desc <- GenState String
woFuncDesc
MS (r (Method r))
mthd <- String
-> VSType r
-> String
-> [ParameterChunk]
-> Maybe String
-> [MSBlock r]
-> StateT DrasilState Identity (MS (r (Method r)))
forall (r :: * -> *).
SharedProg r =>
String
-> VSType r
-> String
-> [ParameterChunk]
-> Maybe String
-> [MSBlock r]
-> GenState (SMethod r)
publicFuncProc String
woName VSType r
forall (r :: * -> *). TypeSym r => VSType r
void String
desc ((CodeVarChunk -> ParameterChunk)
-> [CodeVarChunk] -> [ParameterChunk]
forall a b. (a -> b) -> [a] -> [b]
map CodeVarChunk -> ParameterChunk
forall c. CodeIdea c => c -> ParameterChunk
pcAuto [CodeVarChunk]
parms) Maybe String
forall a. Maybe a
Nothing
[[MS (r (Statement r))] -> MSBlock r
forall (r :: * -> *). BlockSym r => [MSStatement r] -> MSBlock r
block ([MS (r (Statement r))] -> MSBlock r)
-> [MS (r (Statement r))] -> MSBlock r
forall a b. (a -> b) -> a -> b
$ [
SVariable r -> r (Scope r) -> MS (r (Statement r))
forall (r :: * -> *).
DeclStatement r =>
SVariable r -> r (Scope r) -> MSStatement r
varDec SVariable r
var_outfile r (Scope r)
forall (r :: * -> *). ScopeSym r => r (Scope r)
local,
SVariable r -> SValue r -> MS (r (Statement r))
forall (r :: * -> *).
IOStatement r =>
SVariable r -> SValue r -> MSStatement r
openFileW SVariable r
var_outfile (String -> SValue r
forall (r :: * -> *). Literal r => String -> SValue r
litString String
"output.txt") ] [MS (r (Statement r))]
-> [MS (r (Statement r))] -> [MS (r (Statement r))]
forall a. [a] -> [a] -> [a]
++
[[MS (r (Statement r))]] -> [MS (r (Statement r))]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[MS (r (Statement r))]]
outp [MS (r (Statement r))]
-> [MS (r (Statement r))] -> [MS (r (Statement r))]
forall a. [a] -> [a] -> [a]
++ [ SValue r -> MS (r (Statement r))
forall (r :: * -> *). IOStatement r => SValue r -> MSStatement r
closeFile SValue r
v_outfile ]]
Maybe (MS (r (Method r)))
-> StateT DrasilState Identity (Maybe (MS (r (Method r))))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MS (r (Method r)))
-> StateT DrasilState Identity (Maybe (MS (r (Method r)))))
-> Maybe (MS (r (Method r)))
-> StateT DrasilState Identity (Maybe (MS (r (Method r))))
forall a b. (a -> b) -> a -> b
$ MS (r (Method r)) -> Maybe (MS (r (Method r)))
forall a. a -> Maybe a
Just MS (r (Method r))
mthd
Maybe String -> GenState (Maybe (SMethod r))
forall (r :: * -> *).
SharedProg r =>
Maybe String -> GenState (Maybe (SMethod r))
genOutput (Maybe String -> GenState (Maybe (SMethod r)))
-> Maybe String -> GenState (Maybe (SMethod r))
forall a b. (a -> b) -> a -> b
$ String -> Map String String -> Maybe String
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
woName (DrasilState -> Map String String
eMap DrasilState
g)