module Language.Drasil.Code.Imperative.FunctionCalls (
getAllInputCalls, getInputCall, getDerivedCall, getConstraintCall,
getCalcCall, getOutputCall
) where
import Language.Drasil.Code.Imperative.GenerateGOOL (fApp, fAppInOut)
import Language.Drasil.Code.Imperative.Import (codeType, mkVal, mkVar)
import Language.Drasil.Code.Imperative.Logging (maybeLog)
import Language.Drasil.Code.Imperative.Parameters (getCalcParams,
getConstraintParams, getDerivedIns, getDerivedOuts, getInputFormatIns,
getInputFormatOuts, getOutputParams)
import Language.Drasil.Code.Imperative.DrasilState (GenState, DrasilState(..))
import Language.Drasil.Chunk.Code (CodeIdea(codeName), CodeVarChunk, quantvar)
import Language.Drasil.Chunk.CodeDefinition (CodeDefinition)
import Language.Drasil.Mod (Name)
import GOOL.Drasil (VSType, SValue, MSStatement, OOProg, TypeSym(..),
VariableValue(..), StatementSym(..), DeclStatement(..), convType)
import Data.List ((\\), intersect)
import qualified Data.Map as Map (lookup)
import Data.Maybe (catMaybes)
import Control.Applicative ((<|>))
import Control.Monad.State (get)
getAllInputCalls :: (OOProg r) => GenState [MSStatement r]
getAllInputCalls :: forall (r :: * -> *). OOProg r => GenState [MSStatement r]
getAllInputCalls = do
Maybe (MSStatement r)
gi <- forall (r :: * -> *). OOProg r => GenState (Maybe (MSStatement r))
getInputCall
Maybe (MSStatement r)
dv <- forall (r :: * -> *). OOProg r => GenState (Maybe (MSStatement r))
getDerivedCall
Maybe (MSStatement r)
ic <- forall (r :: * -> *). OOProg r => GenState (Maybe (MSStatement r))
getConstraintCall
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. [Maybe a] -> [a]
catMaybes [Maybe (MSStatement r)
gi, Maybe (MSStatement r)
dv, Maybe (MSStatement r)
ic]
getInputCall :: (OOProg r) => GenState (Maybe (MSStatement r))
getInputCall :: forall (r :: * -> *). OOProg r => GenState (Maybe (MSStatement r))
getInputCall = forall (r :: * -> *).
OOProg r =>
Name
-> GenState [CodeVarChunk]
-> GenState [CodeVarChunk]
-> GenState (Maybe (MSStatement r))
getInOutCall Name
"get_input" GenState [CodeVarChunk]
getInputFormatIns GenState [CodeVarChunk]
getInputFormatOuts
getDerivedCall :: (OOProg r) => GenState (Maybe (MSStatement r))
getDerivedCall :: forall (r :: * -> *). OOProg r => GenState (Maybe (MSStatement r))
getDerivedCall = forall (r :: * -> *).
OOProg r =>
Name
-> GenState [CodeVarChunk]
-> GenState [CodeVarChunk]
-> GenState (Maybe (MSStatement r))
getInOutCall Name
"derived_values" GenState [CodeVarChunk]
getDerivedIns GenState [CodeVarChunk]
getDerivedOuts
getConstraintCall :: (OOProg r) => GenState (Maybe (MSStatement r))
getConstraintCall :: forall (r :: * -> *). OOProg r => GenState (Maybe (MSStatement r))
getConstraintCall = do
Maybe (VS (r (Value r)))
val <- forall (r :: * -> *).
OOProg r =>
Name
-> VSType r
-> GenState [CodeVarChunk]
-> GenState (Maybe (SValue r))
getFuncCall Name
"input_constraints" forall (r :: * -> *). TypeSym r => VSType r
void GenState [CodeVarChunk]
getConstraintParams
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (r :: * -> *). StatementSym r => SValue r -> MSStatement r
valStmt Maybe (VS (r (Value r)))
val
getCalcCall :: (OOProg r) => CodeDefinition -> GenState (Maybe (MSStatement r))
getCalcCall :: forall (r :: * -> *).
OOProg r =>
CodeDefinition -> GenState (Maybe (MSStatement r))
getCalcCall CodeDefinition
c = do
CodeType
t <- forall c. HasSpace c => c -> GenState CodeType
codeType CodeDefinition
c
Maybe (VS (r (Value r)))
val <- forall (r :: * -> *).
OOProg r =>
Name
-> VSType r
-> GenState [CodeVarChunk]
-> GenState (Maybe (SValue r))
getFuncCall (forall c. CodeIdea c => c -> Name
codeName CodeDefinition
c) (forall (r :: * -> *). TypeSym r => CodeType -> VSType r
convType CodeType
t) (CodeDefinition -> GenState [CodeVarChunk]
getCalcParams CodeDefinition
c)
VS (r (Variable r))
v <- forall (r :: * -> *).
OOProg r =>
CodeVarChunk -> GenState (SVariable r)
mkVar forall a b. (a -> b) -> a -> b
$ forall c. (Quantity c, MayHaveUnit c) => c -> CodeVarChunk
quantvar CodeDefinition
c
[MSStatement r]
l <- forall (r :: * -> *).
OOProg r =>
SVariable r -> GenState [MSStatement r]
maybeLog VS (r (Variable r))
v
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (r :: * -> *).
StatementSym r =>
[MSStatement r] -> MSStatement r
multi forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> [a] -> [a]
: [MSStatement r]
l) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (r :: * -> *).
DeclStatement r =>
SVariable r -> SValue r -> MSStatement r
varDecDef VS (r (Variable r))
v) Maybe (VS (r (Value r)))
val
getOutputCall :: (OOProg r) => GenState (Maybe (MSStatement r))
getOutputCall :: forall (r :: * -> *). OOProg r => GenState (Maybe (MSStatement r))
getOutputCall = do
Maybe (VS (r (Value r)))
val <- forall (r :: * -> *).
OOProg r =>
Name
-> VSType r
-> GenState [CodeVarChunk]
-> GenState (Maybe (SValue r))
getFuncCall Name
"write_output" forall (r :: * -> *). TypeSym r => VSType r
void GenState [CodeVarChunk]
getOutputParams
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (r :: * -> *). StatementSym r => SValue r -> MSStatement r
valStmt Maybe (VS (r (Value r)))
val
getFuncCall :: (OOProg r) => Name -> VSType r ->
GenState [CodeVarChunk] -> GenState (Maybe (SValue r))
getFuncCall :: forall (r :: * -> *).
OOProg r =>
Name
-> VSType r
-> GenState [CodeVarChunk]
-> GenState (Maybe (SValue r))
getFuncCall Name
n VSType r
t GenState [CodeVarChunk]
funcPs = do
Maybe Name
mm <- Name -> GenState (Maybe Name)
getCall Name
n
let getFuncCall' :: Maybe Name -> GenState (Maybe (SValue r))
getFuncCall' Maybe Name
Nothing = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
getFuncCall' (Just Name
m) = do
[CodeVarChunk]
cs <- GenState [CodeVarChunk]
funcPs
[SValue r]
pvals <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (r :: * -> *).
OOProg r =>
CodeVarChunk -> GenState (SValue r)
mkVal [CodeVarChunk]
cs
SValue r
val <- forall (r :: * -> *).
OOProg r =>
Name
-> Name
-> VSType r
-> [SValue r]
-> NamedArgs r
-> GenState (SValue r)
fApp Name
m Name
n VSType r
t [SValue r]
pvals []
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just SValue r
val
Maybe Name -> GenState (Maybe (SValue r))
getFuncCall' Maybe Name
mm
getInOutCall :: (OOProg r) => Name -> GenState [CodeVarChunk] ->
GenState [CodeVarChunk] -> GenState (Maybe (MSStatement r))
getInOutCall :: forall (r :: * -> *).
OOProg r =>
Name
-> GenState [CodeVarChunk]
-> GenState [CodeVarChunk]
-> GenState (Maybe (MSStatement r))
getInOutCall Name
n GenState [CodeVarChunk]
inFunc GenState [CodeVarChunk]
outFunc = do
Maybe Name
mm <- Name -> GenState (Maybe Name)
getCall Name
n
let getInOutCall' :: Maybe Name
-> StateT DrasilState Identity (Maybe (MS (r (Statement r))))
getInOutCall' Maybe Name
Nothing = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
getInOutCall' (Just Name
m) = do
[CodeVarChunk]
ins' <- GenState [CodeVarChunk]
inFunc
[CodeVarChunk]
outs' <- GenState [CodeVarChunk]
outFunc
[VS (r (Variable r))]
ins <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (r :: * -> *).
OOProg r =>
CodeVarChunk -> GenState (SVariable r)
mkVar ([CodeVarChunk]
ins' forall a. Eq a => [a] -> [a] -> [a]
\\ [CodeVarChunk]
outs')
[VS (r (Variable r))]
outs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (r :: * -> *).
OOProg r =>
CodeVarChunk -> GenState (SVariable r)
mkVar ([CodeVarChunk]
outs' forall a. Eq a => [a] -> [a] -> [a]
\\ [CodeVarChunk]
ins')
[VS (r (Variable r))]
both <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (r :: * -> *).
OOProg r =>
CodeVarChunk -> GenState (SVariable r)
mkVar ([CodeVarChunk]
ins' forall a. Eq a => [a] -> [a] -> [a]
`intersect` [CodeVarChunk]
outs')
MS (r (Statement r))
stmt <- forall (r :: * -> *).
OOProg r =>
Name
-> Name
-> [SValue r]
-> [SVariable r]
-> [SVariable r]
-> GenState (MSStatement r)
fAppInOut Name
m Name
n (forall a b. (a -> b) -> [a] -> [b]
map forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
valueOf [VS (r (Variable r))]
ins) [VS (r (Variable r))]
outs [VS (r (Variable r))]
both
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just MS (r (Statement r))
stmt
forall {r :: * -> *}.
OOProg r =>
Maybe Name
-> StateT DrasilState Identity (Maybe (MS (r (Statement r))))
getInOutCall' Maybe Name
mm
getCall :: Name -> GenState (Maybe Name)
getCall :: Name -> GenState (Maybe Name)
getCall Name
n = do
DrasilState
g <- forall s (m :: * -> *). MonadState s m => m s
get
let currc :: Name
currc = DrasilState -> Name
currentClass DrasilState
g
getCallExported :: Maybe Name -> m (Maybe Name)
getCallExported Maybe Name
Nothing = forall {m :: * -> *}. Monad m => Maybe Name -> m (Maybe Name)
getCallInClass (forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
n forall a b. (a -> b) -> a -> b
$ DrasilState -> ClassDefinitionMap
clsMap DrasilState
g)
getCallExported Maybe Name
m = forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Name
m
getCallInClass :: Maybe Name -> m (Maybe Name)
getCallInClass Maybe Name
Nothing = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
getCallInClass (Just Name
c) = if Name
c forall a. Eq a => a -> a -> Bool
== Name
currc then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
c (DrasilState -> ClassDefinitionMap
eMap
DrasilState
g) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. HasCallStack => Name -> a
error (Name
c forall a. [a] -> [a] -> [a]
++ Name
" class missing from export map")
else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
forall {m :: * -> *}. Monad m => Maybe Name -> m (Maybe Name)
getCallExported forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
n (DrasilState -> ClassDefinitionMap
eMap DrasilState
g)