{-# 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 qualified SysInfo.Drasil as SI
import SysInfo.Drasil (HasSystemInformation(..))

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.CodeExpr.Development (expr, eNamesRI, eDep)
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
_sysinfodb :: 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")
    , ("_sysinfodb", "sysinfodbO")
    ] ''OldCodeSpec

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

instance HasSystemInformation CodeSpec where
  systemInformation :: Lens' CodeSpec SI.SystemInformation
  systemInformation :: Lens' CodeSpec SystemInformation
systemInformation = (SystemInformation -> f SystemInformation)
-> CodeSpec -> f CodeSpec
Lens' CodeSpec SystemInformation
sysInfo
  background :: Lens' CodeSpec SI.Background
  background :: Lens' CodeSpec Background
background = (SystemInformation -> f SystemInformation)
-> CodeSpec -> f CodeSpec
forall c. HasSystemInformation c => Lens' c SystemInformation
Lens' CodeSpec SystemInformation
systemInformation ((SystemInformation -> f SystemInformation)
 -> CodeSpec -> f CodeSpec)
-> ((Background -> f Background)
    -> SystemInformation -> f SystemInformation)
-> (Background -> f Background)
-> CodeSpec
-> f CodeSpec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Background -> f Background)
-> SystemInformation -> f SystemInformation
forall c. HasSystemInformation c => Lens' c Background
Lens' SystemInformation Background
SI.background
  purpose :: Lens' CodeSpec SI.Purpose
  purpose :: Lens' CodeSpec Background
purpose = (SystemInformation -> f SystemInformation)
-> CodeSpec -> f CodeSpec
forall c. HasSystemInformation c => Lens' c SystemInformation
Lens' CodeSpec SystemInformation
systemInformation ((SystemInformation -> f SystemInformation)
 -> CodeSpec -> f CodeSpec)
-> ((Background -> f Background)
    -> SystemInformation -> f SystemInformation)
-> (Background -> f Background)
-> CodeSpec
-> f CodeSpec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Background -> f Background)
-> SystemInformation -> f SystemInformation
forall c. HasSystemInformation c => Lens' c Background
Lens' SystemInformation Background
SI.purpose
  scope :: Lens' CodeSpec SI.Scope
  scope :: Lens' CodeSpec Background
scope = (SystemInformation -> f SystemInformation)
-> CodeSpec -> f CodeSpec
forall c. HasSystemInformation c => Lens' c SystemInformation
Lens' CodeSpec SystemInformation
systemInformation ((SystemInformation -> f SystemInformation)
 -> CodeSpec -> f CodeSpec)
-> ((Background -> f Background)
    -> SystemInformation -> f SystemInformation)
-> (Background -> f Background)
-> CodeSpec
-> f CodeSpec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Background -> f Background)
-> SystemInformation -> f SystemInformation
forall c. HasSystemInformation c => Lens' c Background
Lens' SystemInformation Background
SI.scope
  motivation :: Lens' CodeSpec SI.Motivation
  motivation :: Lens' CodeSpec Background
motivation = (SystemInformation -> f SystemInformation)
-> CodeSpec -> f CodeSpec
forall c. HasSystemInformation c => Lens' c SystemInformation
Lens' CodeSpec SystemInformation
systemInformation ((SystemInformation -> f SystemInformation)
 -> CodeSpec -> f CodeSpec)
-> ((Background -> f Background)
    -> SystemInformation -> f SystemInformation)
-> (Background -> f Background)
-> CodeSpec
-> f CodeSpec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Background -> f Background)
-> SystemInformation -> f SystemInformation
forall c. HasSystemInformation c => Lens' c Background
Lens' SystemInformation Background
SI.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

  sysinfodbO :: Lens' CodeSpec ChunkDB
  sysinfodbO :: Lens' CodeSpec ChunkDB
sysinfodbO = (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
sysinfodbO

-- | 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 'SystemInformation', 'Choices', and 'Mod's.
-- The 'CodeSpec' consists of the system information and a corresponding 'OldCodeSpec'.
codeSpec :: SI.SystemInformation -> Choices -> [Mod] -> CodeSpec
codeSpec :: SystemInformation -> Choices -> [Mod] -> CodeSpec
codeSpec SystemInformation
si Choices
chs [Mod]
ms = CS {
  _sysInfo :: SystemInformation
_sysInfo = SystemInformation
si,
  _oldCode :: OldCodeSpec
_oldCode = SystemInformation -> Choices -> [Mod] -> OldCodeSpec
oldcodeSpec SystemInformation
si Choices
chs [Mod]
ms
}

-- | Generates an 'OldCodeSpec' from 'SystemInformation', 'Choices', and a list of 'Mod's.
-- This function extracts various components (e.g., inputs, outputs, constraints, etc.)
-- from 'SystemInformation' to populate the 'OldCodeSpec' structure.
oldcodeSpec :: SI.SystemInformation -> Choices -> [Mod] -> OldCodeSpec
oldcodeSpec :: SystemInformation -> Choices -> [Mod] -> OldCodeSpec
oldcodeSpec SI.SI{ _sys :: ()
SI._sys = a
sys
                   , _authors :: SystemInformation -> People
SI._authors = People
as
                   , _instModels :: SystemInformation -> [InstanceModel]
SI._instModels = [InstanceModel]
ims
                   , _datadefs :: SystemInformation -> [DataDefinition]
SI._datadefs = [DataDefinition]
ddefs
                   , _configFiles :: SystemInformation -> [Name]
SI._configFiles = [Name]
cfp
                   , _inputs :: ()
SI._inputs = [h]
ins
                   , _outputs :: ()
SI._outputs = [i]
outs
                   , _constraints :: ()
SI._constraints = [j]
cs
                   , _constants :: SystemInformation -> [ConstQDef]
SI._constants = [ConstQDef]
cnsts
                   , _sysinfodb :: SystemInformation -> ChunkDB
SI._sysinfodb = ChunkDB
db } Choices
chs [Mod]
ms =
  let n :: Name
n = a -> Name
forall c. CommonIdea c => c -> Name
programName a
sys
      inputs' :: [CodeVarChunk]
inputs' = (h -> CodeVarChunk) -> [h] -> [CodeVarChunk]
forall a b. (a -> b) -> [a] -> [b]
map h -> CodeVarChunk
forall c. (Quantity c, MayHaveUnit 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 = (SimpleQDef -> CodeDefinition) -> [SimpleQDef] -> [CodeDefinition]
forall a b. (a -> b) -> [a] -> [b]
map SimpleQDef -> CodeDefinition
forall e. CanGenCode e => QDefinition e -> CodeDefinition
qtov ([SimpleQDef] -> [CodeDefinition])
-> [SimpleQDef] -> [CodeDefinition]
forall a b. (a -> b) -> a -> b
$ [DataDefinition]
-> [CodeVarChunk] -> [CodeDefinition] -> ChunkDB -> [SimpleQDef]
getDerivedInputs [DataDefinition]
ddefs [CodeVarChunk]
inputs' [CodeDefinition]
const' ChunkDB
db
      rels :: [CodeDefinition]
rels = ((SimpleQDef -> CodeDefinition) -> [SimpleQDef] -> [CodeDefinition]
forall a b. (a -> b) -> [a] -> [b]
map SimpleQDef -> CodeDefinition
forall (q :: * -> *).
(Quantity (q Expr), MayHaveUnit (q Expr), DefiningExpr q) =>
q Expr -> CodeDefinition
qtoc ([InstanceModel] -> [SimpleQDef]
getEqModQdsFromIm [InstanceModel]
ims [SimpleQDef] -> [SimpleQDef] -> [SimpleQDef]
forall a. [a] -> [a] -> [a]
++ (DataDefinition -> Maybe SimpleQDef)
-> [DataDefinition] -> [SimpleQDef]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe DataDefinition -> Maybe SimpleQDef
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) => 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) => 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) => 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,
        _sysinfodb :: ChunkDB
_sysinfodb = ChunkDB
db
      } 


-- medium hacks ---

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

-- | Get a 'UID' of a chunk corresponding to a 'Func'.
funcUID :: Func -> UID
funcUID :: Func -> UID
funcUID Func
f = Func -> QuantityDict
asVC Func
f QuantityDict -> Getting UID QuantityDict UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID QuantityDict UID
forall c. HasUID c => Getter c UID
Getter QuantityDict 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 -> [SimpleQDef]
getDerivedInputs [DataDefinition]
ddefs [CodeVarChunk]
ins [CodeDefinition]
cnsts ChunkDB
sm =
  (SimpleQDef -> Bool) -> [SimpleQDef] -> [SimpleQDef]
forall a. (a -> Bool) -> [a] -> [a]
filter (([CodeVarChunk] -> [CodeVarChunk] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`subsetOf` [CodeVarChunk]
refSet) ([CodeVarChunk] -> Bool)
-> (SimpleQDef -> [CodeVarChunk]) -> SimpleQDef -> 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])
-> (SimpleQDef -> CodeExpr) -> SimpleQDef -> [CodeVarChunk]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> CodeExpr
expr (Expr -> CodeExpr)
-> (SimpleQDef -> Expr) -> SimpleQDef -> CodeExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SimpleQDef -> Getting Expr SimpleQDef Expr -> Expr
forall s a. s -> Getting a s a -> a
^. Getting Expr SimpleQDef Expr
forall e. Lens' (QDefinition e) e
forall (c :: * -> *) e. DefiningExpr c => Lens' (c e) e
defnExpr)) ((DataDefinition -> Maybe SimpleQDef)
-> [DataDefinition] -> [SimpleQDef]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe DataDefinition -> Maybe SimpleQDef
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) => 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) => 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) => 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