Basic EquationalRealms

code/drasil-example/Drasil/GamePhysics/TMods.hs

@@ -1,8 +1,10 @@
 {-# LANGUAGE PostfixOperators #-}
 module Drasil.GamePhysics.TMods (tMods, newtonSL, newtonSLR, newtonTL, newtonLUG) where
 
+import qualified Data.List.NonEmpty as NE
+
 import Language.Drasil
-import Theory.Drasil (TheoryModel, tmNoRefs, tmNoRefs', ModelKinds(OthModel, EquationalModel))
+import Theory.Drasil
 import Utils.Drasil
 import qualified Utils.Drasil.Sentence as S
 
@@ -44,22 +46,21 @@ newtonTLNote = foldlSent [(S "Every action has an equal and opposite reaction" !
 
 -- T3 : Newton's law of universal gravitation --
 
+-- FIXME: Missing ConceptDomain!
+newtonLUGModel :: ModelKinds
+newtonLUGModel = EquationalRealm $ mkMultiDefnForQuant newtonForceQuant EmptyS $ NE.fromList [
+    mkDefiningExpr "newtonLUGviaDeriv" [] EmptyS (sy gravitationalConst `mulRe` (sy mass_1 `mulRe` sy mass_2 $/ square (sy dispNorm)) `mulRe` sy dVect),
+    mkDefiningExpr "newtonLUGviaForm" [] EmptyS (sy gravitationalConst `mulRe` (sy mass_1 `mulRe` sy mass_2 $/ square (sy dispNorm)) `mulRe` (sy distMass $/ sy dispNorm))
+  ]
+
 newtonLUG :: TheoryModel
-newtonLUG = tmNoRefs (OthModel newtonLUGRC)
+newtonLUG = tmNoRefs newtonLUGModel
   [qw force, qw gravitationalConst, qw mass_1, qw mass_2,
   qw dispNorm, qw dVect, qw distMass] ([] :: [ConceptChunk])
-  [] [newtonLUGRel] [] "UniversalGravLaw" newtonLUGNotes
-
-newtonLUGRC :: RelationConcept
-newtonLUGRC = makeRC "newtonLUGRC"
-  (nounPhraseSP "Newton's law of universal gravitation") EmptyS newtonLUGRel
-
-newtonLUGRel :: Relation
-newtonLUGRel = sy force $=
-  sy gravitationalConst `mulRe` (sy mass_1 `mulRe` sy mass_2 $/
-  square (sy dispNorm)) `mulRe` sy dVect $=
-  sy gravitationalConst `mulRe` (sy mass_1 `mulRe` sy mass_2 $/
-  square (sy dispNorm)) `mulRe` (sy distMass $/ sy dispNorm)
+  [] [relat newtonLUGModel] [] "UniversalGravLaw" newtonLUGNotes
+
+newtonForceQuant :: QuantityDict
+newtonForceQuant = mkQuant' "force" (nounPhraseSP "Newton's law of universal gravitation") Nothing Real (symbol force) Nothing
 
 -- Can't include fractions within a sentence (in the part where 'r denotes the
 -- unit displacement vector, equivalent to r/||r||' (line 184)). Changed to a

code/drasil-lang/Language/Drasil.hs

@@ -71,7 +71,8 @@ module Language.Drasil (
   , cuc, cvc, constrained', cuc', cuc'', constrainedNRV'
   , cnstrw, cnstrw'
   -- Chunk.Eq
-  , QDefinition, fromEqn, fromEqn', fromEqnSt, fromEqnSt', equat, mkQuantDef, mkQuantDef', ec
+  , QDefinition, fromEqn, fromEqn', fromEqnSt, fromEqnSt', equat
+  , mkQDefSt, mkQuantDef, mkQuantDef', ec
   -- Chunk.Quantity
   , QuantityDict, qw, mkQuant, mkQuant', codeVC, implVar, implVar', dcc, dcc', 
     dccWDS, dccWDS', vc, vc'', vcSt, vcUnit, ccs, cc, cc', cic
@@ -245,7 +246,7 @@ import Language.Drasil.Constraint (physc, sfwrc, enumc, isPhysC, isSfwrC,
   Constraint(..), ConstraintReason(..))
 import Language.Drasil.Chunk.DefinedQuantity
 import Language.Drasil.Chunk.Eq (QDefinition, fromEqn, fromEqn', fromEqnSt, 
-  fromEqnSt', equat, mkQuantDef, mkQuantDef', ec)
+  fromEqnSt', equat, mkQDefSt, mkQuantDef, mkQuantDef', ec)
 import Language.Drasil.Chunk.NamedArgument (NamedArgument, narg)
 import Language.Drasil.Chunk.NamedIdea
 import Language.Drasil.Chunk.Quantity

code/drasil-lang/Language/Drasil/Chunk/Eq.hs

@@ -1,9 +1,9 @@
 {-# LANGUAGE TemplateHaskell #-}
 module Language.Drasil.Chunk.Eq (QDefinition, fromEqn, fromEqn', fromEqnSt,
-  fromEqnSt', equat, mkQuantDef, mkQuantDef', ec) where
+  fromEqnSt', equat, mkQDefSt, mkQuantDef, mkQuantDef', ec) where
 
 import Control.Lens ((^.), makeLenses, view)
-import Language.Drasil.Chunk.UnitDefn (unitWrapper, MayHaveUnit(getUnit))
+import Language.Drasil.Chunk.UnitDefn (unitWrapper, MayHaveUnit(getUnit), UnitDefn)
 
 import Language.Drasil.Classes.Core (HasUID(uid), HasSymbol(symbol))
 import Language.Drasil.Classes (NamedIdea(term), Idea(getA),
@@ -37,7 +37,7 @@ instance Idea          QDefinition where getA c = getA $ c ^. qua
 -- ^ Finds the idea contained in the 'QuantityDict' used to make the 'QDefinition'.
 instance HasSpace      QDefinition where typ = qua . typ
 -- ^ Finds the 'Space' of the 'QuantityDict' used to make the 'QDefinition'.
-instance HasSymbol     QDefinition where symbol e = symbol (e^.qua)
+instance HasSymbol     QDefinition where symbol e = symbol (e ^. qua)
 -- ^ Finds the 'Symbol' of the 'QuantityDict' used to make the 'QDefinition'.
 instance Definition    QDefinition where defn = defn'
 -- ^ Finds the definition of 'QDefinition'.
@@ -77,17 +77,19 @@ fromEqnSt' :: String -> NP -> Sentence -> (Stage -> Symbol) -> Space -> Expr ->
 fromEqnSt' nm desc def symb sp expr =
   EC (mkQuant' nm desc Nothing sp symb Nothing) def expr []
 
--- | Used to help make 'Qdefinition's when 'UID', term, and 'Symbol' come from the same source.
+-- | Wrapper for fromEqnSt and fromEqnSt'
+mkQDefSt :: UID -> NP -> Sentence -> (Stage -> Symbol) -> Space ->
+  Maybe UnitDefn -> Expr -> QDefinition
+mkQDefSt u n s symb sp (Just ud) e = fromEqnSt u n s symb sp ud e
+mkQDefSt u n s symb sp Nothing   e = fromEqnSt' u n s symb sp e
+
+-- | Used to help make 'QDefinition's when 'UID', term, and 'Symbol' come from the same source.
 mkQuantDef :: (Quantity c, MayHaveUnit c) => c -> Expr -> QDefinition
-mkQuantDef c e = datadef $ getUnit c
-  where datadef (Just a) = fromEqnSt  (c ^. uid) (c ^. term) EmptyS (symbol c) (c ^. typ) a e
-        datadef Nothing  = fromEqnSt' (c ^. uid) (c ^. term) EmptyS (symbol c) (c ^. typ) e
+mkQuantDef c = mkQDefSt (c ^. uid) (c ^. term) EmptyS (symbol c) (c ^. typ) (getUnit c)
 
--- | Used to help make 'Qdefinition's when 'UID' and 'Symbol' come from the same source, with the term separate.
+-- | Used to help make 'QDefinition's when 'UID' and 'Symbol' come from the same source, with the term separate.
 mkQuantDef' :: (Quantity c, MayHaveUnit c) => c -> NP -> Expr -> QDefinition
-mkQuantDef' c t e = datadef $ getUnit c
-  where datadef (Just a) = fromEqnSt  (c ^. uid) t EmptyS (symbol c) (c ^. typ) a e
-        datadef Nothing  = fromEqnSt' (c ^. uid) t EmptyS (symbol c) (c ^. typ) e
+mkQuantDef' c t = mkQDefSt (c ^. uid) t EmptyS (symbol c) (c ^. typ) (getUnit c)
 
 -- HACK - makes the definition EmptyS !!! FIXME
 -- | Smart constructor for QDefinitions. Requires a quantity and its defining 

code/drasil-lang/Language/Drasil/Chunk/Relation.hs

@@ -14,7 +14,7 @@ import Language.Drasil.UID (UID)
 
 -- | For a 'ConceptChunk' that also has a 'Relation' attached.
 data RelationConcept = RC { _conc :: ConceptChunk
-                          , rel :: Relation
+                          , _rel :: Relation
                           }
 makeLenses ''RelationConcept
 
@@ -28,7 +28,7 @@ instance Definition    RelationConcept where defn = conc . defn
 -- ^ Finds the definition contained in the 'ConceptChunk' used to make the 'RelationConcept'.
 instance ConceptDomain RelationConcept where cdom = cdom . view conc
 -- ^ Finds the domain of the 'ConceptChunk' used to make the 'RelationConcept'.
-instance ExprRelat     RelationConcept where relat = rel
+instance ExprRelat     RelationConcept where relat = (^. rel)
 -- ^ Finds the relation expression for a 'RelationConcept'.
 instance Eq            RelationConcept where a == b = (a ^. uid) == (b ^. uid)
 -- ^ Equal if 'UID's are equal.

code/drasil-lang/Language/Drasil/Classes.hs

@@ -177,5 +177,19 @@ class DefiningExpr c where
   -- | Provides a 'Lens' to the expression.
   defnExpr :: Lens' c Expr
 
+{-
+  If we intend to replace all 'relat's with 'defnExpr's, it will require a bit
+  more work since defnExpr is used very differently. 'defnExpr' is primarily
+  used for uniquely defining expressions of QDefinitions and DataDefinitions,
+  while relat is primarily used for cosmetic formatting (quickly grabbing 
+  `x $= ...` Exprs in particular).
+
+  If we return a NonEmpty list of Exprs for 'defnExpr' instead of a single Expr,
+  then, for all the instances that use relat, we can just intercalate $=,
+  prepending a symbol as well, but then it might not work nicely with the
+  existing usage for DataDefinitions -- for example, defining unique expressions
+  for constants. I think we'll need to have a both in some capacity.
+-}
+
 -- | Members must have a named argument.
 class (HasSymbol c) => IsArgumentName c where

code/drasil-theory/Theory/Drasil.hs

@@ -8,6 +8,10 @@ module Theory.Drasil (
   , GenDefn
   , gd, gdNoRefs, gd', gdNoRefs'
   , getEqModQdsFromGd
+  -- MultiDefn
+  , MultiDefn, DefiningExpr
+  , mkMultiDefn, mkMultiDefnForQuant, mkDefiningExpr
+  , multiDefnGenQD, multiDefnGenQDByUID
   -- ModelKinds
   , ModelKinds(..), getEqModQds
   -- InstanceModel
@@ -24,4 +28,5 @@ import Theory.Drasil.DataDefinition (DataDefinition, dd, ddNoRefs, qdFromDD)
 import Theory.Drasil.GenDefn
 import Theory.Drasil.ModelKinds
 import Theory.Drasil.InstanceModel
+import Theory.Drasil.MultiDefn
 import Theory.Drasil.Theory

code/drasil-theory/Theory/Drasil/GenDefn.hs

@@ -5,14 +5,15 @@ module Theory.Drasil.GenDefn (GenDefn,
 import Language.Drasil
 import Data.Drasil.TheoryConcepts (genDefn)
 import Theory.Drasil.ModelKinds (ModelKinds(..), elimMk, setMk, getEqModQds)
+import Theory.Drasil.MultiDefn (MultiDefn)
 
-import Control.Lens (makeLenses, view, lens, (^.), set, Lens', to)
+import Control.Lens (makeLenses, view, lens, (^.), set, Lens')
 
 -- | A general definition is a 'ModelKind' that may have units, a derivation,
 -- references, a shortname, a reference address, and notes.
 data GenDefn = GD { _gUid  :: UID
                   , _mk    :: ModelKinds
-                  , gdUnit :: Maybe UnitDefn                  
+                  , gdUnit :: Maybe UnitDefn -- TODO: Should be derived from the ModelKinds
                   , _deri  :: Maybe Derivation
                   , _ref   :: [Reference]
                   , _sn    :: ShortName
@@ -22,39 +23,39 @@ data GenDefn = GD { _gUid  :: UID
 makeLenses ''GenDefn
 
 -- | Make 'Lens' for a 'GenDefn' based on its 'ModelKinds'.
-lensMk :: forall a. Lens' QDefinition a -> Lens' RelationConcept a -> Lens' GenDefn a
-lensMk lq lr = lens g s
+lensMk :: forall a. Lens' QDefinition a -> Lens' MultiDefn a -> Lens' RelationConcept a -> Lens' GenDefn a
+lensMk lq lqd lr = lens g s
     where g :: GenDefn -> a
-          g gd_ = elimMk lq lr (gd_ ^. mk)
+          g gd_ = elimMk lq lqd lr (gd_ ^. mk)
           s :: GenDefn -> a -> GenDefn
-          s gd_ x = set mk (setMk (gd_ ^. mk) lq lr x) gd_
+          s gd_ x = set mk (setMk (gd_ ^. mk) lq lqd lr x) gd_
 
 -- | Finds the 'UID' of a 'GenDefn'.
-instance HasUID             GenDefn where uid = gUid
+instance HasUID             GenDefn where uid           = gUid
 -- | Finds the term ('NP') of the 'GenDefn'.
-instance NamedIdea          GenDefn where term = lensMk term term
+instance NamedIdea          GenDefn where term          = lensMk term term term
 -- | Finds the idea contained in the 'GenDefn'.
-instance Idea               GenDefn where getA = elimMk (to getA) (to getA) . view mk
+instance Idea               GenDefn where getA          = getA . (^. mk)
 -- | Finds the definition of the 'GenDefn'.
-instance Definition         GenDefn where defn = lensMk defn defn
+instance Definition         GenDefn where defn          = lensMk defn defn defn
 -- | Finds the domain of the 'GenDefn'.
-instance ConceptDomain      GenDefn where cdom = elimMk (to cdom) (to cdom) . view mk
+instance ConceptDomain      GenDefn where cdom          = cdom . (^. mk)
 -- | Finds the relation expression for a 'GenDefn'.
-instance ExprRelat          GenDefn where relat = elimMk (to relat) (to relat) . view mk
+instance ExprRelat          GenDefn where relat         = relat . (^. mk)
 -- | Finds the derivation of the 'GenDefn'. May contain Nothing.
-instance HasDerivation      GenDefn where derivations = deri
+instance HasDerivation      GenDefn where derivations   = deri
 -- | Finds 'Reference's contained in the 'GenDefn'.
 instance HasReference       GenDefn where getReferences = ref
 -- | Finds the 'ShortName' of the 'GenDefn'.
-instance HasShortName       GenDefn where shortname = view sn
+instance HasShortName       GenDefn where shortname     = view sn
 -- | Finds the reference address of the 'GenDefn'.
-instance HasRefAddress      GenDefn where getRefAdd = view ra
--- | Finds any additional notes for the 'GenDefn'.
-instance HasAdditionalNotes GenDefn where getNotes = notes
+instance HasRefAddress      GenDefn where getRefAdd     = view ra
 -- | Finds the units of the 'GenDefn'.
-instance MayHaveUnit        GenDefn where getUnit = gdUnit
+instance HasAdditionalNotes GenDefn where getNotes      = notes
+-- | Finds the units of the 'GenDefn'.
+instance MayHaveUnit        GenDefn where getUnit       = gdUnit
 -- | Finds the idea of a 'GenDefn' (abbreviation).
-instance CommonIdea         GenDefn where abrv _ = abrv genDefn
+instance CommonIdea         GenDefn where abrv _        = abrv genDefn
 -- | Finds the reference address of a 'GenDefn'.
 instance Referable          GenDefn where
   refAdd      = getRefAdd

code/drasil-theory/Theory/Drasil/InstanceModel.hs

@@ -11,8 +11,9 @@ import Language.Drasil
 import Theory.Drasil.Classes (HasInputs(inputs), HasOutput(..))
 import Data.Drasil.TheoryConcepts (inModel)
 
-import Control.Lens (makeLenses, view, lens, (^.), set, Lens', to, _1, _2)
+import Control.Lens (set, (^.), lens, view, makeLenses, Lens', _1, _2) 
 import Theory.Drasil.ModelKinds (ModelKinds(..), elimMk, setMk, getEqModQds)
+import Theory.Drasil.MultiDefn (MultiDefn)
 
 type Input = (QuantityDict, Maybe (RealInterval Expr Expr))
 type Inputs = [Input]
@@ -34,25 +35,25 @@ data InstanceModel = IM { _mk       :: ModelKinds
 makeLenses ''InstanceModel
 
 -- | Make 'Lens' for an 'InstanceModel' based on its 'ModelKinds'.
-lensMk :: forall a. Lens' QDefinition a -> Lens' RelationConcept a -> Lens' InstanceModel a
-lensMk lq lr = lens g s
+lensMk :: forall a. Lens' QDefinition a -> Lens' MultiDefn a -> Lens' RelationConcept a -> Lens' InstanceModel a
+lensMk lq lqd lr = lens g s
     where g :: InstanceModel -> a
-          g im_ = elimMk lq lr (im_ ^. mk)
+          g im_ = elimMk lq lqd lr (im_ ^. mk)
           s :: InstanceModel -> a -> InstanceModel
-          s im_ x = set mk (setMk (im_ ^. mk) lq lr x) im_
+          s im_ x = set mk (setMk (im_ ^. mk) lq lqd lr x) im_
 
 -- | Finds the 'UID' of an 'InstanceModel'.
-instance HasUID             InstanceModel where uid = lensMk uid uid
+instance HasUID             InstanceModel where uid = lensMk uid uid uid
 -- | Finds the term ('NP') of the 'InstanceModel'.
 instance NamedIdea          InstanceModel where term = imTerm
 -- | Finds the idea contained in the 'InstanceModel'.
-instance Idea               InstanceModel where getA = elimMk (to getA) (to getA) . view mk
+instance Idea               InstanceModel where getA = getA . (^. mk)
 -- | Finds the definition of the 'InstanceModel'.
-instance Definition         InstanceModel where defn = lensMk defn defn
+instance Definition         InstanceModel where defn = lensMk defn defn defn
 -- | Finds the domain of the 'InstanceModel'.
-instance ConceptDomain      InstanceModel where cdom = elimMk (to cdom) (to cdom) . view mk
+instance ConceptDomain      InstanceModel where cdom = cdom . (^. mk)
 -- | Finds the relation expression for an 'InstanceModel'.
-instance ExprRelat          InstanceModel where relat = elimMk (to relat) (to relat) . view mk
+instance ExprRelat          InstanceModel where relat = relat . (^. mk)
 -- | Finds the derivation of the 'InstanceModel'. May contain Nothing.
 instance HasDerivation      InstanceModel where derivations = deri
 -- | Finds 'Reference's contained in the 'InstanceModel'.