Incremental GA support starting from CSchankGA

code/drasil-code/lib/Data/Drasil/ExternalLibraries/ODELibraries.hs

@@ -10,10 +10,8 @@ module Data.Drasil.ExternalLibraries.ODELibraries (
   odeintPckg, odeintSymbols
 ) where
 
-import Language.Drasil (HasSymbol(symbol), HasUID(uid), MayHaveUnit(getUnit),
-  QuantityDict, HasSpace(typ), Space (Actor, Natural, Real, Void, Boolean, String, Array, Vect), implVar,
-  implVarUID, implVarUID', qw, compoundPhrase, nounPhrase, nounPhraseSP, label,
-  sub, Idea(getA), NamedIdea(term), Stage(..), (+++))
+import Language.Drasil hiding (dim)
+import Language.Drasil.Space (ClifKind(..), Dimension(..))
 import Language.Drasil.Display (Symbol(Label, Concat))
 
 import Language.Drasil.Code (Lang(..), ExternalLibrary, Step, Argument,
@@ -39,8 +37,8 @@ import Language.Drasil.Code (Lang(..), ExternalLibrary, Step, Argument,
   mkODELibNoPath, pubStateVar, privStateVar,
   NamedArgument, narg)
 
-import Drasil.Code.CodeExpr
-import Drasil.Code.CodeExpr.Development
+import Drasil.Code.CodeExpr hiding (dim)
+import qualified Drasil.Code.CodeExpr.Development as CE
 
 import Control.Lens ((^.), _1, _2, over)
 
@@ -431,6 +429,11 @@ computeDerivatives = quantfunc $ implVar "computeDerivatives_apache" (nounPhrase
 odeintPckg :: ODELibPckg
 odeintPckg = mkODELib "odeint" "v2" odeint odeintCall "." [Cpp]
 
+-- | Symbolic dimension used for vector-valued ODE variables.
+-- Allows examples to specialize this to "2", "3", etc., while keeping library code generic.
+dim :: String
+dim = "n"
+
 odeint :: ExternalLibrary
 odeint = externalLib [
   choiceSteps [
@@ -444,15 +447,20 @@ odeint = externalLib [
       customObjArg [] "Class representing an ODE system" ode odeCtor
         (customClass [constructorInfo odeCtor [] [],
           methodInfoNoReturn odeOp "function representation of ODE system"
-            [unnamedParam (Vect Real), unnamedParam (Vect Real), lockedParam t]
+          -- | ODE parameters: generalized for vectors of symbolic dimension 'dim'.
+          -- TODO: Once ClifS is integrated, revisit this to allow symbolic multivectors as parameter types.
+          -- Likely replacement: ClifS dim Real instead of ClifS (VDim dim) Multivector Real.
+            [unnamedParam (ClifS (VDim dim) Multivector Real), unnamedParam (ClifS (VDim dim) Multivector Real), lockedParam t]
             [assignArrayIndex]]),
+            -- [unnamedParam (ClifS (VDim dim) Multivector Real), unnamedParam (ClifS (VDim dim) Multivector Real), lockedParam t]
+            -- [assignArrayIndex]]),
       -- Need to declare variable holding initial value because odeint will update this variable at each step
       preDefinedArg odeintCurrVals,
       inlineArg Real, inlineArg Real, inlineArg Real,
       customObjArg []
         "Class for populating a list during an ODE solution process"
         pop popCtor (customClass [
-          constructorInfo popCtor [unnamedParam (Vect Real)] [],
+          constructorInfo popCtor [unnamedParam (ClifS (VDim dim) Multivector Real)] [],
           methodInfoNoReturn popOp
             "appends solution point for current ODE solution step"
             [lockedParam y, lockedParam t] [appendCurrSol (sy y)]])]]
@@ -497,7 +505,7 @@ odeintCurrVals, rk, stepper, pop :: CodeVarChunk
 odeintCurrVals = quantvar $ implVar "currVals_odeint" (nounPhrase
   "vector holding ODE solution values for the current step"
   "vectors holding ODE solution values for the current step")
-  (Vect Real) (label "currVals")
+  (ClifS (VDim dim) Multivector Real) (label "currVals")
 rk = quantvar $ implVar "rk_odeint" (nounPhrase
   "stepper for solving ODE system using Runge-Kutta-Dopri5 method"
   "steppers for solving ODE system using Runge-Kutta-Dopri5 method")
@@ -556,7 +564,7 @@ t = quantvar $ implVar "t_ode" (nounPhrase
 y = quantvar $ implVar "y_ode" (nounPhrase
   "current dependent variable value in ODE solution"
   "current dependent variable value in ODE solution")
-  (Vect Real) (label "y")
+  (ClifS (VDim dim) Multivector Real) (label "y")
 
 -- | ODE object constructor.
 odeCtor :: CodeFuncChunk
@@ -586,35 +594,36 @@ diffCodeChunk c = quantvar $ implVarUID' (c +++ "d" )
 modifiedODESyst :: String -> ODEInfo -> [CodeExpr]
 modifiedODESyst sufx info = map replaceDepVar (odeSyst info)
   where
-    replaceDepVar cc@(C c) | c == depVar info ^. uid = C $ depVar info +++ ("_" ++ sufx)
+    replaceDepVar cc@(CE.C c) | c == depVar info ^. uid = CE.C $ depVar info +++ ("_" ++ sufx)
                            | otherwise               = cc
-    replaceDepVar (AssocA a es)           = AssocA a (map replaceDepVar es)
-    replaceDepVar (AssocB b es)           = AssocB b (map replaceDepVar es)
-    replaceDepVar (FCall u es nes)        = FCall u (map replaceDepVar es)
+    replaceDepVar (CE.AssocA a es)           = CE.AssocA a (map replaceDepVar es)
+    replaceDepVar (CE.AssocB b es)           = CE.AssocB b (map replaceDepVar es)
+    replaceDepVar (CE.FCall u es nes)        = CE.FCall u (map replaceDepVar es)
       (map (over _2 replaceDepVar) nes)
-    replaceDepVar (New u es nes)          = New u (map replaceDepVar es)
+    replaceDepVar (CE.New u es nes)          = CE.New u (map replaceDepVar es)
       (map (over _2 replaceDepVar) nes)
-    replaceDepVar (Message au mu es nes)  = Message au mu (map replaceDepVar es)
+    replaceDepVar (CE.Message au mu es nes)  = CE.Message au mu (map replaceDepVar es)
       (map (over _2 replaceDepVar) nes)
-    replaceDepVar (Case c cs)             = Case c (map (over _1 replaceDepVar) cs)
-    replaceDepVar (Matrix es)             = Matrix $ map (map replaceDepVar) es
-    replaceDepVar (UnaryOp u e)           = UnaryOp u $ replaceDepVar e
-    replaceDepVar (UnaryOpB u e)          = UnaryOpB u $ replaceDepVar e
-    replaceDepVar (UnaryOpVV u e)         = UnaryOpVV u $ replaceDepVar e
-    replaceDepVar (UnaryOpVN u e)         = UnaryOpVN u $ replaceDepVar e
-    replaceDepVar (ArithBinaryOp b e1 e2) = ArithBinaryOp b
+    replaceDepVar (CE.Case c cs)             = CE.Case c (map (over _1 replaceDepVar) cs)
+    replaceDepVar (CE.Matrix es)             = CE.Matrix $ map (map replaceDepVar) es
+    replaceDepVar (CE.UnaryOp u e)           = CE.UnaryOp u $ replaceDepVar e
+    replaceDepVar (CE.UnaryOpB u e)          = CE.UnaryOpB u $ replaceDepVar e
+    -- TODO: When ClifS or multivectors are introduced, add support for UnaryOpCC and UnaryOpCN here.
+    replaceDepVar (CE.UnaryOpCC u e)         = CE.UnaryOpCC u $ replaceDepVar e
+    replaceDepVar (CE.UnaryOpCN u e)         = CE.UnaryOpCN u $ replaceDepVar e
+    replaceDepVar (CE.ArithBinaryOp b e1 e2) = CE.ArithBinaryOp b
       (replaceDepVar e1) (replaceDepVar e2)
-    replaceDepVar (BoolBinaryOp b e1 e2)  = BoolBinaryOp b
+    replaceDepVar (CE.BoolBinaryOp b e1 e2)  = CE.BoolBinaryOp b
       (replaceDepVar e1) (replaceDepVar e2)
-    replaceDepVar (EqBinaryOp b e1 e2)    = EqBinaryOp b
+    replaceDepVar (CE.EqBinaryOp b e1 e2)    = CE.EqBinaryOp b
       (replaceDepVar e1) (replaceDepVar e2)
-    replaceDepVar (LABinaryOp b e1 e2)    = LABinaryOp b
+    replaceDepVar (CE.LABinaryOp b e1 e2)    = CE.LABinaryOp b
       (replaceDepVar e1) (replaceDepVar e2)
-    replaceDepVar (OrdBinaryOp b e1 e2)   = OrdBinaryOp b
+    replaceDepVar (CE.OrdBinaryOp b e1 e2)   = CE.OrdBinaryOp b
       (replaceDepVar e1) (replaceDepVar e2)
-    replaceDepVar (VVNBinaryOp b e1 e2)   = VVNBinaryOp b
+    replaceDepVar (CE.CCNBinaryOp b e1 e2)   = CE.CCNBinaryOp b
       (replaceDepVar e1) (replaceDepVar e2)
-    replaceDepVar (VVVBinaryOp b e1 e2)   = VVVBinaryOp b
+    replaceDepVar (CE.CCCBinaryOp b e1 e2)   = CE.CCCBinaryOp b
       (replaceDepVar e1) (replaceDepVar e2)
-    replaceDepVar (Operator ao dd e)      = Operator ao dd $ replaceDepVar e
+    replaceDepVar (CE.Operator ao dd e)      = CE.Operator ao dd $ replaceDepVar e
     replaceDepVar e = e

code/drasil-code/lib/Language/Drasil/Chunk/Parameter.hs

@@ -37,11 +37,11 @@ instance Eq          ParameterChunk where c1 == c2 = (c1 ^. uid) == (c2 ^. uid)
 -- | Finds the units of the 'CodeChunk' used to make the 'ParameterChunk'.
 instance MayHaveUnit ParameterChunk where getUnit = getUnit . view pcc
 
--- | Automatically chooses 'PassBy' based on 'Space' ('Vect'ors and 'Actor's passed by reference).
+-- | Automatically chooses 'PassBy' based on 'Space' ('Clif's and 'Actor's passed by reference).
 pcAuto :: (CodeIdea c) => c -> ParameterChunk
 pcAuto c = PC cdch (choosePB $ cdch ^. typ)
   where cdch = codeChunk c
-        choosePB (Vect _) = Ref
+        choosePB (ClifS {}) = Ref
         choosePB (Actor _) = Ref
         choosePB _ = Val
 

code/drasil-code/lib/Language/Drasil/Code/Code.hs

@@ -4,8 +4,7 @@ module Language.Drasil.Code.Code (
     spaceToCodeType
     ) where
 
-import qualified Language.Drasil as S (Space(..))
-
+import qualified Language.Drasil.Space as S (Space(..), ClifKind(..))
 import Drasil.GOOL (CodeType(..))
 
 import Text.PrettyPrint.HughesPJ (Doc)
@@ -15,6 +14,9 @@ import Data.List.NonEmpty (toList)
 newtype Code = Code { unCode :: [(FilePath, Doc)]}
 
 -- | Default mapping between 'Space' and 'CodeType'.
+-- TODO: For now, ClifS is rendered like Vect (i.e., as a list).
+-- This does not support full GA structure (e.g., blades, bivectors, matrices).
+-- Matrix <-> ClifS representation is unclear and deferred.
 spaceToCodeType :: S.Space -> [CodeType]
 spaceToCodeType S.Integer        = [Integer]
 spaceToCodeType S.Natural        = [Integer]
@@ -23,12 +25,17 @@ spaceToCodeType S.Rational       = [Double, Float]
 spaceToCodeType S.Boolean        = [Boolean]
 spaceToCodeType S.Char           = [Char]
 spaceToCodeType S.String         = [String]
-spaceToCodeType (S.Vect s)       = map List (spaceToCodeType s)
+spaceToCodeType (S.ClifS _ kind s) = case kind of
+    S.Scalar      -> spaceToCodeType s
+    S.Vector      -> map List (spaceToCodeType s)
+    S.Bivector    -> map List (spaceToCodeType s)
+    S.Multivector -> map (List . List) (spaceToCodeType s)
 spaceToCodeType (S.Matrix _ _ s) = map (List . List) (spaceToCodeType s)
 spaceToCodeType (S.Set s)        = map List (spaceToCodeType s)
 spaceToCodeType (S.Array s)      = map Array (spaceToCodeType s)
 spaceToCodeType (S.Actor s)      = [Object s]
 spaceToCodeType S.Void           = [Void]
 spaceToCodeType (S.Function i t) = [Func is ts | is <- ins, ts <- trgs]
-    where trgs = spaceToCodeType t
-          ins  = map spaceToCodeType (toList i)
+  where trgs = spaceToCodeType t
+        ins  = map spaceToCodeType (toList i)
+