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 :: GenState [MSStatement r]
getAllInputCalls = do
Maybe (MSStatement r)
gi <- GenState (Maybe (MSStatement r))
forall (r :: * -> *). OOProg r => GenState (Maybe (MSStatement r))
getInputCall
Maybe (MSStatement r)
dv <- GenState (Maybe (MSStatement r))
forall (r :: * -> *). OOProg r => GenState (Maybe (MSStatement r))
getDerivedCall
Maybe (MSStatement r)
ic <- GenState (Maybe (MSStatement r))
forall (r :: * -> *). OOProg r => GenState (Maybe (MSStatement r))
getConstraintCall
[MSStatement r] -> GenState [MSStatement r]
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
$ [Maybe (MSStatement r)] -> [MSStatement r]
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 :: GenState (Maybe (MSStatement r))
getInputCall = Name
-> GenState [CodeVarChunk]
-> GenState [CodeVarChunk]
-> GenState (Maybe (MSStatement r))
forall (r :: * -> *).
OOProg r =>
Name
-> GenState [CodeVarChunk]
-> GenState [CodeVarChunk]
-> GenState (Maybe (MSStatement r))
getInOutCall "get_input" GenState [CodeVarChunk]
getInputFormatIns GenState [CodeVarChunk]
getInputFormatOuts
getDerivedCall :: (OOProg r) => GenState (Maybe (MSStatement r))
getDerivedCall :: GenState (Maybe (MSStatement r))
getDerivedCall = Name
-> GenState [CodeVarChunk]
-> GenState [CodeVarChunk]
-> GenState (Maybe (MSStatement r))
forall (r :: * -> *).
OOProg r =>
Name
-> GenState [CodeVarChunk]
-> GenState [CodeVarChunk]
-> GenState (Maybe (MSStatement r))
getInOutCall "derived_values" GenState [CodeVarChunk]
getDerivedIns GenState [CodeVarChunk]
getDerivedOuts
getConstraintCall :: (OOProg r) => GenState (Maybe (MSStatement r))
getConstraintCall :: GenState (Maybe (MSStatement r))
getConstraintCall = do
Maybe (VS (r (Value r)))
val <- Name
-> VSType r
-> GenState [CodeVarChunk]
-> GenState (Maybe (VS (r (Value r))))
forall (r :: * -> *).
OOProg r =>
Name
-> VSType r
-> GenState [CodeVarChunk]
-> GenState (Maybe (SValue r))
getFuncCall "input_constraints" VSType r
forall (r :: * -> *). TypeSym r => VSType r
void GenState [CodeVarChunk]
getConstraintParams
Maybe (MSStatement r) -> GenState (Maybe (MSStatement r))
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
$ (VS (r (Value r)) -> MSStatement r)
-> Maybe (VS (r (Value r))) -> Maybe (MSStatement r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap VS (r (Value r)) -> MSStatement r
forall (r :: * -> *). StatementSym r => SValue r -> MSStatement r
valStmt Maybe (VS (r (Value r)))
val
getCalcCall :: (OOProg r) => CodeDefinition -> GenState (Maybe (MSStatement r))
getCalcCall :: CodeDefinition -> GenState (Maybe (MSStatement r))
getCalcCall c :: CodeDefinition
c = do
CodeType
t <- CodeDefinition -> GenState CodeType
forall c. HasSpace c => c -> GenState CodeType
codeType CodeDefinition
c
Maybe (VS (r (Value r)))
val <- Name
-> VSType r
-> GenState [CodeVarChunk]
-> GenState (Maybe (VS (r (Value r))))
forall (r :: * -> *).
OOProg r =>
Name
-> VSType r
-> GenState [CodeVarChunk]
-> GenState (Maybe (SValue r))
getFuncCall (CodeDefinition -> Name
forall c. CodeIdea c => c -> Name
codeName CodeDefinition
c) (CodeType -> VSType r
forall (r :: * -> *). TypeSym r => CodeType -> VSType r
convType CodeType
t) (CodeDefinition -> GenState [CodeVarChunk]
getCalcParams CodeDefinition
c)
VS (r (Variable r))
v <- CodeVarChunk -> GenState (VS (r (Variable r)))
forall (r :: * -> *).
OOProg r =>
CodeVarChunk -> GenState (SVariable r)
mkVar (CodeVarChunk -> GenState (VS (r (Variable r))))
-> CodeVarChunk -> GenState (VS (r (Variable r)))
forall a b. (a -> b) -> a -> b
$ CodeDefinition -> CodeVarChunk
forall c. (Quantity c, MayHaveUnit c) => c -> CodeVarChunk
quantvar CodeDefinition
c
[MSStatement r]
l <- VS (r (Variable r)) -> GenState [MSStatement r]
forall (r :: * -> *).
OOProg r =>
SVariable r -> GenState [MSStatement r]
maybeLog VS (r (Variable r))
v
Maybe (MSStatement r) -> GenState (Maybe (MSStatement r))
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
$ (VS (r (Value r)) -> MSStatement r)
-> Maybe (VS (r (Value r))) -> Maybe (MSStatement r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([MSStatement r] -> MSStatement r
forall (r :: * -> *).
StatementSym r =>
[MSStatement r] -> MSStatement r
multi ([MSStatement r] -> MSStatement r)
-> (VS (r (Value r)) -> [MSStatement r])
-> VS (r (Value r))
-> MSStatement r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MSStatement r -> [MSStatement r] -> [MSStatement r]
forall a. a -> [a] -> [a]
: [MSStatement r]
l) (MSStatement r -> [MSStatement r])
-> (VS (r (Value r)) -> MSStatement r)
-> VS (r (Value r))
-> [MSStatement r]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VS (r (Variable r)) -> VS (r (Value r)) -> MSStatement r
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 :: GenState (Maybe (MSStatement r))
getOutputCall = do
Maybe (VS (r (Value r)))
val <- Name
-> VSType r
-> GenState [CodeVarChunk]
-> GenState (Maybe (VS (r (Value r))))
forall (r :: * -> *).
OOProg r =>
Name
-> VSType r
-> GenState [CodeVarChunk]
-> GenState (Maybe (SValue r))
getFuncCall "write_output" VSType r
forall (r :: * -> *). TypeSym r => VSType r
void GenState [CodeVarChunk]
getOutputParams
Maybe (MSStatement r) -> GenState (Maybe (MSStatement r))
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
$ (VS (r (Value r)) -> MSStatement r)
-> Maybe (VS (r (Value r))) -> Maybe (MSStatement r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap VS (r (Value r)) -> MSStatement r
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 :: Name
-> VSType r
-> GenState [CodeVarChunk]
-> GenState (Maybe (SValue r))
getFuncCall n :: Name
n t :: VSType r
t funcPs :: GenState [CodeVarChunk]
funcPs = do
Maybe Name
mm <- Name -> GenState (Maybe Name)
getCall Name
n
let getFuncCall' :: Maybe Name -> GenState (Maybe (SValue r))
getFuncCall' Nothing = Maybe (SValue r) -> GenState (Maybe (SValue r))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (SValue r)
forall a. Maybe a
Nothing
getFuncCall' (Just m :: Name
m) = do
[CodeVarChunk]
cs <- GenState [CodeVarChunk]
funcPs
[SValue r]
pvals <- (CodeVarChunk -> StateT DrasilState Identity (SValue r))
-> [CodeVarChunk] -> StateT DrasilState Identity [SValue r]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM CodeVarChunk -> StateT DrasilState Identity (SValue r)
forall (r :: * -> *).
OOProg r =>
CodeVarChunk -> GenState (SValue r)
mkVal [CodeVarChunk]
cs
SValue r
val <- Name
-> Name
-> VSType r
-> [SValue r]
-> NamedArgs r
-> StateT DrasilState Identity (SValue r)
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 []
Maybe (SValue r) -> GenState (Maybe (SValue r))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (SValue r) -> GenState (Maybe (SValue r)))
-> Maybe (SValue r) -> GenState (Maybe (SValue r))
forall a b. (a -> b) -> a -> b
$ SValue r -> Maybe (SValue r)
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 :: Name
-> GenState [CodeVarChunk]
-> GenState [CodeVarChunk]
-> GenState (Maybe (MSStatement r))
getInOutCall n :: Name
n inFunc :: GenState [CodeVarChunk]
inFunc outFunc :: 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' Nothing = Maybe (MS (r (Statement r)))
-> StateT DrasilState Identity (Maybe (MS (r (Statement r))))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MS (r (Statement r)))
forall a. Maybe a
Nothing
getInOutCall' (Just m :: Name
m) = do
[CodeVarChunk]
ins' <- GenState [CodeVarChunk]
inFunc
[CodeVarChunk]
outs' <- GenState [CodeVarChunk]
outFunc
[VS (r (Variable r))]
ins <- (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)
mapM CodeVarChunk -> StateT DrasilState Identity (VS (r (Variable r)))
forall (r :: * -> *).
OOProg r =>
CodeVarChunk -> GenState (SVariable r)
mkVar ([CodeVarChunk]
ins' [CodeVarChunk] -> [CodeVarChunk] -> [CodeVarChunk]
forall a. Eq a => [a] -> [a] -> [a]
\\ [CodeVarChunk]
outs')
[VS (r (Variable r))]
outs <- (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)
mapM CodeVarChunk -> StateT DrasilState Identity (VS (r (Variable r)))
forall (r :: * -> *).
OOProg r =>
CodeVarChunk -> GenState (SVariable r)
mkVar ([CodeVarChunk]
outs' [CodeVarChunk] -> [CodeVarChunk] -> [CodeVarChunk]
forall a. Eq a => [a] -> [a] -> [a]
\\ [CodeVarChunk]
ins')
[VS (r (Variable r))]
both <- (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)
mapM CodeVarChunk -> StateT DrasilState Identity (VS (r (Variable r)))
forall (r :: * -> *).
OOProg r =>
CodeVarChunk -> GenState (SVariable r)
mkVar ([CodeVarChunk]
ins' [CodeVarChunk] -> [CodeVarChunk] -> [CodeVarChunk]
forall a. Eq a => [a] -> [a] -> [a]
`intersect` [CodeVarChunk]
outs')
MS (r (Statement r))
stmt <- Name
-> Name
-> [SValue r]
-> [VS (r (Variable r))]
-> [VS (r (Variable r))]
-> GenState (MS (r (Statement r)))
forall (r :: * -> *).
OOProg r =>
Name
-> Name
-> [SValue r]
-> [SVariable r]
-> [SVariable r]
-> GenState (MSStatement r)
fAppInOut Name
m Name
n ((VS (r (Variable r)) -> SValue r)
-> [VS (r (Variable r))] -> [SValue r]
forall a b. (a -> b) -> [a] -> [b]
map VS (r (Variable r)) -> SValue r
forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
valueOf [VS (r (Variable r))]
ins) [VS (r (Variable r))]
outs [VS (r (Variable r))]
both
Maybe (MS (r (Statement r)))
-> StateT DrasilState Identity (Maybe (MS (r (Statement r))))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MS (r (Statement r)))
-> StateT DrasilState Identity (Maybe (MS (r (Statement r)))))
-> Maybe (MS (r (Statement r)))
-> StateT DrasilState Identity (Maybe (MS (r (Statement r))))
forall a b. (a -> b) -> a -> b
$ MS (r (Statement r)) -> Maybe (MS (r (Statement r)))
forall a. a -> Maybe a
Just MS (r (Statement r))
stmt
Maybe Name -> GenState (Maybe (MSStatement r))
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 n :: Name
n = do
DrasilState
g <- StateT DrasilState Identity DrasilState
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 Nothing = Maybe Name -> m (Maybe Name)
forall (m :: * -> *). Monad m => Maybe Name -> m (Maybe Name)
getCallInClass (Name -> Map Name Name -> Maybe Name
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
n (Map Name Name -> Maybe Name) -> Map Name Name -> Maybe Name
forall a b. (a -> b) -> a -> b
$ DrasilState -> Map Name Name
clsMap DrasilState
g)
getCallExported m :: Maybe Name
m = Maybe Name -> m (Maybe Name)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Name
m
getCallInClass :: Maybe Name -> m (Maybe Name)
getCallInClass Nothing = Maybe Name -> m (Maybe Name)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Name
forall a. Maybe a
Nothing
getCallInClass (Just c :: Name
c) = if Name
c Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
currc then Maybe Name -> m (Maybe Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Name -> m (Maybe Name)) -> Maybe Name -> m (Maybe Name)
forall a b. (a -> b) -> a -> b
$ Name -> Map Name Name -> Maybe Name
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
c (DrasilState -> Map Name Name
eMap
DrasilState
g) Maybe Name -> Maybe Name -> Maybe Name
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Name -> Maybe Name
forall a. HasCallStack => Name -> a
error (Name
c Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ " class missing from export map")
else Maybe Name -> m (Maybe Name)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Name
forall a. Maybe a
Nothing
Maybe Name -> GenState (Maybe Name)
forall (m :: * -> *). Monad m => Maybe Name -> m (Maybe Name)
getCallExported (Maybe Name -> GenState (Maybe Name))
-> Maybe Name -> GenState (Maybe Name)
forall a b. (a -> b) -> a -> b
$ Name -> Map Name Name -> Maybe Name
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
n (DrasilState -> Map Name Name
eMap DrasilState
g)