{-# LANGUAGE GADTs, TemplateHaskell #-}
{-# LANGUAGE InstanceSigs #-}
-- | Defines the CodeSpec structure and related functions.
module Language.Drasil.CodeSpec where

import Language.Drasil hiding (None, new)
import Language.Drasil.Display (Symbol(Variable))
import Database.Drasil
import Drasil.Code.CodeExpr.Development (expr, eNamesRI, eDep)
import qualified Drasil.System as S
import Drasil.System (HasSystem(..))

import Theory.Drasil (DataDefinition, qdEFromDD, getEqModQdsFromIm)

import Language.Drasil.Chunk.ConstraintMap (ConstraintCEMap, ConstraintCE, constraintMap)
import Language.Drasil.Chunk.CodeDefinition (CodeDefinition, qtov, qtoc, odeDef,
  auxExprs)
import Language.Drasil.Choices (Choices(..), Maps(..), ODE(..), ExtLib(..))
import Language.Drasil.Chunk.CodeBase
import Language.Drasil.Mod (Func(..), FuncData(..), FuncDef(..), Mod(..), Name)

import Utils.Drasil (subsetOf)

import Control.Lens ((^.), makeLenses, Lens', makeClassyFor)
import Data.List (intercalate, nub, (\\))
import qualified Data.Map as Map
import Data.Maybe (mapMaybe)

import Prelude hiding (const)

-- | Program input.
type Input = CodeVarChunk
-- | Program output.
type Output = CodeVarChunk
-- | Constants in the problem.
type Const = CodeDefinition
-- | Derived inputs.
type Derived = CodeDefinition
-- | Mathematical definition.
type Def = CodeDefinition
-- | Maps constants to their respective 'CodeDefinition'.
type ConstantMap = Map.Map UID CodeDefinition

-- | Old Code specifications. Holds information needed to generate code.
data OldCodeSpec = OldCodeSpec {
  -- | Program name.
  OldCodeSpec -> Name
_pName :: Name,
  -- | Authors.
  OldCodeSpec -> People
_authors :: People,
  -- | All inputs.
  OldCodeSpec -> [CodeVarChunk]
_inputs :: [Input],
  -- | Explicit inputs (values to be supplied by a file).
  OldCodeSpec -> [CodeVarChunk]
_extInputs :: [Input],
  -- | Derived inputs (each calculated from explicit inputs in a single step).
  OldCodeSpec -> [CodeDefinition]
_derivedInputs :: [Derived],
  -- | All outputs.
  OldCodeSpec -> [CodeVarChunk]
_outputs :: [Output],
  -- | List of files that must be in same directory for running the executable.
  OldCodeSpec -> [Name]
_configFiles :: [FilePath],
  -- | Mathematical definitions, ordered so that they form a path from inputs to
  -- outputs.
  OldCodeSpec -> [CodeDefinition]
_execOrder :: [Def],
  -- | Map from 'UID's to constraints for all constrained chunks used in the problem.
  OldCodeSpec -> ConstraintCEMap
_cMap :: ConstraintCEMap,
  -- | List of all constants used in the problem.
  OldCodeSpec -> [CodeDefinition]
_constants :: [Const],
  -- | Map containing all constants used in the problem.
  OldCodeSpec -> ConstantMap
_constMap :: ConstantMap,
  -- | Additional modules required in the generated code, which Drasil cannot yet
  -- automatically define.
  OldCodeSpec -> [Mod]
_mods :: [Mod],  -- medium hack
  -- | The database of all chunks used in the problem.
  OldCodeSpec -> ChunkDB
_systemdb :: ChunkDB
  }

makeClassyFor "HasOldCodeSpec" "oldCodeSpec"
  [   ("_pName", "pNameO")
    , ("_authors", "authorsO")
    , ("_inputs", "inputsO")
    , ("_extInputs", "extInputsO")
    , ("_derivedInputs", "derivedInputsO")
    , ("_outputs", "outputsO")
    , ("_configFiles", "configFilesO") 
    , ("_execOrder", "execOrderO")
    , ("_cMap", "cMapO")
    , ("_constants", "constantsO")
    , ("_constMap", "constMapO")
    , ("_mods", "modsO")
    , ("_systemdb", "systemdbO")
    ] ''OldCodeSpec

-- | New Code Specification. Holds system information and a reference to `OldCodeSpec`.
data CodeSpec = CS {
  CodeSpec -> System
_system' :: S.System,
  CodeSpec -> OldCodeSpec
_oldCode :: OldCodeSpec
}
makeLenses ''CodeSpec

instance HasSystem CodeSpec where
  system :: Lens' CodeSpec S.System
  system :: Lens' CodeSpec System
system = (System -> f System) -> CodeSpec -> f CodeSpec
Lens' CodeSpec System
system'
  background :: Lens' CodeSpec S.Background
  background :: Lens' CodeSpec Background
background = (System -> f System) -> CodeSpec -> f CodeSpec
forall c. HasSystem c => Lens' c System
Lens' CodeSpec System
system ((System -> f System) -> CodeSpec -> f CodeSpec)
-> ((Background -> f Background) -> System -> f System)
-> (Background -> f Background)
-> CodeSpec
-> f CodeSpec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Background -> f Background) -> System -> f System
forall c. HasSystem c => Lens' c Background
Lens' System Background
S.background
  purpose :: Lens' CodeSpec S.Purpose
  purpose :: Lens' CodeSpec Background
purpose = (System -> f System) -> CodeSpec -> f CodeSpec
forall c. HasSystem c => Lens' c System
Lens' CodeSpec System
system ((System -> f System) -> CodeSpec -> f CodeSpec)
-> ((Background -> f Background) -> System -> f System)
-> (Background -> f Background)
-> CodeSpec
-> f CodeSpec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Background -> f Background) -> System -> f System
forall c. HasSystem c => Lens' c Background
Lens' System Background
S.purpose
  scope :: Lens' CodeSpec S.Scope
  scope :: Lens' CodeSpec Background
scope = (System -> f System) -> CodeSpec -> f CodeSpec
forall c. HasSystem c => Lens' c System
Lens' CodeSpec System
system ((System -> f System) -> CodeSpec -> f CodeSpec)
-> ((Background -> f Background) -> System -> f System)
-> (Background -> f Background)
-> CodeSpec
-> f CodeSpec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Background -> f Background) -> System -> f System
forall c. HasSystem c => Lens' c Background
Lens' System Background
S.scope
  motivation :: Lens' CodeSpec S.Motivation
  motivation :: Lens' CodeSpec Background
motivation = (System -> f System) -> CodeSpec -> f CodeSpec
forall c. HasSystem c => Lens' c System
Lens' CodeSpec System
system ((System -> f System) -> CodeSpec -> f CodeSpec)
-> ((Background -> f Background) -> System -> f System)
-> (Background -> f Background)
-> CodeSpec
-> f CodeSpec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Background -> f Background) -> System -> f System
forall c. HasSystem c => Lens' c Background
Lens' System Background
S.motivation

instance HasOldCodeSpec CodeSpec where
  oldCodeSpec :: Lens' CodeSpec OldCodeSpec
  oldCodeSpec :: Lens' CodeSpec OldCodeSpec
oldCodeSpec = (OldCodeSpec -> f OldCodeSpec) -> CodeSpec -> f CodeSpec
Lens' CodeSpec OldCodeSpec
oldCode

  pNameO :: Lens' CodeSpec Name
  pNameO :: Lens' CodeSpec Name
pNameO = (OldCodeSpec -> f OldCodeSpec) -> CodeSpec -> f CodeSpec
Lens' CodeSpec OldCodeSpec
oldCode ((OldCodeSpec -> f OldCodeSpec) -> CodeSpec -> f CodeSpec)
-> ((Name -> f Name) -> OldCodeSpec -> f OldCodeSpec)
-> (Name -> f Name)
-> CodeSpec
-> f CodeSpec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name -> f Name) -> OldCodeSpec -> f OldCodeSpec
forall c. HasOldCodeSpec c => Lens' c Name
Lens' OldCodeSpec Name
pNameO

  authorsO :: Lens' CodeSpec People
  authorsO :: Lens' CodeSpec People
authorsO = (OldCodeSpec -> f OldCodeSpec) -> CodeSpec -> f CodeSpec
Lens' CodeSpec OldCodeSpec
oldCode ((OldCodeSpec -> f OldCodeSpec) -> CodeSpec -> f CodeSpec)
-> ((People -> f People) -> OldCodeSpec -> f OldCodeSpec)
-> (People -> f People)
-> CodeSpec
-> f CodeSpec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (People -> f People) -> OldCodeSpec -> f OldCodeSpec
forall c. HasOldCodeSpec c => Lens' c People
Lens' OldCodeSpec People
authorsO

  inputsO :: Lens' CodeSpec [Input]
  inputsO :: Lens' CodeSpec [CodeVarChunk]
inputsO = (OldCodeSpec -> f OldCodeSpec) -> CodeSpec -> f CodeSpec
Lens' CodeSpec OldCodeSpec
oldCode ((OldCodeSpec -> f OldCodeSpec) -> CodeSpec -> f CodeSpec)
-> (([CodeVarChunk] -> f [CodeVarChunk])
    -> OldCodeSpec -> f OldCodeSpec)
-> ([CodeVarChunk] -> f [CodeVarChunk])
-> CodeSpec
-> f CodeSpec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([CodeVarChunk] -> f [CodeVarChunk])
-> OldCodeSpec -> f OldCodeSpec
forall c. HasOldCodeSpec c => Lens' c [CodeVarChunk]
Lens' OldCodeSpec [CodeVarChunk]
inputsO

  extInputsO :: Lens' CodeSpec [Input]
  extInputsO :: Lens' CodeSpec [CodeVarChunk]
extInputsO = (OldCodeSpec -> f OldCodeSpec) -> CodeSpec -> f CodeSpec
Lens' CodeSpec OldCodeSpec
oldCode ((OldCodeSpec -> f OldCodeSpec) -> CodeSpec -> f CodeSpec)
-> (([CodeVarChunk] -> f [CodeVarChunk])
    -> OldCodeSpec -> f OldCodeSpec)
-> ([CodeVarChunk] -> f [CodeVarChunk])
-> CodeSpec
-> f CodeSpec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([CodeVarChunk] -> f [CodeVarChunk])
-> OldCodeSpec -> f OldCodeSpec
forall c. HasOldCodeSpec c => Lens' c [CodeVarChunk]
Lens' OldCodeSpec [CodeVarChunk]
extInputsO

  derivedInputsO :: Lens' CodeSpec [Derived]
  derivedInputsO :: Lens' CodeSpec [CodeDefinition]
derivedInputsO = (OldCodeSpec -> f OldCodeSpec) -> CodeSpec -> f CodeSpec
Lens' CodeSpec OldCodeSpec
oldCode ((OldCodeSpec -> f OldCodeSpec) -> CodeSpec -> f CodeSpec)
-> (([CodeDefinition] -> f [CodeDefinition])
    -> OldCodeSpec -> f OldCodeSpec)
-> ([CodeDefinition] -> f [CodeDefinition])
-> CodeSpec
-> f CodeSpec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([CodeDefinition] -> f [CodeDefinition])
-> OldCodeSpec -> f OldCodeSpec
forall c. HasOldCodeSpec c => Lens' c [CodeDefinition]
Lens' OldCodeSpec [CodeDefinition]
derivedInputsO

  outputsO :: Lens' CodeSpec [Output]
  outputsO :: Lens' CodeSpec [CodeVarChunk]
outputsO = (OldCodeSpec -> f OldCodeSpec) -> CodeSpec -> f CodeSpec
Lens' CodeSpec OldCodeSpec
oldCode ((OldCodeSpec -> f OldCodeSpec) -> CodeSpec -> f CodeSpec)
-> (([CodeVarChunk] -> f [CodeVarChunk])
    -> OldCodeSpec -> f OldCodeSpec)
-> ([CodeVarChunk] -> f [CodeVarChunk])
-> CodeSpec
-> f CodeSpec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([CodeVarChunk] -> f [CodeVarChunk])
-> OldCodeSpec -> f OldCodeSpec
forall c. HasOldCodeSpec c => Lens' c [CodeVarChunk]
Lens' OldCodeSpec [CodeVarChunk]
outputsO

  configFilesO :: Lens' CodeSpec [FilePath]
  configFilesO :: Lens' CodeSpec [Name]
configFilesO = (OldCodeSpec -> f OldCodeSpec) -> CodeSpec -> f CodeSpec
Lens' CodeSpec OldCodeSpec
oldCode ((OldCodeSpec -> f OldCodeSpec) -> CodeSpec -> f CodeSpec)
-> (([Name] -> f [Name]) -> OldCodeSpec -> f OldCodeSpec)
-> ([Name] -> f [Name])
-> CodeSpec
-> f CodeSpec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Name] -> f [Name]) -> OldCodeSpec -> f OldCodeSpec
forall c. HasOldCodeSpec c => Lens' c [Name]
Lens' OldCodeSpec [Name]
configFilesO

  execOrderO :: Lens' CodeSpec [Def]
  execOrderO :: Lens' CodeSpec [CodeDefinition]
execOrderO = (OldCodeSpec -> f OldCodeSpec) -> CodeSpec -> f CodeSpec
Lens' CodeSpec OldCodeSpec
oldCode ((OldCodeSpec -> f OldCodeSpec) -> CodeSpec -> f CodeSpec)
-> (([CodeDefinition] -> f [CodeDefinition])
    -> OldCodeSpec -> f OldCodeSpec)
-> ([CodeDefinition] -> f [CodeDefinition])
-> CodeSpec
-> f CodeSpec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([CodeDefinition] -> f [CodeDefinition])
-> OldCodeSpec -> f OldCodeSpec
forall c. HasOldCodeSpec c => Lens' c [CodeDefinition]
Lens' OldCodeSpec [CodeDefinition]
execOrderO

  cMapO :: Lens' CodeSpec ConstraintCEMap
  cMapO :: Lens' CodeSpec ConstraintCEMap
cMapO = (OldCodeSpec -> f OldCodeSpec) -> CodeSpec -> f CodeSpec
Lens' CodeSpec OldCodeSpec
oldCode ((OldCodeSpec -> f OldCodeSpec) -> CodeSpec -> f CodeSpec)
-> ((ConstraintCEMap -> f ConstraintCEMap)
    -> OldCodeSpec -> f OldCodeSpec)
-> (ConstraintCEMap -> f ConstraintCEMap)
-> CodeSpec
-> f CodeSpec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ConstraintCEMap -> f ConstraintCEMap)
-> OldCodeSpec -> f OldCodeSpec
forall c. HasOldCodeSpec c => Lens' c ConstraintCEMap
Lens' OldCodeSpec ConstraintCEMap
cMapO

  constantsO :: Lens' CodeSpec [Const]
  constantsO :: Lens' CodeSpec [CodeDefinition]
constantsO = (OldCodeSpec -> f OldCodeSpec) -> CodeSpec -> f CodeSpec
Lens' CodeSpec OldCodeSpec
oldCode ((OldCodeSpec -> f OldCodeSpec) -> CodeSpec -> f CodeSpec)
-> (([CodeDefinition] -> f [CodeDefinition])
    -> OldCodeSpec -> f OldCodeSpec)
-> ([CodeDefinition] -> f [CodeDefinition])
-> CodeSpec
-> f CodeSpec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([CodeDefinition] -> f [CodeDefinition])
-> OldCodeSpec -> f OldCodeSpec
forall c. HasOldCodeSpec c => Lens' c [CodeDefinition]
Lens' OldCodeSpec [CodeDefinition]
constantsO

  constMapO :: Lens' CodeSpec ConstantMap
  constMapO :: Lens' CodeSpec ConstantMap
constMapO = (OldCodeSpec -> f OldCodeSpec) -> CodeSpec -> f CodeSpec
Lens' CodeSpec OldCodeSpec
oldCode ((OldCodeSpec -> f OldCodeSpec) -> CodeSpec -> f CodeSpec)
-> ((ConstantMap -> f ConstantMap) -> OldCodeSpec -> f OldCodeSpec)
-> (ConstantMap -> f ConstantMap)
-> CodeSpec
-> f CodeSpec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ConstantMap -> f ConstantMap) -> OldCodeSpec -> f OldCodeSpec
forall c. HasOldCodeSpec c => Lens' c ConstantMap
Lens' OldCodeSpec ConstantMap
constMapO

  modsO :: Lens' CodeSpec [Mod]
  modsO :: Lens' CodeSpec [Mod]
modsO = (OldCodeSpec -> f OldCodeSpec) -> CodeSpec -> f CodeSpec
Lens' CodeSpec OldCodeSpec
oldCode ((OldCodeSpec -> f OldCodeSpec) -> CodeSpec -> f CodeSpec)
-> (([Mod] -> f [Mod]) -> OldCodeSpec -> f OldCodeSpec)
-> ([Mod] -> f [Mod])
-> CodeSpec
-> f CodeSpec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Mod] -> f [Mod]) -> OldCodeSpec -> f OldCodeSpec
forall c. HasOldCodeSpec c => Lens' c [Mod]
Lens' OldCodeSpec [Mod]
modsO

  systemdbO :: Lens' CodeSpec ChunkDB
  systemdbO :: Lens' CodeSpec ChunkDB
systemdbO = (OldCodeSpec -> f OldCodeSpec) -> CodeSpec -> f CodeSpec
Lens' CodeSpec OldCodeSpec
oldCode ((OldCodeSpec -> f OldCodeSpec) -> CodeSpec -> f CodeSpec)
-> ((ChunkDB -> f ChunkDB) -> OldCodeSpec -> f OldCodeSpec)
-> (ChunkDB -> f ChunkDB)
-> CodeSpec
-> f CodeSpec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ChunkDB -> f ChunkDB) -> OldCodeSpec -> f OldCodeSpec
forall c. HasOldCodeSpec c => Lens' c ChunkDB
Lens' OldCodeSpec ChunkDB
systemdbO

-- | Converts a list of chunks that have 'UID's to a Map from 'UID' to the associated chunk.
assocToMap :: HasUID a => [a] -> Map.Map UID a
assocToMap :: forall a. HasUID a => [a] -> Map UID a
assocToMap = [(UID, a)] -> Map UID a
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(UID, a)] -> Map UID a)
-> ([a] -> [(UID, a)]) -> [a] -> Map UID a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> (UID, a)) -> [a] -> [(UID, a)]
forall a b. (a -> b) -> [a] -> [b]
map (\a
x -> (a
x a -> Getting UID a UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID a UID
forall c. HasUID c => Getter c UID
Getter a UID
uid, a
x))

-- | Get ODE from ExtLib
getODE :: [ExtLib] -> Maybe ODE
getODE :: [ExtLib] -> Maybe ODE
getODE [] = Maybe ODE
forall a. Maybe a
Nothing
getODE (Math ODE
ode: [ExtLib]
_) = ODE -> Maybe ODE
forall a. a -> Maybe a
Just ODE
ode
-- getODE (_:xs) = getODE xs

-- | Maps ODE to their respective 'CodeDefinition'.
mapODE :: Maybe ODE -> [CodeDefinition]
mapODE :: Maybe ODE -> [CodeDefinition]
mapODE Maybe ODE
Nothing = []
mapODE (Just ODE
ode) = (ODEInfo -> CodeDefinition) -> [ODEInfo] -> [CodeDefinition]
forall a b. (a -> b) -> [a] -> [b]
map ODEInfo -> CodeDefinition
odeDef ([ODEInfo] -> [CodeDefinition]) -> [ODEInfo] -> [CodeDefinition]
forall a b. (a -> b) -> a -> b
$ ODE -> [ODEInfo]
odeInfo ODE
ode

-- | Creates a 'CodeSpec' using the provided 'System', 'Choices', and 'Mod's.
-- The 'CodeSpec' consists of the system information and a corresponding 'OldCodeSpec'.
codeSpec :: S.System -> Choices -> [Mod] -> CodeSpec
codeSpec :: System -> Choices -> [Mod] -> CodeSpec
codeSpec System
si Choices
chs [Mod]
ms = CS {
  _system' :: System
_system' = System
si,
  _oldCode :: OldCodeSpec
_oldCode = System -> Choices -> [Mod] -> OldCodeSpec
oldcodeSpec System
si Choices
chs [Mod]
ms
}

-- | Generates an 'OldCodeSpec' from 'System', 'Choices', and a list of 'Mod's.
-- This function extracts various components (e.g., inputs, outputs, constraints, etc.)
-- from 'System' to populate the 'OldCodeSpec' structure.
oldcodeSpec :: S.System -> Choices -> [Mod] -> OldCodeSpec
oldcodeSpec :: System -> Choices -> [Mod] -> OldCodeSpec
oldcodeSpec sys :: System
sys@S.SI{ _sys :: ()
S._sys = a
sysIdea
                 , _authors :: System -> People
S._authors = People
as
                 , _configFiles :: System -> [Name]
S._configFiles = [Name]
cfp
                 , _inputs :: ()
S._inputs = [h]
ins
                 , _outputs :: ()
S._outputs = [i]
outs
                 , _constraints :: ()
S._constraints = [j]
cs
                 , _constants :: System -> [ConstQDef]
S._constants = [ConstQDef]
cnsts
                 , _systemdb :: System -> ChunkDB
S._systemdb = ChunkDB
db } Choices
chs [Mod]
ms =
  let ddefs :: [DataDefinition]
ddefs = System
sys System
-> Getting [DataDefinition] System [DataDefinition]
-> [DataDefinition]
forall s a. s -> Getting a s a -> a
^. Getting [DataDefinition] System [DataDefinition]
forall c. HasSystem c => Lens' c [DataDefinition]
Lens' System [DataDefinition]
dataDefns
      n :: Name
n = a -> Name
forall c. CommonIdea c => c -> Name
programName a
sysIdea
      inputs' :: [CodeVarChunk]
inputs' = (h -> CodeVarChunk) -> [h] -> [CodeVarChunk]
forall a b. (a -> b) -> [a] -> [b]
map h -> CodeVarChunk
forall c.
(Quantity c, MayHaveUnit c, Concept c) =>
c -> CodeVarChunk
quantvar [h]
ins
      const' :: [CodeDefinition]
const' = (ConstQDef -> CodeDefinition) -> [ConstQDef] -> [CodeDefinition]
forall a b. (a -> b) -> [a] -> [b]
map ConstQDef -> CodeDefinition
forall e. CanGenCode e => QDefinition e -> CodeDefinition
qtov ((ConstQDef -> Bool) -> [ConstQDef] -> [ConstQDef]
forall a. (a -> Bool) -> [a] -> [a]
filter ((UID -> Map UID [CodeConcept] -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`Map.notMember` Maps -> Map UID [CodeConcept]
conceptMatch (Choices -> Maps
maps Choices
chs)) (UID -> Bool) -> (ConstQDef -> UID) -> ConstQDef -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ConstQDef -> Getting UID ConstQDef UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID ConstQDef UID
forall c. HasUID c => Getter c UID
Getter ConstQDef UID
uid))
        [ConstQDef]
cnsts)
      derived :: [CodeDefinition]
derived = (QDefinition Expr -> CodeDefinition)
-> [QDefinition Expr] -> [CodeDefinition]
forall a b. (a -> b) -> [a] -> [b]
map QDefinition Expr -> CodeDefinition
forall e. CanGenCode e => QDefinition e -> CodeDefinition
qtov ([QDefinition Expr] -> [CodeDefinition])
-> [QDefinition Expr] -> [CodeDefinition]
forall a b. (a -> b) -> a -> b
$ [DataDefinition]
-> [CodeVarChunk]
-> [CodeDefinition]
-> ChunkDB
-> [QDefinition Expr]
getDerivedInputs [DataDefinition]
ddefs [CodeVarChunk]
inputs' [CodeDefinition]
const' ChunkDB
db
      rels :: [CodeDefinition]
rels = ((QDefinition Expr -> CodeDefinition)
-> [QDefinition Expr] -> [CodeDefinition]
forall a b. (a -> b) -> [a] -> [b]
map QDefinition Expr -> CodeDefinition
forall (q :: * -> *).
(Quantity (q Expr), MayHaveUnit (q Expr), DefiningExpr q,
 Concept (q Expr)) =>
q Expr -> CodeDefinition
qtoc ([InstanceModel] -> [QDefinition Expr]
getEqModQdsFromIm (System
sys System
-> Getting [InstanceModel] System [InstanceModel]
-> [InstanceModel]
forall s a. s -> Getting a s a -> a
^. Getting [InstanceModel] System [InstanceModel]
forall c. HasSystem c => Lens' c [InstanceModel]
Lens' System [InstanceModel]
instModels) [QDefinition Expr] -> [QDefinition Expr] -> [QDefinition Expr]
forall a. [a] -> [a] -> [a]
++ (DataDefinition -> Maybe (QDefinition Expr))
-> [DataDefinition] -> [QDefinition Expr]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe DataDefinition -> Maybe (QDefinition Expr)
qdEFromDD [DataDefinition]
ddefs) [CodeDefinition] -> [CodeDefinition] -> [CodeDefinition]
forall a. Eq a => [a] -> [a] -> [a]
\\ [CodeDefinition]
derived)
        [CodeDefinition] -> [CodeDefinition] -> [CodeDefinition]
forall a. [a] -> [a] -> [a]
++ Maybe ODE -> [CodeDefinition]
mapODE ([ExtLib] -> Maybe ODE
getODE ([ExtLib] -> Maybe ODE) -> [ExtLib] -> Maybe ODE
forall a b. (a -> b) -> a -> b
$ Choices -> [ExtLib]
extLibs Choices
chs)
      -- TODO: When we have better DEModels, we should be deriving our ODE information
      --       directly from the instance models (ims) instead of directly from the choices.
      outs' :: [CodeVarChunk]
outs' = (i -> CodeVarChunk) -> [i] -> [CodeVarChunk]
forall a b. (a -> b) -> [a] -> [b]
map i -> CodeVarChunk
forall c.
(Quantity c, MayHaveUnit c, Concept c) =>
c -> CodeVarChunk
quantvar [i]
outs
      allInputs :: [CodeVarChunk]
allInputs = [CodeVarChunk] -> [CodeVarChunk]
forall a. Eq a => [a] -> [a]
nub ([CodeVarChunk] -> [CodeVarChunk])
-> [CodeVarChunk] -> [CodeVarChunk]
forall a b. (a -> b) -> a -> b
$ [CodeVarChunk]
inputs' [CodeVarChunk] -> [CodeVarChunk] -> [CodeVarChunk]
forall a. [a] -> [a] -> [a]
++ (CodeDefinition -> CodeVarChunk)
-> [CodeDefinition] -> [CodeVarChunk]
forall a b. (a -> b) -> [a] -> [b]
map CodeDefinition -> CodeVarChunk
forall c.
(Quantity c, MayHaveUnit c, Concept c) =>
c -> CodeVarChunk
quantvar [CodeDefinition]
derived
      exOrder :: [CodeDefinition]
exOrder = [CodeDefinition]
-> [CodeVarChunk] -> [CodeVarChunk] -> ChunkDB -> [CodeDefinition]
getExecOrder [CodeDefinition]
rels ([CodeVarChunk]
allInputs [CodeVarChunk] -> [CodeVarChunk] -> [CodeVarChunk]
forall a. [a] -> [a] -> [a]
++ (ConstQDef -> CodeVarChunk) -> [ConstQDef] -> [CodeVarChunk]
forall a b. (a -> b) -> [a] -> [b]
map ConstQDef -> CodeVarChunk
forall c.
(Quantity c, MayHaveUnit c, Concept c) =>
c -> CodeVarChunk
quantvar [ConstQDef]
cnsts) [CodeVarChunk]
outs' ChunkDB
db
  in OldCodeSpec {
        _pName :: Name
_pName = Name
n,
        _authors :: People
_authors = People
as,
        _inputs :: [CodeVarChunk]
_inputs = [CodeVarChunk]
allInputs,
        _extInputs :: [CodeVarChunk]
_extInputs = [CodeVarChunk]
inputs',
        _derivedInputs :: [CodeDefinition]
_derivedInputs = [CodeDefinition]
derived,
        _outputs :: [CodeVarChunk]
_outputs = [CodeVarChunk]
outs',
        _configFiles :: [Name]
_configFiles = [Name]
cfp,
        _execOrder :: [CodeDefinition]
_execOrder = [CodeDefinition]
exOrder,
        _cMap :: ConstraintCEMap
_cMap = [j] -> ConstraintCEMap
forall c. (HasUID c, Constrained c) => [c] -> ConstraintCEMap
constraintMap [j]
cs,
        _constants :: [CodeDefinition]
_constants = [CodeDefinition]
const',
        _constMap :: ConstantMap
_constMap = [CodeDefinition] -> ConstantMap
forall a. HasUID a => [a] -> Map UID a
assocToMap [CodeDefinition]
const',
        _mods :: [Mod]
_mods = [Mod]
ms,
        _systemdb :: ChunkDB
_systemdb = ChunkDB
db
      } 


-- medium hacks ---

-- | Convert a 'Func' to an implementation-stage 'DefinedQuantityDict' representing the
-- function.
asVC :: Func -> DefinedQuantityDict
asVC :: Func -> DefinedQuantityDict
asVC (FDef (FuncDef Name
n Name
d [ParameterChunk]
_ Space
_ Maybe Name
_ [FuncStmt]
_)) = ConceptChunk -> Symbol -> Space -> DefinedQuantityDict
dqdNoUnit (Name -> NP -> Name -> ConceptChunk
dcc Name
n (Name -> NP
nounPhraseSP Name
n) Name
d) (Name -> Symbol
Variable Name
n) Space
Real
asVC (FDef (CtorDef Name
n Name
d [ParameterChunk]
_ [Initializer]
_ [FuncStmt]
_))   = ConceptChunk -> Symbol -> Space -> DefinedQuantityDict
dqdNoUnit (Name -> NP -> Name -> ConceptChunk
dcc Name
n (Name -> NP
nounPhraseSP Name
n) Name
d) (Name -> Symbol
Variable Name
n) Space
Real
asVC (FData (FuncData Name
n Name
d DataDesc
_))     = ConceptChunk -> Symbol -> Space -> DefinedQuantityDict
dqdNoUnit (Name -> NP -> Name -> ConceptChunk
dcc Name
n (Name -> NP
nounPhraseSP Name
n) Name
d) (Name -> Symbol
Variable Name
n) Space
Real

-- | Get a 'UID' of a chunk corresponding to a 'Func'.
funcUID :: Func -> UID
funcUID :: Func -> UID
funcUID Func
f = Func -> DefinedQuantityDict
asVC Func
f DefinedQuantityDict -> Getting UID DefinedQuantityDict UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID DefinedQuantityDict UID
forall c. HasUID c => Getter c UID
Getter DefinedQuantityDict UID
uid

-- | Determines the derived inputs, which can be immediately calculated from the
-- knowns (inputs and constants). If there are DDs, the derived inputs will
-- come from those. If there are none, then the 'QDefinition's are used instead.
getDerivedInputs :: [DataDefinition] -> [Input] -> [Const] ->
  ChunkDB -> [SimpleQDef]
getDerivedInputs :: [DataDefinition]
-> [CodeVarChunk]
-> [CodeDefinition]
-> ChunkDB
-> [QDefinition Expr]
getDerivedInputs [DataDefinition]
ddefs [CodeVarChunk]
ins [CodeDefinition]
cnsts ChunkDB
sm =
  (QDefinition Expr -> Bool)
-> [QDefinition Expr] -> [QDefinition Expr]
forall a. (a -> Bool) -> [a] -> [a]
filter (([CodeVarChunk] -> [CodeVarChunk] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`subsetOf` [CodeVarChunk]
refSet) ([CodeVarChunk] -> Bool)
-> (QDefinition Expr -> [CodeVarChunk]) -> QDefinition Expr -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CodeExpr -> ChunkDB -> [CodeVarChunk])
-> ChunkDB -> CodeExpr -> [CodeVarChunk]
forall a b c. (a -> b -> c) -> b -> a -> c
flip CodeExpr -> ChunkDB -> [CodeVarChunk]
codevars ChunkDB
sm (CodeExpr -> [CodeVarChunk])
-> (QDefinition Expr -> CodeExpr)
-> QDefinition Expr
-> [CodeVarChunk]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> CodeExpr
expr (Expr -> CodeExpr)
-> (QDefinition Expr -> Expr) -> QDefinition Expr -> CodeExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (QDefinition Expr -> Getting Expr (QDefinition Expr) Expr -> Expr
forall s a. s -> Getting a s a -> a
^. Getting Expr (QDefinition Expr) Expr
forall e. Lens' (QDefinition e) e
forall (c :: * -> *) e. DefiningExpr c => Lens' (c e) e
defnExpr)) ((DataDefinition -> Maybe (QDefinition Expr))
-> [DataDefinition] -> [QDefinition Expr]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe DataDefinition -> Maybe (QDefinition Expr)
qdEFromDD [DataDefinition]
ddefs)
  where refSet :: [CodeVarChunk]
refSet = [CodeVarChunk]
ins [CodeVarChunk] -> [CodeVarChunk] -> [CodeVarChunk]
forall a. [a] -> [a] -> [a]
++ (CodeDefinition -> CodeVarChunk)
-> [CodeDefinition] -> [CodeVarChunk]
forall a b. (a -> b) -> [a] -> [b]
map CodeDefinition -> CodeVarChunk
forall c.
(Quantity c, MayHaveUnit c, Concept c) =>
c -> CodeVarChunk
quantvar [CodeDefinition]
cnsts

-- | Known values.
type Known = CodeVarChunk
-- | Calculated values.
type Need  = CodeVarChunk

-- | Orders a list of definitions such that they form a path between 'Known' values
-- and values that 'Need' to be calculated.
getExecOrder :: [Def] -> [Known] -> [Need] -> ChunkDB -> [Def]
getExecOrder :: [CodeDefinition]
-> [CodeVarChunk] -> [CodeVarChunk] -> ChunkDB -> [CodeDefinition]
getExecOrder [CodeDefinition]
d [CodeVarChunk]
k' [CodeVarChunk]
n' ChunkDB
sm  = [CodeDefinition]
-> [CodeDefinition]
-> [CodeVarChunk]
-> [CodeVarChunk]
-> [CodeDefinition]
getExecOrder' [] [CodeDefinition]
d [CodeVarChunk]
k' ([CodeVarChunk]
n' [CodeVarChunk] -> [CodeVarChunk] -> [CodeVarChunk]
forall a. Eq a => [a] -> [a] -> [a]
\\ [CodeVarChunk]
k')
  where getExecOrder' :: [CodeDefinition]
-> [CodeDefinition]
-> [CodeVarChunk]
-> [CodeVarChunk]
-> [CodeDefinition]
getExecOrder' [CodeDefinition]
ord [CodeDefinition]
_ [CodeVarChunk]
_ []   = [CodeDefinition]
ord
        getExecOrder' [CodeDefinition]
ord [CodeDefinition]
defs' [CodeVarChunk]
k [CodeVarChunk]
n =
          let new :: [CodeDefinition]
new  = (CodeDefinition -> Bool) -> [CodeDefinition] -> [CodeDefinition]
forall a. (a -> Bool) -> [a] -> [a]
filter (\CodeDefinition
def -> ([CodeVarChunk] -> [CodeVarChunk] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`subsetOf` [CodeVarChunk]
k) ((CodeExpr -> [CodeVarChunk]) -> [CodeExpr] -> [CodeVarChunk]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (CodeExpr -> ChunkDB -> [CodeVarChunk]
`codevars'` ChunkDB
sm)
                (CodeDefinition
def 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 CodeExpr -> [CodeExpr] -> [CodeExpr]
forall a. a -> [a] -> [a]
: CodeDefinition
def CodeDefinition
-> Getting [CodeExpr] CodeDefinition [CodeExpr] -> [CodeExpr]
forall s a. s -> Getting a s a -> a
^. Getting [CodeExpr] CodeDefinition [CodeExpr]
Lens' CodeDefinition [CodeExpr]
auxExprs) [CodeVarChunk] -> [CodeVarChunk] -> [CodeVarChunk]
forall a. Eq a => [a] -> [a] -> [a]
\\ [CodeDefinition -> CodeVarChunk
forall c.
(Quantity c, MayHaveUnit c, Concept c) =>
c -> CodeVarChunk
quantvar CodeDefinition
def])) [CodeDefinition]
defs'
              cnew :: [CodeVarChunk]
cnew = (CodeDefinition -> CodeVarChunk)
-> [CodeDefinition] -> [CodeVarChunk]
forall a b. (a -> b) -> [a] -> [b]
map CodeDefinition -> CodeVarChunk
forall c.
(Quantity c, MayHaveUnit c, Concept c) =>
c -> CodeVarChunk
quantvar [CodeDefinition]
new
              kNew :: [CodeVarChunk]
kNew = [CodeVarChunk]
k [CodeVarChunk] -> [CodeVarChunk] -> [CodeVarChunk]
forall a. [a] -> [a] -> [a]
++ [CodeVarChunk]
cnew
              nNew :: [CodeVarChunk]
nNew = [CodeVarChunk]
n [CodeVarChunk] -> [CodeVarChunk] -> [CodeVarChunk]
forall a. Eq a => [a] -> [a] -> [a]
\\ [CodeVarChunk]
cnew
          in  if [CodeDefinition] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [CodeDefinition]
new
              then Name -> [CodeDefinition]
forall a. HasCallStack => Name -> a
error (Name
"The following outputs cannot be computed: " Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++
                       Name -> [Name] -> Name
forall a. [a] -> [[a]] -> [a]
intercalate Name
", " ((CodeVarChunk -> Name) -> [CodeVarChunk] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map CodeVarChunk -> Name
forall a. HasUID a => a -> Name
showUID [CodeVarChunk]
n) Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Name
"\n"
                     Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Name
"Unused definitions are: "
                       Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Name -> [Name] -> Name
forall a. [a] -> [[a]] -> [a]
intercalate Name
", " ((CodeDefinition -> Name) -> [CodeDefinition] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map CodeDefinition -> Name
forall a. HasUID a => a -> Name
showUID [CodeDefinition]
defs') Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Name
"\n"
                     Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Name
"Known values are: "
                       Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Name -> [Name] -> Name
forall a. [a] -> [[a]] -> [a]
intercalate Name
", " ((CodeVarChunk -> Name) -> [CodeVarChunk] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map CodeVarChunk -> Name
forall a. HasUID a => a -> Name
showUID [CodeVarChunk]
k))
              else [CodeDefinition]
-> [CodeDefinition]
-> [CodeVarChunk]
-> [CodeVarChunk]
-> [CodeDefinition]
getExecOrder' ([CodeDefinition]
ord [CodeDefinition] -> [CodeDefinition] -> [CodeDefinition]
forall a. [a] -> [a] -> [a]
++ [CodeDefinition]
new) ([CodeDefinition]
defs' [CodeDefinition] -> [CodeDefinition] -> [CodeDefinition]
forall a. Eq a => [a] -> [a] -> [a]
\\ [CodeDefinition]
new) [CodeVarChunk]
kNew [CodeVarChunk]
nNew


-- | Get a list of 'Constraint's for a list of 'CodeChunk's.
getConstraints :: (HasUID c) => ConstraintCEMap -> [c] -> [ConstraintCE]
getConstraints :: forall c. HasUID c => ConstraintCEMap -> [c] -> [ConstraintCE]
getConstraints ConstraintCEMap
cm [c]
cs = [[ConstraintCE]] -> [ConstraintCE]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[ConstraintCE]] -> [ConstraintCE])
-> [[ConstraintCE]] -> [ConstraintCE]
forall a b. (a -> b) -> a -> b
$ (c -> Maybe [ConstraintCE]) -> [c] -> [[ConstraintCE]]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\c
c -> UID -> ConstraintCEMap -> Maybe [ConstraintCE]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (c
c c -> Getting UID c UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID c UID
forall c. HasUID c => Getter c UID
Getter c UID
uid) ConstraintCEMap
cm) [c]
cs

-- | Get a list of 'CodeChunk's from a constraint.
constraintvars :: ConstraintCE -> ChunkDB -> [CodeChunk]
constraintvars :: ConstraintCE -> ChunkDB -> [CodeChunk]
constraintvars (Range ConstraintReason
_ RealInterval CodeExpr CodeExpr
ri) ChunkDB
m =
  (UID -> CodeChunk) -> [UID] -> [CodeChunk]
forall a b. (a -> b) -> [a] -> [b]
map (CodeVarChunk -> CodeChunk
forall c. CodeIdea c => c -> CodeChunk
codeChunk (CodeVarChunk -> CodeChunk)
-> (UID -> CodeVarChunk) -> UID -> CodeChunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChunkDB -> UID -> CodeVarChunk
varResolve ChunkDB
m) ([UID] -> [CodeChunk]) -> [UID] -> [CodeChunk]
forall a b. (a -> b) -> a -> b
$ [UID] -> [UID]
forall a. Eq a => [a] -> [a]
nub ([UID] -> [UID]) -> [UID] -> [UID]
forall a b. (a -> b) -> a -> b
$ RealInterval CodeExpr CodeExpr -> [UID]
eNamesRI RealInterval CodeExpr CodeExpr
ri
constraintvars (Elem ConstraintReason
_ CodeExpr
ri) ChunkDB
m =
  (UID -> CodeChunk) -> [UID] -> [CodeChunk]
forall a b. (a -> b) -> [a] -> [b]
map (CodeVarChunk -> CodeChunk
forall c. CodeIdea c => c -> CodeChunk
codeChunk (CodeVarChunk -> CodeChunk)
-> (UID -> CodeVarChunk) -> UID -> CodeChunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChunkDB -> UID -> CodeVarChunk
varResolve ChunkDB
m) ([UID] -> [CodeChunk]) -> [UID] -> [CodeChunk]
forall a b. (a -> b) -> a -> b
$ CodeExpr -> [UID]
eDep CodeExpr
ri