Merge branch 'main' into GlobalLocalScope

.github/workflows/Build.yaml

@@ -128,7 +128,7 @@ jobs:
 
       - name: "Deploy 🚀"
         if: ${{ fromJSON(env.is_deployment) }}
-        uses: JamesIves/[email protected].1
+        uses: JamesIves/[email protected].3
         with:
           git-config-name: ${{ secrets.BOT_NAME }}
           git-config-email: ${{ secrets.BOT_EMAIL }}

.github/workflows/Lint.yaml

@@ -1,6 +1,7 @@
 on:
   pull_request:
     branches: main
+  workflow_dispatch:
     paths: [code/drasil-**, .github/workflows/Lint.yaml]
 name: Linter
 concurrency:
@@ -13,8 +14,24 @@ defaults:
 jobs:
   linter:
     name: "HLint"
-    runs-on: ubuntu-22.04
+    runs-on: ubuntu-latest
     steps:
       - uses: actions/checkout@v4
-      - name: "HLint"
-        run: make hot_hlint
+
+      # Once we update our LTS, we can remove this step, see "Inputs": https://github.com/haskell-actions/hlint-setup
+      - name: 'Install HLint system dependencies'
+        run: |
+          sudo apt-get update
+          sudo apt-get install -y libtinfo5
+
+      - name: 'Set up HLint'
+        uses: haskell-actions/hlint-setup@v2
+        with: # DO NOT MODIFY THE BELOW LINE MANUALLY -- code/scripts/update_default_stackage.sh is in charge of this!
+          version: '3.4.1' # HLINT VERSION TIED TO CURRENT TARGET (LTS-20.26)
+
+      - name: 'Run HLint'
+        uses: haskell-actions/hlint-run@v2
+        with: # The custom hlint-bin is necessary because we need to inject options to hlint, since hlint-run does not support it yet, see: https://github.com/haskell-actions/hlint-run/issues/20
+          hlint-bin: hlint --hint=code/.hlint.yaml
+          path: code/
+          fail-on: status

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

@@ -211,11 +211,18 @@ genArguments _ _ = error argumentMismatch
 genClassInfo :: CodeVarChunk -> CodeFuncChunk -> Name -> Description ->
   [StateVariable] -> ClassInfo -> ClassInfoFill ->
   State ExtLibState (Class, [String])
-genClassInfo o c n desc svs ci cif = let (mis, mifs, f) = genCI ci cif in
-  if length mis /= length mifs then error methodInfoNumberMismatch else do
-    ms <- zipWithM (genMethodInfo o c) mis mifs
-    modify (if any isConstructor mis then id else addDef (new c []) o)
-    return (f desc svs (map fst ms), concatMap snd ms)
+genClassInfo o c n desc svs ci cif = let 
+  (mis, mifs, f) = genCI ci cif 
+  zMs = zip mis mifs
+  (zCtrs, zMths) = partition (\(mi, _) -> isConstructor mi) zMs
+  (ctrIs, ctrIFs) = unzip zCtrs
+  (mthIs, mthIFs) = unzip zMths 
+  in
+    if length mis /= length mifs then error methodInfoNumberMismatch else do
+      cs <- zipWithM (genMethodInfo o c) ctrIs ctrIFs
+      ms <- zipWithM (genMethodInfo o c) mthIs mthIFs
+      modify (if any isConstructor mis then id else addDef (new c []) o)
+      return (f desc svs (map fst cs) (map fst ms), concatMap snd ms)
   where genCI (Regular mis') (RegularF mifs') = (mis', mifs', classDef n)
         genCI (Implements intn mis') (ImplementsF mifs') = (mis', mifs',
           classImplements n intn)

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

@@ -14,7 +14,8 @@ import Language.Drasil.Mod (Name, Description, Import)
 import GOOL.Drasil (SFile, VSType, SVariable, SValue, MSStatement, SMethod,
   CSStateVar, SClass, NamedArgs, OOProg, FileSym(..), TypeElim(..),
   ValueSym(..), Argument(..), ValueExpression(..), OOValueExpression(..),
-  FuncAppStatement(..), ClassSym(..), ModuleSym(..), CodeType(..), GOOLState)
+  FuncAppStatement(..), OOFuncAppStatement(..), ClassSym(..), ModuleSym(..),
+  CodeType(..), GOOLState)
 
 import Data.Bifunctor (second)
 import qualified Data.Map as Map (lookup)
@@ -27,8 +28,8 @@ import Control.Monad.State (get, modify)
 -- documents the file name, because without this Doxygen will not find the
 -- function-level comments in the file.
 genModuleWithImports :: (OOProg r) => Name -> Description -> [Import] ->
-  [GenState (Maybe (SMethod r))] ->
-  [GenState (Maybe (SClass r))] -> GenState (SFile r)
+  [GenState (Maybe (SMethod r))] -> [GenState (Maybe (SClass r))] -> 
+  GenState (SFile r)
 genModuleWithImports n desc is maybeMs maybeCs = do
   g <- get
   modify (\s -> s { currentModule = n })
@@ -45,8 +46,8 @@ genModuleWithImports n desc is maybeMs maybeCs = do
 
 -- | Generates a module for when imports do not need to be explicitly stated.
 genModule :: (OOProg r) => Name -> Description ->
-  [GenState (Maybe (SMethod r))] ->
-  [GenState (Maybe (SClass r))] -> GenState (SFile r)
+  [GenState (Maybe (SMethod r))] -> [GenState (Maybe (SClass r))] ->
+  GenState (SFile r)
 genModule n desc = genModuleWithImports n desc []
 
 -- | Generates a Doxygen configuration file if the user has comments enabled.
@@ -75,31 +76,32 @@ data ClassType = Primary | Auxiliary
 -- state variables, and methods. The 'Maybe' 'Name' parameter is the name of the
 -- interface the class implements, if applicable.
 mkClass :: (OOProg r) => ClassType -> Name -> Maybe Name -> Description ->
-  [CSStateVar r] -> GenState [SMethod r] ->
+  [CSStateVar r] -> GenState [SMethod r] -> GenState [SMethod r] ->
   GenState (SClass r)
-mkClass s n l desc vs mths = do
+mkClass s n l desc vs cstrs mths = do
   g <- get
   modify (\ds -> ds {currentClass = n})
+  cs <- cstrs
   ms <- mths
   modify (\ds -> ds {currentClass = ""})
   let getFunc Primary = getFunc' l
       getFunc Auxiliary = extraClass n Nothing
       getFunc' Nothing = buildClass Nothing
       getFunc' (Just intfc) = implementingClass n [intfc]
-      c = getFunc s vs ms
+      c = getFunc s vs cs ms
   return $ if CommentClass `elem` commented g
     then docClass desc c
     else c
 
 -- | Generates a primary class.
 primaryClass :: (OOProg r) => Name -> Maybe Name -> Description ->
-  [CSStateVar r] -> GenState [SMethod r] ->
+  [CSStateVar r] -> GenState [SMethod r] -> GenState [SMethod r] ->
   GenState (SClass r)
 primaryClass = mkClass Primary
 
 -- | Generates an auxiliary class (for when a module contains multiple classes).
 auxClass :: (OOProg r) => Name -> Maybe Name -> Description ->
-  [CSStateVar r] -> GenState [SMethod r] ->
+  [CSStateVar r] -> GenState [SMethod r] -> GenState [SMethod r] ->
   GenState (SClass r)
 auxClass = mkClass Auxiliary
 

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

@@ -46,8 +46,8 @@ import GOOL.Drasil (Label, SFile, MSBody, MSBlock, VSType, SVariable, SValue,
   ValueExpression(..), OOValueExpression(..), objMethodCallMixedArgs, List(..),
   StatementSym(..), AssignStatement(..), DeclStatement(..), IOStatement(..),
   StringStatement(..), ControlStatement(..), ifNoElse, VisibilitySym(..),
-  ParameterSym(..), MethodSym(..), pubDVar, privDVar, nonInitConstructor,
-  convTypeOO, VisibilityTag(..), CodeType(..), onStateValue)
+  ParameterSym(..), MethodSym(..), OOMethodSym(..), pubDVar, privDVar,
+  nonInitConstructor, convTypeOO, VisibilityTag(..), CodeType(..), onStateValue)
 import qualified GOOL.Drasil as C (CodeType(List, Array))
 
 import Prelude hiding (sin, cos, tan, log, exp)
@@ -486,14 +486,15 @@ genModClasses (Mod _ _ _ cs _) = map (genClass auxClass) cs
 -- | Converts a Class (from the Mod AST) to GOOL.
 -- The class generator to use is passed as a parameter.
 genClass :: (OOProg r) => (Name -> Maybe Name -> Description -> [CSStateVar r]
-  -> GenState [SMethod r] -> GenState (SClass r)) ->
+  -> GenState [SMethod r] -> GenState [SMethod r] -> GenState (SClass r)) ->
   M.Class -> GenState (SClass r)
-genClass f (M.ClassDef n i desc svs ms) = let svar Pub = pubDVar
-                                              svar Priv = privDVar
+genClass f (M.ClassDef n i desc svs cs ms) = let svar Pub = pubDVar
+                                                 svar Priv = privDVar
   in do
   svrs <- mapM (\(SV s v) -> fmap (svar s . var' (codeName v) local . -- TODO: get scope from state
                 convTypeOO) (codeType v)) svs
-  f n i desc svrs (mapM (genFunc publicMethod svs) ms)
+  f n i desc svrs (mapM (genFunc publicMethod svs) cs) 
+                  (mapM (genFunc publicMethod svs) ms)
 
 -- | Converts a 'Func' (from the Mod AST) to GOOL.
 -- The function generator to use is passed as a parameter. Automatically adds

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

@@ -69,7 +69,7 @@ loggedMethod lName n vars = block [
 
 -- | The variable representing the log file in write mode.
 varLogFile :: (OOProg r) => r (Scope r) -> SVariable r
-varLogFile = var "outfile" outfile -- TODO: get scope from state?
+varLogFile = var "outfile" outfile
 
 -- | The value of the variable representing the log file in write mode.
 valLogFile :: (OOProg r) => r (Scope r) -> SValue r

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

@@ -49,9 +49,10 @@ import GOOL.Drasil (SFile, MSBody, MSBlock, SVariable, SValue, MSStatement,
   BlockSym(..), PermanenceSym(..), TypeSym(..), VariableSym(..), var,
   ScopeSym(..), Literal(..), VariableValue(..), CommandLineArgs(..),
   BooleanExpression(..), StatementSym(..), AssignStatement(..),
-  DeclStatement(..), objDecNewNoParams, extObjDecNewNoParams, IOStatement(..),
-  ControlStatement(..), ifNoElse, VisibilitySym(..), MethodSym(..),
-  StateVarSym(..), pubDVar, convTypeOO, VisibilityTag(..))
+  DeclStatement(..), OODeclStatement(..), objDecNewNoParams,
+  extObjDecNewNoParams, IOStatement(..), ControlStatement(..), ifNoElse,
+  VisibilitySym(..), MethodSym(..), StateVarSym(..), pubDVar, convTypeOO,
+  VisibilityTag(..))
 
 import Prelude hiding (print)
 import Data.List (intersperse, partition)
@@ -210,10 +211,14 @@ genInputClass scp = do
       cs = constants $ codeSpec g
       filt :: (CodeIdea c) => [c] -> [c]
       filt = filter ((Just cname ==) . flip Map.lookup (clsMap g) . codeName)
+      constructors :: (OOProg r) => GenState [SMethod r]
+      constructors = if cname `elem` defSet g
+        then concat <$> mapM (fmap maybeToList) [genInputConstructor]
+        else return []
       methods :: (OOProg r) => GenState [SMethod r]
       methods = if cname `elem` defSet g
-        then concat <$> mapM (fmap maybeToList) [genInputConstructor,
-        genInputFormat Priv, genInputDerived Priv, genInputConstraints Priv]
+        then concat <$> mapM (fmap maybeToList) [genInputFormat Priv,
+        genInputDerived Priv, genInputConstraints Priv]
         else return []
       genClass :: (OOProg r) => [CodeVarChunk] -> [CodeDefinition] ->
         GenState (Maybe (SClass r))
@@ -229,7 +234,7 @@ genInputClass scp = do
             getFunc Auxiliary = auxClass
             f = getFunc scp
         icDesc <- inputClassDesc
-        c <- f cname Nothing icDesc (inputVars ++ constVars) methods
+        c <- f cname Nothing icDesc (inputVars ++ constVars) constructors methods
         return $ Just c
   genClass (filt ins) (filt cs)
 
@@ -462,7 +467,7 @@ genConstClass scp = do
             getFunc Auxiliary = auxClass
             f = getFunc scp
         cDesc <- constClassDesc
-        cls <- f cname Nothing cDesc constVars (return [])
+        cls <- f cname Nothing cDesc constVars (return []) (return [])
         return $ Just cls
   genClass $ filter (flip member (Map.filter (cname ==) (clsMap g))
     . codeName) cs

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

@@ -47,6 +47,7 @@ data Class = ClassDef {
   implements :: Maybe Name,
   classDesc :: Description,
   stateVars :: [StateVariable],
+  constructors :: [Func],
   methods :: [Func]}
 
 -- | State variables hold attach a 'VisibilityTag' to a 'CodeVarChunk'.
@@ -64,13 +65,13 @@ privStateVar = SV Priv
 
 -- | Define a class with the given 'Name', 'Description', state variables, and
 -- methods.
-classDef :: Name -> Description -> [StateVariable] -> [Func] -> Class
+classDef :: Name -> Description -> [StateVariable] -> [Func] -> [Func] -> Class
 classDef n = ClassDef n Nothing
 
 -- | Define a class that implements an interface. 1st 'Name' is class name, 2nd is
 -- interface name.
 classImplements :: Name -> Name -> Description -> [StateVariable] -> [Func] ->
-  Class
+  [Func] -> Class
 classImplements n i = ClassDef n (Just i)
 
 -- | Holds a function definition or function data.

code/drasil-code/test/HelloWorld.hs

@@ -6,11 +6,12 @@ module HelloWorld (helloWorld) where
 import GOOL.Drasil (GSProgram, MSBody, MSBlock, MSStatement, SMethod, SVariable,
   OOProg, ProgramSym(..), FileSym(..), BodySym(..), bodyStatements, oneLiner,
   BlockSym(..), listSlice, TypeSym(..), StatementSym(..), AssignStatement(..), 
-  (&=), DeclStatement(..), IOStatement(..), StringStatement(..),
-  CommentStatement(..), ControlStatement(..), var, constant, ScopeSym(..),
-  listVar, Literal(..), VariableValue(..), CommandLineArgs(..),
-  NumericExpression(..), BooleanExpression(..), Comparison(..),
-  ValueExpression(..), extFuncApp, List(..), MethodSym(..), ModuleSym(..))
+  (&=), DeclStatement(..), OODeclStatement(..), IOStatement(..),
+  StringStatement(..), CommentStatement(..), ControlStatement(..), var,
+  constant, ScopeSym(..), listVar, Literal(..), VariableValue(..),
+  CommandLineArgs(..), NumericExpression(..), BooleanExpression(..),
+  Comparison(..), ValueExpression(..), extFuncApp, List(..), MethodSym(..),
+  ModuleSym(..))
 import Prelude hiding (return,print,log,exp,sin,cos,tan,const)
 import Helper (helper)
 

code/drasil-code/test/Observer.hs

@@ -4,7 +4,7 @@ module Observer (observer, observerName, printNum, x) where
 import GOOL.Drasil (SFile, SVariable, SMethod, SClass, OOProg, FileSym(..),
   PermanenceSym(..), oneLiner, TypeSym(..), IOStatement(..), VariableSym(..),
   var, ScopeSym(..), OOVariableSym(..), Literal(..), VariableValue(..),
-  OOVariableValue, VisibilitySym(..), MethodSym(..), initializer,
+  OOVariableValue, VisibilitySym(..), OOMethodSym(..), initializer,
   StateVarSym(..), ClassSym(..), ModuleSym(..))
 import Prelude hiding (return,print,log,exp,sin,cos,tan)
 
@@ -32,13 +32,13 @@ selfX = objVarSelf x
 -- | Helper function to create the class.
 helperClass :: (ClassSym r, IOStatement r, Literal r, OOVariableValue r) => SClass r
 helperClass = buildClass Nothing [stateVar public dynamic x]
-  [observerConstructor, printNumMethod, getMethod x, setMethod x]
+  [observerConstructor] [printNumMethod, getMethod x, setMethod x]
 
 -- | Default value for observer class is 5.
-observerConstructor :: (MethodSym r, Literal r) => SMethod r
+observerConstructor :: (OOMethodSym r, Literal r) => SMethod r
 observerConstructor = initializer [] [(x, litInt 5)]
 
 -- | Create the @printNum@ method.
-printNumMethod :: (MethodSym r, IOStatement r, OOVariableValue r) => SMethod r
+printNumMethod :: (OOMethodSym r, IOStatement r, OOVariableValue r) => SMethod r
 printNumMethod = method printNum public dynamic void [] $
   oneLiner $ printLn $ valueOf selfX

code/drasil-code/test/PatternTest.hs

@@ -5,22 +5,17 @@ module PatternTest (patternTest) where
 import GOOL.Drasil (GSProgram, VSType, SVariable, SValue, SMethod, OOProg,
   ProgramSym(..), FileSym(..), BodySym(..), oneLiner, BlockSym(..),
   TypeSym(..), OOTypeSym(..), StatementSym(..), DeclStatement(..),
-  IOStatement(..), initState, changeState, initObserverList, addObserver,
-  var, OOVariableSym(..), ScopeSym(..), Literal(..), VariableValue(..),
-  OOValueExpression(..), extNewObj, FunctionSym(..), GetSet(..),
-  StatePattern(..), ObserverPattern(..), StrategyPattern(..), MethodSym(..),
-  ModuleSym(..))
+  IOStatement(..), initObserverList, addObserver, var, OOVariableSym(..),
+  ScopeSym(..), Literal(..), VariableValue(..), OOValueExpression(..),
+  extNewObj, FunctionSym(..), GetSet(..), ObserverPattern(..),
+  StrategyPattern(..), MethodSym(..), ModuleSym(..))
 import Prelude hiding (return,print,log,exp,sin,cos,tan)
 import Observer (observer, observerName, printNum, x)
 
 -- | Variables, program names, and used strings within the program.
-progName, fsmName, offState, onState, noState, strat1, strat2, obs1Name,
+progName, strat1, strat2, obs1Name,
   obs2Name, nName :: String
 progName = "PatternTest"
-fsmName = "myFSM"
-offState = "Off"
-onState = "On"
-noState = "Neither"
 strat1 = "myStrat"
 strat2 = "yourStrat"
 obs1Name = "obs1"
@@ -49,15 +44,7 @@ patternTest = prog progName "" [fileDoc (buildModule progName []
 -- | Creates the main function for PatternTest.
 patternTestMainMethod :: (OOProg r) => SMethod r
 patternTestMainMethod = mainFunction (body [block [
-  varDec n,
-  initState fsmName offState,
-  changeState fsmName onState,
-  checkState fsmName
-    [(litString offState,
-      oneLiner $ printStrLn offState),
-     (litString onState,
-       oneLiner $ printStrLn onState)]
-    (oneLiner $ printStrLn noState)],
+  varDec n],
 
   runStrategy strat1
     [(strat1, oneLiner $ printStrLn strat1),