From 704f8a3606ae6f37066bb179aee1d2effafd1771 Mon Sep 17 00:00:00 2001 From: Brooks MacLachlan Date: Wed, 26 Jun 2019 16:45:03 -0400 Subject: [PATCH 01/11] All outputs get declared for inOutFunc --- .../Language/Drasil/Code/Imperative/Import.hs | 41 ++++++++++--------- .../Code/Imperative/LanguageRenderer.hs | 15 +++++-- .../LanguageRenderer/CSharpRenderer.hs | 6 +-- .../LanguageRenderer/CppRenderer.hs | 22 +++++----- .../LanguageRenderer/JavaRenderer.hs | 10 ++--- .../LanguageRenderer/PythonRenderer.hs | 2 +- .../Drasil/Code/Imperative/Symantics.hs | 2 +- code/drasil-code/Test/FileTests.hs | 8 ++-- code/drasil-code/Test/HelloWorld.hs | 8 ++-- code/drasil-code/Test/Helper.hs | 2 +- code/drasil-code/Test/PatternTest.hs | 2 +- 11 files changed, 63 insertions(+), 55 deletions(-) diff --git a/code/drasil-code/Language/Drasil/Code/Imperative/Import.hs b/code/drasil-code/Language/Drasil/Code/Imperative/Import.hs index 9de98b31d7..6c272e2a2b 100644 --- a/code/drasil-code/Language/Drasil/Code/Imperative/Import.hs +++ b/code/drasil-code/Language/Drasil/Code/Imperative/Import.hs @@ -76,8 +76,8 @@ chooseLogging LogAll = loggedAssign chooseLogging _ = \x y -> return $ assign x y initLogFileVar :: (RenderSym repr) => Logging -> [repr (Statement repr)] -initLogFileVar LogVar = [varDec "outfile" outfile] -initLogFileVar LogAll = [varDec "outfile" outfile] +initLogFileVar LogVar = [varDec $ var "outfile" outfile] +initLogFileVar LogAll = [varDec $ var "outfile" outfile] initLogFileVar _ = [] @@ -363,7 +363,7 @@ genOutputFormat = do ] ) (outputs $ csi $ codeSpec g) mthd <- publicMethod (mState void) "write_output" parms (return [block $ [ - varDec l_outfile outfile, + varDec v_outfile, openFileW v_outfile (litString "output.txt") ] ++ concat outp ++ [ closeFile v_outfile ]]) return $ Just mthd @@ -423,7 +423,7 @@ loggedMethod n vals b = g <- ask rest <- b return $ block [ - varDec l_outfile outfile, + varDec v_outfile, openFileA v_outfile (litString $ logName g), printFileStr v_outfile ("function " ++ n ++ "("), printParams vals v_outfile, @@ -474,14 +474,15 @@ getInputDecl :: (RenderSym repr) => Reader (State repr) (Maybe (repr ( getInputDecl = do g <- ask let l_params = "inParams" - getDecl :: (RenderSym repr) => Structure -> [CodeChunk] -> Maybe (repr - (Statement repr)) - getDecl _ [] = Nothing - getDecl Loose ins = Just $ multi $ map (\x -> varDec (codeName x) - (convType $ codeType x)) ins - getDecl AsClass _ = Just $ extObjDecNewVoid l_params "InputParameters" - (obj "InputParameters") - return $ getDecl (inStruct g) (inputs $ codeSpec g) + getDecl :: (RenderSym repr) => Structure -> [CodeChunk] -> + Reader (State repr) (Maybe (repr (Statement repr))) + getDecl _ [] = return Nothing + getDecl Loose ins = do + vals <- mapM (\x -> variable (codeName x) (convType $ codeType x)) ins + return $ Just $ multi $ map varDec vals + getDecl AsClass _ = return $ Just $ extObjDecNewVoid l_params + "InputParameters" (obj "InputParameters") + getDecl (inStruct g) (inputs $ codeSpec g) getFuncCall :: (RenderSym repr) => String -> repr (StateType repr) -> Reader (State repr) [ParamData repr] -> @@ -798,12 +799,10 @@ genFunc (FDef (FuncDef n i o s)) = do g <- ask parms <- getParams i stmts <- mapM convStmt s + vals <- mapM (\x -> variable (codeName x) (convType $ codeType x)) + (fstdecl (sysinfodb $ csi $ codeSpec g) s \\ i) publicMethod (mState $ convType o) n parms - (return [block $ - map (\x -> varDec (codeName x) (convType $ codeType x)) - (fstdecl (sysinfodb $ csi $ codeSpec g) s \\ i) - ++ stmts - ]) + (return [block $ map varDec vals ++ stmts]) genFunc (FData (FuncData n ddef)) = genDataFunc n ddef genFunc (FCD cd) = genCalcFunc cd @@ -839,7 +838,9 @@ convStmt (FTry t c) = do convStmt FContinue = return continue convStmt (FDec v (C.List t)) = return $ listDec (codeName v) 0 (listType dynamic_ (convType t)) -convStmt (FDec v t) = return $ varDec (codeName v) (convType t) +convStmt (FDec v t) = do + val <- variable (codeName v) (convType t) + return $ varDec val convStmt (FProcCall n l) = do e' <- convExpr (FCall (asExpr n) l) return $ valState e' @@ -863,8 +864,8 @@ readData :: (RenderSym repr) => DataDesc -> Reader (State repr) readData ddef = do inD <- mapM inData ddef return [block $ [ - varDec l_infile infile, - varDec l_line string, + varDec v_infile, + varDec v_line, listDec l_lines 0 (listType dynamic_ string), listDec l_linetokens 0 (listType dynamic_ string), openFileR v_infile v_filename ] ++ diff --git a/code/drasil-code/Language/Drasil/Code/Imperative/LanguageRenderer.hs b/code/drasil-code/Language/Drasil/Code/Imperative/LanguageRenderer.hs index ecd85b076b..9083f22b86 100644 --- a/code/drasil-code/Language/Drasil/Code/Imperative/LanguageRenderer.hs +++ b/code/drasil-code/Language/Drasil/Code/Imperative/LanguageRenderer.hs @@ -28,8 +28,8 @@ module Language.Drasil.Code.Imperative.LanguageRenderer ( constDecDefDocD, notNullDocD, listIndexExistsDocD, funcDocD, castDocD, sizeDocD, listAccessDocD, listSetDocD, objAccessDocD, castObjDocD, includeD, breakDocD, continueDocD, staticDocD, dynamicDocD, privateDocD, publicDocD, - addCommentsDocD, valList, appendToBody, getterName, setterName, - setMain, setEmpty, statementsToStateVars + addCommentsDocD, valList, prependToBody, appendToBody, surroundBody, + getterName, setterName, setMain, setEmpty, statementsToStateVars ) where import Utils.Drasil (capitalize, indent, indentList) @@ -314,8 +314,8 @@ plusPlusDocD v = valDoc v <> text "++" plusPlusDocD' :: ValData -> Doc -> Doc plusPlusDocD' v plusOp = valDoc v <+> equals <+> valDoc v <+> plusOp <+> int 1 -varDecDocD :: Label -> TypeData -> Doc -varDecDocD l st = typeDoc st <+> text l +varDecDocD :: ValData -> Doc +varDecDocD v = typeDoc (valType v) <+> valDoc v varDecDefDocD :: Label -> TypeData -> ValData -> Doc varDecDefDocD l st v = typeDoc st <+> text l <+> equals <+> valDoc v @@ -655,10 +655,17 @@ dashes s l = replicate (l - length s) '-' valList :: [ValData] -> Doc valList vs = hcat (intersperse (text ", ") (map valDoc vs)) +prependToBody :: (Doc, Terminator) -> Doc -> Doc +prependToBody s b = vcat [fst $ statementDocD s, maybeBlank, b] + where maybeBlank = if isEmpty b then empty else blank + appendToBody :: Doc -> (Doc, Terminator) -> Doc appendToBody b s = vcat [b, maybeBlank, fst $ statementDocD s] where maybeBlank = if isEmpty b then empty else blank +surroundBody :: (Doc, Terminator) -> Doc -> (Doc, Terminator) -> Doc +surroundBody p b a = prependToBody p (appendToBody b a) + getterName :: String -> String getterName s = "Get" ++ capitalize s diff --git a/code/drasil-code/Language/Drasil/Code/Imperative/LanguageRenderer/CSharpRenderer.hs b/code/drasil-code/Language/Drasil/Code/Imperative/LanguageRenderer/CSharpRenderer.hs index 185aa10e3a..c7ea8ef06e 100644 --- a/code/drasil-code/Language/Drasil/Code/Imperative/LanguageRenderer/CSharpRenderer.hs +++ b/code/drasil-code/Language/Drasil/Code/Imperative/LanguageRenderer/CSharpRenderer.hs @@ -38,7 +38,7 @@ import Language.Drasil.Code.Imperative.LanguageRenderer ( notNullDocD, listIndexExistsDocD, funcDocD, castDocD, listSetDocD, listAccessDocD, objAccessDocD, castObjDocD, breakDocD, continueDocD, staticDocD, dynamicDocD, privateDocD, publicDocD, dot, new, observerListName, - doubleSlash, addCommentsDocD, valList, appendToBody, getterName, setterName, + doubleSlash, addCommentsDocD, valList, surroundBody, getterName, setterName, setMain, setEmpty, statementsToStateVars) import Language.Drasil.Code.Imperative.Helpers (Terminator(..), FuncData(..), fd, ModData(..), md, TypeData(..), td, ValData(..), vd, updateValDoc, liftA4, @@ -346,7 +346,7 @@ instance StatementSym CSharpCode where (&++) v = mkSt <$> fmap plusPlusDocD v (&~-) v = v &= (v #- litInt 1) - varDec l t = mkSt <$> fmap (varDecDocD l) t + varDec v = mkSt <$> fmap varDecDocD v varDecDef l t v = mkSt <$> liftA2 (varDecDefDocD l) t v listDec l n t = mkSt <$> liftA2 (listDecDocD l) (litInt n) t -- this means that the type you declare must already be a list. Not sure how I feel about this. On the bright side, it also means you don't need to pass permanence listDecDef l t vs = mkSt <$> lift1List (listDecDefDocD l) t vs @@ -520,7 +520,7 @@ instance MethodSym CSharpCode where function n = method n "" inOutFunc n s p ins [v] b = function n s p (mState (fmap valType v)) - (map stateParam ins) (liftA2 appendToBody b $ returnState v) + (map stateParam ins) (liftA3 surroundBody (varDec v) b (returnState v)) inOutFunc n s p ins outs b = function n s p (mState void) (nub $ map (\v -> if v `elem` outs then fmap csRef (stateParam v) else stateParam v) ins ++ map (fmap csRef . stateParam) outs) b diff --git a/code/drasil-code/Language/Drasil/Code/Imperative/LanguageRenderer/CppRenderer.hs b/code/drasil-code/Language/Drasil/Code/Imperative/LanguageRenderer/CppRenderer.hs index c5d10fb011..72c931c7a6 100644 --- a/code/drasil-code/Language/Drasil/Code/Imperative/LanguageRenderer/CppRenderer.hs +++ b/code/drasil-code/Language/Drasil/Code/Imperative/LanguageRenderer/CppRenderer.hs @@ -36,7 +36,7 @@ import Language.Drasil.Code.Imperative.LanguageRenderer ( objVarDocD, inlineIfDocD, funcAppDocD, funcDocD, castDocD, objAccessDocD, castObjDocD, breakDocD, continueDocD, staticDocD, dynamicDocD, privateDocD, publicDocD, classDec, dot, observerListName, doubleSlash, addCommentsDocD, - valList, appendToBody, getterName, setterName, setEmpty) + valList, surroundBody, getterName, setterName, setEmpty) import Language.Drasil.Code.Imperative.Helpers (Pair(..), Terminator(..), ScopeTag (..), FuncData(..), fd, ModData(..), md, MethodData(..), mthd, StateVarData(..), svd, TypeData(..), td, ValData(..), vd, angles, blank, @@ -337,7 +337,7 @@ instance (Pair p) => StatementSym (p CppSrcCode CppHdrCode) where (&++) v = pair ((&++) $ pfst v) ((&++) $ psnd v) (&~-) v = pair ((&~-) $ pfst v) ((&~-) $ psnd v) - varDec l t = pair (varDec l $ pfst t) (varDec l $ psnd t) + varDec v = pair (varDec $ pfst v) (varDec $ psnd v) varDecDef l t v = pair (varDecDef l (pfst t) (pfst v)) (varDecDef l (psnd t) (psnd v)) listDec l n t = pair (listDec l n $ pfst t) (listDec l n $ psnd t) @@ -844,7 +844,7 @@ instance StatementSym CppSrcCode where (&++) v = mkSt <$> fmap plusPlusDocD v (&~-) v = v &= (v #- litInt 1) - varDec l t = mkSt <$> fmap (varDecDocD l) t + varDec v = mkSt <$> fmap varDecDocD v varDecDef l t v = mkSt <$> liftA2 (varDecDefDocD l) t v listDec l n t = mkSt <$> liftA2 (cppListDecDoc l) (litInt n) t -- this means that the type you declare must already be a list. Not sure how I feel about this. On the bright side, it also means you don't need to pass permanence listDecDef l t vs = mkSt <$> liftA2 (cppListDecDefDoc l) t (liftList @@ -924,9 +924,9 @@ instance StatementSym CppSrcCode where in multi [ valState $ vnew $. func "clear" void [], - varDec l_ss (obj "std::stringstream"), + varDec v_ss, valState $ objMethodCall string v_ss "str" [s], - varDec l_word string, + varDec v_word, while (funcApp "std::getline" string [v_ss, v_word, litChar d]) (oneLiner $ valState $ vnew $. listAppend v_word) ] @@ -995,7 +995,7 @@ instance ControlStatementSym CppSrcCode where getFileInputAll f v = let l_line = "nextLine" v_line = var l_line string in - multi [varDec l_line string, + multi [varDec v_line, while (funcApp "std::getline" string [f, v_line]) (oneLiner $ valState $ v $. listAppend v_line)] @@ -1031,9 +1031,9 @@ instance MethodSym CppSrcCode where pubMethod n c = method n c public dynamic_ constructor n = method n n public dynamic_ (construct n) destructor n vs = - let i = "i" + let i = var "i" int deleteStatements = map (fmap destructSts) vs - loopIndexDec = varDec i int + loopIndexDec = varDec i dbody = if all (isEmpty . fst . unCPPSC) deleteStatements then return empty else bodyStatements $ loopIndexDec : deleteStatements in pubMethod ('~':n) n void [] dbody @@ -1042,7 +1042,7 @@ instance MethodSym CppSrcCode where (cppsFunction n) t (liftList paramListDocD ps) b blockStart blockEnd) inOutFunc n s p ins [v] b = function n s p (mState (fmap valType v)) - (map (fmap getParam) ins) (liftA2 appendToBody b $ returnState v) + (map (fmap getParam) ins) (liftA3 surroundBody (varDec v) b (returnState v)) inOutFunc n s p ins outs b = function n s p (mState void) (nub $ map (\v -> if v `elem` outs then pointerParam v else fmap getParam v) ins ++ map pointerParam outs) b @@ -1357,7 +1357,7 @@ instance StatementSym CppHdrCode where (&++) _ = return (mkStNoEnd empty) (&~-) _ = return (mkStNoEnd empty) - varDec _ _ = return (mkStNoEnd empty) + varDec _ = return (mkStNoEnd empty) varDecDef _ _ _ = return (mkStNoEnd empty) listDec _ _ _ = return (mkStNoEnd empty) listDecDef _ _ _ = return (mkStNoEnd empty) @@ -1488,7 +1488,7 @@ instance MethodSym CppHdrCode where function n = method n "" inOutFunc n s p ins [v] b = function n s p (mState (fmap valType v)) - (map (fmap getParam) ins) (liftA2 appendToBody b $ returnState v) + (map (fmap getParam) ins) b inOutFunc n s p ins outs b = function n s p (mState void) (nub $ map (\v -> if v `elem` outs then pointerParam v else fmap getParam v) ins ++ map pointerParam outs) b diff --git a/code/drasil-code/Language/Drasil/Code/Imperative/LanguageRenderer/JavaRenderer.hs b/code/drasil-code/Language/Drasil/Code/Imperative/LanguageRenderer/JavaRenderer.hs index 7769370488..4c375d91e5 100644 --- a/code/drasil-code/Language/Drasil/Code/Imperative/LanguageRenderer/JavaRenderer.hs +++ b/code/drasil-code/Language/Drasil/Code/Imperative/LanguageRenderer/JavaRenderer.hs @@ -37,7 +37,7 @@ import Language.Drasil.Code.Imperative.LanguageRenderer ( funcAppDocD, extFuncAppDocD, stateObjDocD, listStateObjDocD, notNullDocD, funcDocD, castDocD, objAccessDocD, castObjDocD, breakDocD, continueDocD, staticDocD, dynamicDocD, privateDocD, publicDocD, dot, new, forLabel, - observerListName, doubleSlash, addCommentsDocD, valList, appendToBody, + observerListName, doubleSlash, addCommentsDocD, valList, surroundBody, getterName, setterName, setMain, setEmpty, statementsToStateVars) import Language.Drasil.Code.Imperative.Helpers (Terminator(..), FuncData(..), fd, ModData(..), md, TypeData(..), td, ValData(..), vd, angles, liftA4, @@ -350,7 +350,7 @@ instance StatementSym JavaCode where (&++) v = mkSt <$> fmap plusPlusDocD v (&~-) v = v &= (v #- litInt 1) - varDec l t = mkSt <$> fmap (varDecDocD l) t + varDec v = mkSt <$> fmap varDecDocD v varDecDef l t v = mkSt <$> liftA2 (varDecDefDocD l) t v listDec l n t = mkSt <$> liftA2 (listDecDocD l) (litInt n) t -- this means that the type you declare must already be a list. Not sure how I feel about this. On the bright side, it also means you don't need to pass permanence listDecDef l t vs = mkSt <$> liftA2 (jListDecDef l) t (liftList @@ -531,10 +531,9 @@ instance MethodSym JavaCode where inOutFunc n s p ins [] b = function n s p (mState void) (map stateParam ins) b inOutFunc n s p ins [v] b = function n s p (mState (fmap valType v)) - (map stateParam ins) (liftA2 appendToBody b (returnState v)) + (map stateParam ins) (liftA3 surroundBody (varDec v) b (returnState v)) inOutFunc n s p ins outs b = function n s p jArrayType - (map stateParam ins) (liftA2 appendToBody b (multi ( - varDecDef "outputs" jArrayType + (map stateParam ins) (liftA3 surroundBody decls b (multi (varDecDef "outputs" jArrayType (var ("new Object[" ++ show (length outs) ++ "]") jArrayType) : assignArray 0 outs ++ [returnVar "outputs" jArrayType]))) @@ -543,6 +542,7 @@ instance MethodSym JavaCode where assignArray _ [] = [] assignArray c (v:vs) = (var ("outputs[" ++ show c ++ "]") (fmap valType v) &= v) : assignArray (c+1) vs + decls = multi $ map varDec outs instance StateVarSym JavaCode where diff --git a/code/drasil-code/Language/Drasil/Code/Imperative/LanguageRenderer/PythonRenderer.hs b/code/drasil-code/Language/Drasil/Code/Imperative/LanguageRenderer/PythonRenderer.hs index 8796a384a9..b5a745259a 100644 --- a/code/drasil-code/Language/Drasil/Code/Imperative/LanguageRenderer/PythonRenderer.hs +++ b/code/drasil-code/Language/Drasil/Code/Imperative/LanguageRenderer/PythonRenderer.hs @@ -327,7 +327,7 @@ instance StatementSym PythonCode where (&++) v = mkStNoEnd <$> liftA2 plusPlusDocD' v plusOp (&~-) v = v &= (v #- litInt 1) - varDec _ _ = return (mkStNoEnd empty) + varDec _ = return (mkStNoEnd empty) varDecDef l _ v = mkStNoEnd <$> fmap (pyVarDecDef l) v listDec l _ t = mkStNoEnd <$> fmap (pyListDec l) (listType static_ t) listDecDef l _ vs = mkStNoEnd <$> fmap (pyListDecDef l) (liftList diff --git a/code/drasil-code/Language/Drasil/Code/Imperative/Symantics.hs b/code/drasil-code/Language/Drasil/Code/Imperative/Symantics.hs index 424e127276..aa144a0b68 100644 --- a/code/drasil-code/Language/Drasil/Code/Imperative/Symantics.hs +++ b/code/drasil-code/Language/Drasil/Code/Imperative/Symantics.hs @@ -333,7 +333,7 @@ class (ValueSym repr, Selector repr, SelectorFunction repr, FunctionSym repr) multiAssign :: [repr (Value repr)] -> [repr (Value repr)] -> repr (Statement repr) - varDec :: Label -> repr (StateType repr) -> repr (Statement repr) + varDec :: repr (Value repr) -> repr (Statement repr) varDecDef :: Label -> repr (StateType repr) -> repr (Value repr) -> repr (Statement repr) listDec :: Label -> Integer -> repr (StateType repr) -> diff --git a/code/drasil-code/Test/FileTests.hs b/code/drasil-code/Test/FileTests.hs index b000b8a72f..004f3f71b3 100644 --- a/code/drasil-code/Test/FileTests.hs +++ b/code/drasil-code/Test/FileTests.hs @@ -16,9 +16,9 @@ fileTestMethod = mainMethod "FileTests" (body [writeStory, block [readStory], writeStory :: (RenderSym repr) => repr (Block repr) writeStory = block [ varDecDef "e" int (litInt 5), - varDec "f" float, + varDec $ var "f" float, var "f" float &= castObj (cast float int) (var "e" int), - varDec "fileToWrite" outfile, + varDec $ var "fileToWrite" outfile, openFileW (var "fileToWrite" outfile) (litString "testText.txt"), printFile (var "fileToWrite" outfile) int (litInt 0), @@ -28,9 +28,9 @@ writeStory = block [ printFileStrLn (var "fileToWrite" outfile) "!!", closeFile (var "fileToWrite" outfile), - varDec "fileToRead" infile, + varDec $ var "fileToRead" infile, openFileR (var "fileToRead" infile) (litString "testText.txt"), - varDec "fileLine" string, + varDec $ var "fileLine" string, getFileInputLine (var "fileToRead" infile) (var "fileLine" string), discardFileLine (var "fileToRead" infile), listDec "fileContents" 0 (listType dynamic_ string)] diff --git a/code/drasil-code/Test/HelloWorld.hs b/code/drasil-code/Test/HelloWorld.hs index fa956000fb..d57fe4fc27 100644 --- a/code/drasil-code/Test/HelloWorld.hs +++ b/code/drasil-code/Test/HelloWorld.hs @@ -25,7 +25,7 @@ helloWorldMain = mainMethod "HelloWorld" (body [ helloInitVariables, helloInitVariables :: (RenderSym repr) => repr (Block repr) helloInitVariables = block [comment "Initializing variables", - varDec "a" int, + varDec $ var "a" int, varDecDef "b" int (litInt 5), listDecDef "myOtherList" (listType static_ float) [litFloat 1.0, litFloat 1.5], varDecDef "oneIndex" int (indexOf (var "myOtherList" (listType static_ float)) (litFloat 1.0)), @@ -34,7 +34,7 @@ helloInitVariables = block [comment "Initializing variables", valState (objAccess (var "myOtherList" (listType static_ float)) (listAdd (var "myOtherList" (listType static_ float)) (litInt 2) (litFloat 2.0))), valState (objAccess (var "myOtherList" (listType static_ float)) (listAppend (litFloat 2.5))), - varDec "e" float, + varDec $ var "e" float, var "e" int &= objAccess (var "myOtherList" (listType static_ float)) (listAccess float (litInt 1)), valState (objAccess (var "myOtherList" (listType static_ float)) (listSet (litInt 1) (litFloat 17.4))), listDec "myName" 7 (listType static_ string), @@ -50,8 +50,8 @@ helloListSlice = listSlice (listType static_ float) (var "mySlicedList" (listTyp helloIfBody :: (RenderSym repr) => repr (Body repr) helloIfBody = addComments "If body" (body [ block [ - varDec "c" int, - varDec "d" int, + varDec $ var "c" int, + varDec $ var "d" int, assign (var "a" int) (litInt 5), var "b" int &= (var "a" int #+ litInt 2), var "c" int &= (var "b" int #+ litInt 3), diff --git a/code/drasil-code/Test/Helper.hs b/code/drasil-code/Test/Helper.hs index 1bac1bbbd5..5795ef22f0 100644 --- a/code/drasil-code/Test/Helper.hs +++ b/code/drasil-code/Test/Helper.hs @@ -13,7 +13,7 @@ doubleAndAdd :: (RenderSym repr) => repr (Method repr) doubleAndAdd = function "doubleAndAdd" public static_ (mState float) [stateParam $ var "num1" float, stateParam $ var "num2" float] (bodyStatements [ - varDec "doubledSum" float, + varDec $ var "doubledSum" float, var "doubledSum" float &= ((litFloat 2.0 #* var "num1" float) #+ (litFloat 2.0 #* var "num2" float)), returnVar "doubledSum" float]) \ No newline at end of file diff --git a/code/drasil-code/Test/PatternTest.hs b/code/drasil-code/Test/PatternTest.hs index 6cbf2268d1..6cb39964d9 100644 --- a/code/drasil-code/Test/PatternTest.hs +++ b/code/drasil-code/Test/PatternTest.hs @@ -13,7 +13,7 @@ patternTest = packMods "PatternTest" [fileDoc (buildModule "PatternTest" ["Obser patternTestMainMethod :: (RenderSym repr) => repr (Method repr) patternTestMainMethod = mainMethod "PatternTest" (body [block [ - varDec "n" int, + varDec $ var "n" int, initState "myFSM" "Off", changeState "myFSM" "On", checkState "myFSM" From f83de3a8c298f47c2a0258328afa48c328f85c58 Mon Sep 17 00:00:00 2001 From: Brooks MacLachlan Date: Wed, 26 Jun 2019 17:06:42 -0400 Subject: [PATCH 02/11] Updated stable --- code/stable/nopcm/src/cpp/Control.cpp | 28 +++++++++---------- code/stable/nopcm/src/csharp/Control.cs | 28 +++++++++---------- code/stable/nopcm/src/java/SWHS/Control.java | 28 +++++++++---------- .../nopcm/src/java/SWHS/InputFormat.java | 15 ++++++++++ 4 files changed, 57 insertions(+), 42 deletions(-) diff --git a/code/stable/nopcm/src/cpp/Control.cpp b/code/stable/nopcm/src/cpp/Control.cpp index b69fc5c030..b3843d5aec 100644 --- a/code/stable/nopcm/src/cpp/Control.cpp +++ b/code/stable/nopcm/src/cpp/Control.cpp @@ -19,20 +19,20 @@ using std::ofstream; int main(int argc, const char *argv[]) { string filename = argv[1]; - double A_C; - double C_W; - double h_C; - double T_init; - double t_final; - double L; - double T_C; - double t_step; - double rho_W; - double D; - double A_tol; - double R_tol; - double T_W; - double E_W; + double inParams.A_C; + double inParams.C_W; + double inParams.h_C; + double inParams.T_init; + double inParams.t_final; + double inParams.L; + double inParams.T_C; + double inParams.t_step; + double inParams.rho_W; + double inParams.D; + double inParams.A_tol; + double inParams.R_tol; + double inParams.T_W; + double inParams.E_W; get_input(filename, A_C, C_W, h_C, T_init, t_final, L, T_C, t_step, rho_W, D, A_tol, R_tol, T_W, E_W); input_constraints(A_C, C_W, h_C, T_init, t_final, L, T_C, t_step, rho_W, D, T_W, E_W); write_output(T_W, E_W); diff --git a/code/stable/nopcm/src/csharp/Control.cs b/code/stable/nopcm/src/csharp/Control.cs index 1a1d64c7c9..26f31e9429 100644 --- a/code/stable/nopcm/src/csharp/Control.cs +++ b/code/stable/nopcm/src/csharp/Control.cs @@ -7,20 +7,20 @@ public class Control { public static void Main(string[] args) { string filename = args[0]; - double A_C; - double C_W; - double h_C; - double T_init; - double t_final; - double L; - double T_C; - double t_step; - double rho_W; - double D; - double A_tol; - double R_tol; - double T_W; - double E_W; + double inParams.A_C; + double inParams.C_W; + double inParams.h_C; + double inParams.T_init; + double inParams.t_final; + double inParams.L; + double inParams.T_C; + double inParams.t_step; + double inParams.rho_W; + double inParams.D; + double inParams.A_tol; + double inParams.R_tol; + double inParams.T_W; + double inParams.E_W; InputFormat.get_input(filename, ref A_C, ref C_W, ref h_C, ref T_init, ref t_final, ref L, ref T_C, ref t_step, ref rho_W, ref D, ref A_tol, ref R_tol, ref T_W, ref E_W); InputParameters.input_constraints(A_C, C_W, h_C, T_init, t_final, L, T_C, t_step, rho_W, D, T_W, E_W); OutputFormat.write_output(T_W, E_W); diff --git a/code/stable/nopcm/src/java/SWHS/Control.java b/code/stable/nopcm/src/java/SWHS/Control.java index 6cc4b74a40..b31a60478d 100644 --- a/code/stable/nopcm/src/java/SWHS/Control.java +++ b/code/stable/nopcm/src/java/SWHS/Control.java @@ -12,20 +12,20 @@ public class Control { public static void main(String[] args) throws Exception { String filename = args[0]; - double A_C; - double C_W; - double h_C; - double T_init; - double t_final; - double L; - double T_C; - double t_step; - double rho_W; - double D; - double A_tol; - double R_tol; - double T_W; - double E_W; + double inParams.A_C; + double inParams.C_W; + double inParams.h_C; + double inParams.T_init; + double inParams.t_final; + double inParams.L; + double inParams.T_C; + double inParams.t_step; + double inParams.rho_W; + double inParams.D; + double inParams.A_tol; + double inParams.R_tol; + double inParams.T_W; + double inParams.E_W; Object[] outputs = InputFormat.get_input(filename); A_C = (double)(outputs[0]); C_W = (double)(outputs[1]); diff --git a/code/stable/nopcm/src/java/SWHS/InputFormat.java b/code/stable/nopcm/src/java/SWHS/InputFormat.java index 366356f0b5..9cb4e4912f 100644 --- a/code/stable/nopcm/src/java/SWHS/InputFormat.java +++ b/code/stable/nopcm/src/java/SWHS/InputFormat.java @@ -11,6 +11,21 @@ public class InputFormat { public static Object[] get_input(String filename) throws Exception { + double A_C; + double C_W; + double h_C; + double T_init; + double t_final; + double L; + double T_C; + double t_step; + double rho_W; + double D; + double A_tol; + double R_tol; + double T_W; + double E_W; + Scanner infile; String line; ArrayList lines = new ArrayList(0); From dc0d3316c5194be7b2c8e286ba2421486c02f70c Mon Sep 17 00:00:00 2001 From: Brooks MacLachlan Date: Wed, 26 Jun 2019 13:11:30 -0400 Subject: [PATCH 03/11] Renamed Loose and AsClass to Unbundled and Bundled --- .../Language/Drasil/Code/Imperative/Import.hs | 20 ++++++------- code/drasil-code/Language/Drasil/CodeSpec.hs | 30 +++++++++---------- .../drasil-example/Drasil/GamePhysics/Main.hs | 2 +- code/drasil-example/Drasil/GlassBR/Main.hs | 2 +- code/drasil-example/Drasil/HGHC/Main.hs | 2 +- code/drasil-example/Drasil/NoPCM/Main.hs | 2 +- code/drasil-example/Drasil/SSP/Main.hs | 2 +- code/drasil-example/Drasil/SWHS/Generate.hs | 2 +- 8 files changed, 31 insertions(+), 31 deletions(-) diff --git a/code/drasil-code/Language/Drasil/Code/Imperative/Import.hs b/code/drasil-code/Language/Drasil/Code/Imperative/Import.hs index 6c272e2a2b..c3ade23e65 100644 --- a/code/drasil-code/Language/Drasil/Code/Imperative/Import.hs +++ b/code/drasil-code/Language/Drasil/Code/Imperative/Import.hs @@ -66,8 +66,8 @@ chooseConstr Exception = constrExc chooseInStructure :: (RenderSym repr) => Structure -> Reader (State repr) [repr (Module repr)] -chooseInStructure Loose = genInputModNoClass -chooseInStructure AsClass = genInputModClass +chooseInStructure Unbundled = genInputModNoClass +chooseInStructure Bundled = genInputModClass chooseLogging :: (RenderSym repr) => Logging -> (repr (Value repr) -> repr (Value repr) -> Reader (State repr) (repr (Statement repr))) @@ -477,10 +477,10 @@ getInputDecl = do getDecl :: (RenderSym repr) => Structure -> [CodeChunk] -> Reader (State repr) (Maybe (repr (Statement repr))) getDecl _ [] = return Nothing - getDecl Loose ins = do + getDecl Unbundled ins = do vals <- mapM (\x -> variable (codeName x) (convType $ codeType x)) ins return $ Just $ multi $ map varDec vals - getDecl AsClass _ = return $ Just $ extObjDecNewVoid l_params + getDecl Bundled _ = return $ Just $ extObjDecNewVoid l_params "InputParameters" (obj "InputParameters") getDecl (inStruct g) (inputs $ codeSpec g) @@ -544,8 +544,8 @@ getInputFormatIns :: (RenderSym repr) => Reader (State repr) getInputFormatIns = do g <- ask let getIns :: (RenderSym repr) => Structure -> [repr (Value repr)] - getIns Loose = [] - getIns AsClass = [var "inParams" (obj "InputParameters")] + getIns Unbundled = [] + getIns Bundled = [var "inParams" (obj "InputParameters")] return $ var "filename" string : getIns (inStruct g) getInputFormatOuts :: (RenderSym repr) => Reader (State repr) @@ -553,8 +553,8 @@ getInputFormatOuts :: (RenderSym repr) => Reader (State repr) getInputFormatOuts = do g <- ask let getOuts :: (RenderSym repr) => Structure -> [repr (Value repr)] - getOuts Loose = toValues $ extInputs $ csi $ codeSpec g - getOuts AsClass = [] + getOuts Unbundled = toValues $ extInputs $ csi $ codeSpec g + getOuts Bundled = [] return $ getOuts (inStruct g) toValues :: (RenderSym repr) => [CodeChunk] -> [repr (Value repr)] @@ -671,8 +671,8 @@ mkParam p = PD (paramFunc (codeType p) $ var pName pType) pType pName getInputParams :: (RenderSym repr) => Structure -> [CodeChunk] -> [ParamData repr] getInputParams _ [] = [] -getInputParams Loose cs = map mkParam cs -getInputParams AsClass _ = [PD (pointerParam $ var pName pType) pType pName] +getInputParams Unbundled cs = map mkParam cs +getInputParams Bundled _ = [PD (pointerParam $ var pName pType) pType pName] where pName = "inParams" pType = obj "InputParameters" diff --git a/code/drasil-code/Language/Drasil/CodeSpec.hs b/code/drasil-code/Language/Drasil/CodeSpec.hs index 492a0541ab..98d0899cbd 100644 --- a/code/drasil-code/Language/Drasil/CodeSpec.hs +++ b/code/drasil-code/Language/Drasil/CodeSpec.hs @@ -146,8 +146,8 @@ data Comments = CommentNone data ConstraintBehaviour = Warning | Exception -data Structure = Loose - | AsClass +data Structure = Unbundled + | Bundled defaultChoices :: Choices defaultChoices = Choices { @@ -158,7 +158,7 @@ defaultChoices = Choices { comments = CommentNone, onSfwrConstraint = Exception, onPhysConstraint = Warning, - inputStructure = AsClass + inputStructure = Bundled } type Name = String @@ -356,20 +356,20 @@ type Export = (String, String) getExportInput :: Choices -> [Input] -> [Export] getExportInput _ [] = [] getExportInput chs ins = inExp $ inputStructure chs - where inExp Loose = [] - inExp AsClass = map codeName ins `zip` repeat "InputParameters" + where inExp Unbundled = [] + inExp Bundled = map codeName ins `zip` repeat "InputParameters" getExportDerived :: Choices -> [Derived] -> [Export] getExportDerived _ [] = [] getExportDerived chs _ = [("derived_values", dMod $ inputStructure chs)] - where dMod Loose = "InputParameters" - dMod AsClass = "DerivedValues" + where dMod Unbundled = "InputParameters" + dMod Bundled = "DerivedValues" getExportConstraints :: Choices -> [Constraint] -> [Export] getExportConstraints _ [] = [] getExportConstraints chs _ = [("input_constraints", cMod $ inputStructure chs)] - where cMod Loose = "InputParameters" - cMod AsClass = "InputConstraints" + where cMod Unbundled = "InputParameters" + cMod Bundled = "InputConstraints" getExportInputFormat :: [Input] -> [Export] getExportInputFormat [] = [] @@ -393,16 +393,16 @@ getDepsControl cs mem = getDepsDerived :: CodeSystInfo -> ModExportMap -> Choices -> Maybe (String, [String]) getDepsDerived cs mem chs = derivedDeps $ inputStructure chs - where derivedDeps Loose = Nothing - derivedDeps AsClass = Just ("DerivedValues", nub $ mapMaybe ( + where derivedDeps Unbundled = Nothing + derivedDeps Bundled = Just ("DerivedValues", nub $ mapMaybe ( (`Map.lookup` mem) . codeName) (concatMap (flip codevars (sysinfodb cs) . codeEquat) (derivedInputs cs))) getDepsConstraints :: CodeSystInfo -> ModExportMap -> Choices -> Maybe (String, [String]) getDepsConstraints cs mem chs = constraintDeps $ inputStructure chs - where constraintDeps Loose = Nothing - constraintDeps AsClass = Just ("InputConstraints", nub $ mapMaybe ( + where constraintDeps Unbundled = Nothing + constraintDeps Bundled = Just ("InputConstraints", nub $ mapMaybe ( (`Map.lookup` mem) .codeName) reqdVals) ins = extInputs cs ++ map codevar (derivedInputs cs) cm = cMap cs @@ -412,8 +412,8 @@ getDepsConstraints cs mem chs = constraintDeps $ inputStructure chs getDepsInFormat :: Choices -> Maybe (String, [String]) getDepsInFormat chs = inFormatDeps $ inputStructure chs - where inFormatDeps Loose = Nothing - inFormatDeps AsClass = Just ("InputFormat", ["InputParameters"]) + where inFormatDeps Unbundled = Nothing + inFormatDeps Bundled = Just ("InputFormat", ["InputParameters"]) subsetOf :: (Eq a) => [a] -> [a] -> Bool xs `subsetOf` ys = all (`elem` ys) xs diff --git a/code/drasil-example/Drasil/GamePhysics/Main.hs b/code/drasil-example/Drasil/GamePhysics/Main.hs index 012d2d0bb7..9b23c426c1 100644 --- a/code/drasil-example/Drasil/GamePhysics/Main.hs +++ b/code/drasil-example/Drasil/GamePhysics/Main.hs @@ -20,7 +20,7 @@ import Drasil.GamePhysics.Body (srs, printSetting) -- sysInfo -- comments = CommentNone, -- onSfwrConstraint = Warning, -- onPhysConstraint = Warning, --- inputStructure = Loose +-- inputStructure = Unbundled -- } main :: IO () diff --git a/code/drasil-example/Drasil/GlassBR/Main.hs b/code/drasil-example/Drasil/GlassBR/Main.hs index 03cc82f811..5d8c5b7b65 100644 --- a/code/drasil-example/Drasil/GlassBR/Main.hs +++ b/code/drasil-example/Drasil/GlassBR/Main.hs @@ -21,7 +21,7 @@ choices = Choices { comments = CommentNone, onSfwrConstraint = Exception, onPhysConstraint = Exception, - inputStructure = AsClass + inputStructure = Bundled } main :: IO() diff --git a/code/drasil-example/Drasil/HGHC/Main.hs b/code/drasil-example/Drasil/HGHC/Main.hs index 343cffbe9d..84918be0e3 100644 --- a/code/drasil-example/Drasil/HGHC/Main.hs +++ b/code/drasil-example/Drasil/HGHC/Main.hs @@ -21,7 +21,7 @@ thisChoices = Choices { comments = CommentNone, onSfwrConstraint = Warning, onPhysConstraint = Warning, - inputStructure = AsClass + inputStructure = Bundled } -} main :: IO () diff --git a/code/drasil-example/Drasil/NoPCM/Main.hs b/code/drasil-example/Drasil/NoPCM/Main.hs index 784525bddb..0d110cb6a3 100644 --- a/code/drasil-example/Drasil/NoPCM/Main.hs +++ b/code/drasil-example/Drasil/NoPCM/Main.hs @@ -21,7 +21,7 @@ choices = Choices { comments = CommentNone, onSfwrConstraint = Warning, onPhysConstraint = Warning, - inputStructure = Loose + inputStructure = Unbundled } main :: IO () diff --git a/code/drasil-example/Drasil/SSP/Main.hs b/code/drasil-example/Drasil/SSP/Main.hs index 09bf07222e..9a8201a793 100644 --- a/code/drasil-example/Drasil/SSP/Main.hs +++ b/code/drasil-example/Drasil/SSP/Main.hs @@ -20,7 +20,7 @@ import Drasil.SSP.Body (srs, printSetting) -- si -- comments = CommentNone, -- CommentNone, CommentFunc -- onSfwrConstraint = Warning, -- Warning, Exception -- onPhysConstraint = Warning, -- Warning, Exception --- inputStructure = Loose -- Loose, AsClass +-- inputStructure = Unbundled -- Unbundled, Bundled -- } main :: IO () diff --git a/code/drasil-example/Drasil/SWHS/Generate.hs b/code/drasil-example/Drasil/SWHS/Generate.hs index 2151e75b9e..81e019fb76 100644 --- a/code/drasil-example/Drasil/SWHS/Generate.hs +++ b/code/drasil-example/Drasil/SWHS/Generate.hs @@ -20,7 +20,7 @@ import Drasil.SWHS.Body (srs', printSetting) -- si -- comments = CommentNone, -- CommentNone, CommentFunc -- onSfwrConstraint = Warning, -- Warning, Exception -- onPhysConstraint = Warning, -- Warning, Exception --- inputStructure = Loose -- Loose, AsClass +-- inputStructure = Unbundled -- Unbundled, Bundled -- } generate :: IO () From 9bfdfb2d6280ed7b4d279db9761cd974c0a8d389 Mon Sep 17 00:00:00 2001 From: Brooks MacLachlan Date: Wed, 26 Jun 2019 13:32:16 -0400 Subject: [PATCH 04/11] Only reference inParams if Bundled option is used --- .../Language/Drasil/Code/Imperative/Import.hs | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/code/drasil-code/Language/Drasil/Code/Imperative/Import.hs b/code/drasil-code/Language/Drasil/Code/Imperative/Import.hs index c3ade23e65..7bde4e69bd 100644 --- a/code/drasil-code/Language/Drasil/Code/Imperative/Import.hs +++ b/code/drasil-code/Language/Drasil/Code/Imperative/Import.hs @@ -623,10 +623,15 @@ variable s' t' = do Reader (State repr) (repr (Value repr)) doit s t | member s mm = maybe (error "impossible") (convExpr . codeEquat) (Map.lookup s mm) --extvar "Constants" s - | s `elem` map codeName (inputs cs) = return $ var "inParams" - (obj "InputParameters") $-> var s t + | s `elem` map codeName (inputs cs) = return $ inputVariable + (inStruct g) s t | otherwise = return $ var s t doit s' t' + +inputVariable :: (RenderSym repr) => Structure -> String -> + repr (StateType repr) -> repr (Value repr) +inputVariable Unbundled s t = var s t +inputVariable Bundled s t = var "inParams" (obj "InputParameters") $-> var s t fApp :: (RenderSym repr) => String -> String -> repr (StateType repr) -> [repr (Value repr)] -> Reader (State repr) (repr (Value repr)) From da2023b1a95fda02da460dcd66a6ebb192a396ce Mon Sep 17 00:00:00 2001 From: Brooks MacLachlan Date: Wed, 26 Jun 2019 17:24:39 -0400 Subject: [PATCH 05/11] Use ref and out keywords appropriately in C# --- .../Code/Imperative/LanguageRenderer/CSharpRenderer.hs | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/code/drasil-code/Language/Drasil/Code/Imperative/LanguageRenderer/CSharpRenderer.hs b/code/drasil-code/Language/Drasil/Code/Imperative/LanguageRenderer/CSharpRenderer.hs index c7ea8ef06e..f4650a9f3b 100644 --- a/code/drasil-code/Language/Drasil/Code/Imperative/LanguageRenderer/CSharpRenderer.hs +++ b/code/drasil-code/Language/Drasil/Code/Imperative/LanguageRenderer/CSharpRenderer.hs @@ -521,9 +521,9 @@ instance MethodSym CSharpCode where inOutFunc n s p ins [v] b = function n s p (mState (fmap valType v)) (map stateParam ins) (liftA3 surroundBody (varDec v) b (returnState v)) - inOutFunc n s p ins outs b = function n s p (mState void) (nub $ map (\v -> + inOutFunc n s p ins outs b = function n s p (mState void) (map (\v -> if v `elem` outs then fmap csRef (stateParam v) else stateParam v) ins ++ - map (fmap csRef . stateParam) outs) b + map (fmap csOut . stateParam) (filter (`notElem` ins) outs)) b instance StateVarSym CSharpCode where type StateVar CSharpCode = Doc @@ -602,6 +602,9 @@ csOpenFileWorA f n w a = valDoc f <+> equals <+> new <+> typeDoc w <> csRef :: Doc -> Doc csRef p = text "ref" <+> p +csOut :: Doc -> Doc +csOut p = text "out" <+> p + csInOutCall :: (Label -> CSharpCode (StateType CSharpCode) -> [CSharpCode (Value CSharpCode)] -> CSharpCode (Value CSharpCode)) -> Label -> [CSharpCode (Value CSharpCode)] -> [CSharpCode (Value CSharpCode)] -> @@ -609,4 +612,4 @@ csInOutCall :: (Label -> CSharpCode (StateType CSharpCode) -> csInOutCall f n ins [out] = assign out $ f n (fmap valType out) ins csInOutCall f n ins outs = valState $ f n void (nub $ map (\v -> if v `elem` outs then fmap (updateValDoc csRef) v else v) ins ++ - map (fmap (updateValDoc csRef)) outs) \ No newline at end of file + map (fmap (updateValDoc csOut)) (filter (`notElem` ins) outs)) \ No newline at end of file From d1beb1c455b964933797bc41846cea2428263967 Mon Sep 17 00:00:00 2001 From: Brooks MacLachlan Date: Wed, 26 Jun 2019 17:25:20 -0400 Subject: [PATCH 06/11] Add input file for NoPCM and update makefile to build NoPCM --- code/Makefile | 35 ++++++++++------------------------ code/datafiles/NoPCM/input.txt | 28 +++++++++++++++++++++++++++ 2 files changed, 38 insertions(+), 25 deletions(-) create mode 100644 code/datafiles/NoPCM/input.txt diff --git a/code/Makefile b/code/Makefile index e98c42bda2..f55bf5c84e 100644 --- a/code/Makefile +++ b/code/Makefile @@ -16,7 +16,8 @@ PACKAGE_GEN_TARGET = BUILD DOC GRAPH ##### # Current list of examples -EXAMPLES = tiny glassbr nopcm swhs ssp gamephys projectile template +SRC_EXAMPLES = glassbr nopcm +EXAMPLES = $(SRC_EXAMPLES) tiny swhs ssp gamephys projectile template # where they live TINY_DIR = Tiny @@ -48,7 +49,7 @@ DCP_E_SUFFIX = _deploy_code_path GEN_EXAMPLES = $(addsuffix $(GEN_E_SUFFIX), $(EXAMPLES)) TEST_EXAMPLES = $(addsuffix $(TEST_E_SUFFIX), $(EXAMPLES)) -MOVE_DF_EXAMPLES = $(addsuffix $(MOVE_DF_E_SUFFIX), $(EXAMPLES)) +MOVE_DF_EXAMPLES = $(addsuffix $(MOVE_DF_E_SUFFIX), $(SRC_EXAMPLES)) TEX_EXAMPLES = $(addsuffix $(TEX_E_SUFFIX), $(EXAMPLES)) CODE_EXAMPLES = $(addsuffix $(CODE_E_SUFFIX), $(EXAMPLES)) DCP_EXAMPLES = $(addsuffix $(DCP_E_SUFFIX), $(EXAMPLES)) @@ -144,14 +145,13 @@ $(filter %$(GRAPH_P_SUFFIX), $(GRAPH_PACKAGES)): %$(GRAPH_P_SUFFIX): check_stack graphs: $(GRAPH_PACKAGES) ### +%$(MOVE_DF_E_SUFFIX): EXAMPLE=$(shell echo $* | tr a-z A-Z) +%$(MOVE_DF_E_SUFFIX): EDIR=$($(EXAMPLE)_DIR) $(filter %$(MOVE_DF_E_SUFFIX), $(MOVE_DF_EXAMPLES)): %$(MOVE_DF_E_SUFFIX): %$(GEN_E_SUFFIX) - -# GlassBR is odd, so it needs some special rules just for itself -$(GLASSBR_EXE)$(MOVE_DF_E_SUFFIX): $(GLASSBR_EXE)$(GEN_E_SUFFIX) - test -d $(BUILD_FOLDER)$(GLASSBR_DIR)/$(EXAMPLE_CODE_SUBFOLDER)python && cp ./datafiles/$(GLASSBR_DIR)/*.txt $(BUILD_FOLDER)$(GLASSBR_DIR)/$(EXAMPLE_CODE_SUBFOLDER)python/ - test -d $(BUILD_FOLDER)$(GLASSBR_DIR)/$(EXAMPLE_CODE_SUBFOLDER)java && cp ./datafiles/$(GLASSBR_DIR)/*.txt $(BUILD_FOLDER)$(GLASSBR_DIR)/$(EXAMPLE_CODE_SUBFOLDER)java/ - test -d $(BUILD_FOLDER)$(GLASSBR_DIR)/$(EXAMPLE_CODE_SUBFOLDER)csharp && cp ./datafiles/$(GLASSBR_DIR)/*.txt $(BUILD_FOLDER)$(GLASSBR_DIR)/$(EXAMPLE_CODE_SUBFOLDER)csharp/ - test -d $(BUILD_FOLDER)$(GLASSBR_DIR)/$(EXAMPLE_CODE_SUBFOLDER)cpp && cp ./datafiles/$(GLASSBR_DIR)/*.txt $(BUILD_FOLDER)$(GLASSBR_DIR)/$(EXAMPLE_CODE_SUBFOLDER)cpp/ + test -d $(BUILD_FOLDER)$(EDIR)/$(EXAMPLE_CODE_SUBFOLDER)python && cp ./datafiles/$(EDIR)/*.txt $(BUILD_FOLDER)$(EDIR)/$(EXAMPLE_CODE_SUBFOLDER)python/ + test -d $(BUILD_FOLDER)$(EDIR)/$(EXAMPLE_CODE_SUBFOLDER)java && cp ./datafiles/$(EDIR)/*.txt $(BUILD_FOLDER)$(EDIR)/$(EXAMPLE_CODE_SUBFOLDER)java/ + test -d $(BUILD_FOLDER)$(EDIR)/$(EXAMPLE_CODE_SUBFOLDER)csharp && cp ./datafiles/$(EDIR)/*.txt $(BUILD_FOLDER)$(EDIR)/$(EXAMPLE_CODE_SUBFOLDER)csharp/ + test -d $(BUILD_FOLDER)$(EDIR)/$(EXAMPLE_CODE_SUBFOLDER)cpp && cp ./datafiles/$(EDIR)/*.txt $(BUILD_FOLDER)$(EDIR)/$(EXAMPLE_CODE_SUBFOLDER)cpp/ prog: $(MOVE_DF_EXAMPLES) @@ -171,22 +171,7 @@ tex: $(TEX_EXAMPLES) %$(CODE_E_SUFFIX): EXAMPLE=$(shell echo $* | tr a-z A-Z) %$(CODE_E_SUFFIX): EDIR=$($(EXAMPLE)_DIR) $(filter %$(CODE_E_SUFFIX), $(CODE_EXAMPLES)): %$(CODE_E_SUFFIX): %$(MOVE_DF_E_SUFFIX) - @EDIR=$(EDIR) BUILD_FOLDER=$(BUILD_FOLDER) EXAMPLE_CODE_SUBFOLDER=$(EXAMPLE_CODE_SUBFOLDER) MAKE="$(MAKE)" "$(SHELL)" $(SCRIPT_FOLDER)code_build.sh; \ - # If you're reading this comment because you got NoPCM working, then you should remove everything below this line until the next target. \ - # (Next line with zero idents) Additionally you should remove the "; \" from the line immediately preceeding the comment on the previous line. \ - RET=$$?; \ - if [ $* = $(NOPCM_EXE) ]; then \ - if [ $$RET != 0 ]; then \ - echo "$(NOPCM_DIR) failed to compile as expected. Letting it slide...for now."; \ - exit 0; \ - else \ - echo "$(NOPCM_DIR) surprisingly did not fail to compile!"; \ - echo "Failing this build because you should check the Drasil makefile and alter the code as indicated by the comment for the currently invoked target"; \ - exit 1; \ - fi; \ - else \ - exit $$RET; \ - fi + @EDIR=$(EDIR) BUILD_FOLDER=$(BUILD_FOLDER) EXAMPLE_CODE_SUBFOLDER=$(EXAMPLE_CODE_SUBFOLDER) MAKE="$(MAKE)" "$(SHELL)" $(SCRIPT_FOLDER)code_build.sh code: $(CODE_EXAMPLES) diff --git a/code/datafiles/NoPCM/input.txt b/code/datafiles/NoPCM/input.txt new file mode 100644 index 0000000000..74da805004 --- /dev/null +++ b/code/datafiles/NoPCM/input.txt @@ -0,0 +1,28 @@ +#Ac (0.12) +0.12 +#C_w (4186.0) +4186.0 +#hc (1000.0) +1000.0 +#Tinit (40.0) +40.0 +#tfinal (50000) +50000 +#L (1.5) +1.5 +#Tc (50.0) +50.0 +#tstep (10.0) +10.0 +#rho_w (1000.0) +1000.0 +#diam (0.412) +0.412 +#AbsTol (1e-10) +1e-10 +#RelTol (1e-10) +1e-10 +#T_W (FIXME: Outputs as inputs hack) +40.0 +#E_W (FIXME: Outputs as inputs hack) +0 \ No newline at end of file From 51d85a9251e58ae8a929255b68bf4b73a717f344 Mon Sep 17 00:00:00 2001 From: Brooks MacLachlan Date: Wed, 26 Jun 2019 17:39:36 -0400 Subject: [PATCH 07/11] Updated stable --- code/stable/nopcm/src/cpp/Control.cpp | 28 +++++++-------- code/stable/nopcm/src/cpp/InputFormat.cpp | 28 +++++++-------- code/stable/nopcm/src/cpp/InputParameters.cpp | 36 +++++++++---------- code/stable/nopcm/src/cpp/OutputFormat.cpp | 4 +-- code/stable/nopcm/src/csharp/Control.cs | 30 ++++++++-------- code/stable/nopcm/src/csharp/InputFormat.cs | 30 ++++++++-------- .../nopcm/src/csharp/InputParameters.cs | 36 +++++++++---------- code/stable/nopcm/src/csharp/OutputFormat.cs | 4 +-- code/stable/nopcm/src/java/SWHS/Control.java | 28 +++++++-------- .../nopcm/src/java/SWHS/InputFormat.java | 28 +++++++-------- .../nopcm/src/java/SWHS/InputParameters.java | 36 +++++++++---------- .../nopcm/src/java/SWHS/OutputFormat.java | 4 +-- code/stable/nopcm/src/python/InputFormat.py | 28 +++++++-------- .../nopcm/src/python/InputParameters.py | 36 +++++++++---------- code/stable/nopcm/src/python/OutputFormat.py | 4 +-- 15 files changed, 180 insertions(+), 180 deletions(-) diff --git a/code/stable/nopcm/src/cpp/Control.cpp b/code/stable/nopcm/src/cpp/Control.cpp index b3843d5aec..b69fc5c030 100644 --- a/code/stable/nopcm/src/cpp/Control.cpp +++ b/code/stable/nopcm/src/cpp/Control.cpp @@ -19,20 +19,20 @@ using std::ofstream; int main(int argc, const char *argv[]) { string filename = argv[1]; - double inParams.A_C; - double inParams.C_W; - double inParams.h_C; - double inParams.T_init; - double inParams.t_final; - double inParams.L; - double inParams.T_C; - double inParams.t_step; - double inParams.rho_W; - double inParams.D; - double inParams.A_tol; - double inParams.R_tol; - double inParams.T_W; - double inParams.E_W; + double A_C; + double C_W; + double h_C; + double T_init; + double t_final; + double L; + double T_C; + double t_step; + double rho_W; + double D; + double A_tol; + double R_tol; + double T_W; + double E_W; get_input(filename, A_C, C_W, h_C, T_init, t_final, L, T_C, t_step, rho_W, D, A_tol, R_tol, T_W, E_W); input_constraints(A_C, C_W, h_C, T_init, t_final, L, T_C, t_step, rho_W, D, T_W, E_W); write_output(T_W, E_W); diff --git a/code/stable/nopcm/src/cpp/InputFormat.cpp b/code/stable/nopcm/src/cpp/InputFormat.cpp index 4713390c4b..9e0f4305a6 100644 --- a/code/stable/nopcm/src/cpp/InputFormat.cpp +++ b/code/stable/nopcm/src/cpp/InputFormat.cpp @@ -22,46 +22,46 @@ void get_input(string filename, double &A_C, double &C_W, double &h_C, double &T vector linetokens(0); infile.open(filename, std::fstream::in); infile.ignore(std::numeric_limits::max(), '\n'); - infile >> inParams.A_C; + infile >> A_C; infile.ignore(std::numeric_limits::max(), '\n'); infile.ignore(std::numeric_limits::max(), '\n'); - infile >> inParams.C_W; + infile >> C_W; infile.ignore(std::numeric_limits::max(), '\n'); infile.ignore(std::numeric_limits::max(), '\n'); - infile >> inParams.h_C; + infile >> h_C; infile.ignore(std::numeric_limits::max(), '\n'); infile.ignore(std::numeric_limits::max(), '\n'); - infile >> inParams.T_init; + infile >> T_init; infile.ignore(std::numeric_limits::max(), '\n'); infile.ignore(std::numeric_limits::max(), '\n'); - infile >> inParams.t_final; + infile >> t_final; infile.ignore(std::numeric_limits::max(), '\n'); infile.ignore(std::numeric_limits::max(), '\n'); - infile >> inParams.L; + infile >> L; infile.ignore(std::numeric_limits::max(), '\n'); infile.ignore(std::numeric_limits::max(), '\n'); - infile >> inParams.T_C; + infile >> T_C; infile.ignore(std::numeric_limits::max(), '\n'); infile.ignore(std::numeric_limits::max(), '\n'); - infile >> inParams.t_step; + infile >> t_step; infile.ignore(std::numeric_limits::max(), '\n'); infile.ignore(std::numeric_limits::max(), '\n'); - infile >> inParams.rho_W; + infile >> rho_W; infile.ignore(std::numeric_limits::max(), '\n'); infile.ignore(std::numeric_limits::max(), '\n'); - infile >> inParams.D; + infile >> D; infile.ignore(std::numeric_limits::max(), '\n'); infile.ignore(std::numeric_limits::max(), '\n'); - infile >> inParams.A_tol; + infile >> A_tol; infile.ignore(std::numeric_limits::max(), '\n'); infile.ignore(std::numeric_limits::max(), '\n'); - infile >> inParams.R_tol; + infile >> R_tol; infile.ignore(std::numeric_limits::max(), '\n'); infile.ignore(std::numeric_limits::max(), '\n'); - infile >> inParams.T_W; + infile >> T_W; infile.ignore(std::numeric_limits::max(), '\n'); infile.ignore(std::numeric_limits::max(), '\n'); - infile >> inParams.E_W; + infile >> E_W; infile.ignore(std::numeric_limits::max(), '\n'); infile.close(); } diff --git a/code/stable/nopcm/src/cpp/InputParameters.cpp b/code/stable/nopcm/src/cpp/InputParameters.cpp index 14236c03be..0418057484 100644 --- a/code/stable/nopcm/src/cpp/InputParameters.cpp +++ b/code/stable/nopcm/src/cpp/InputParameters.cpp @@ -16,59 +16,59 @@ using std::ifstream; using std::ofstream; void input_constraints(double A_C, double C_W, double h_C, double T_init, double t_final, double L, double T_C, double t_step, double rho_W, double D, double T_W, double E_W) { - if (!((inParams.A_C <= 100000))) { + if (!((A_C <= 100000))) { std::cout << "Warning: constraint violated" << std::endl; } - if (!(((4170 < inParams.C_W) && (inParams.C_W < 4210)))) { + if (!(((4170 < C_W) && (C_W < 4210)))) { std::cout << "Warning: constraint violated" << std::endl; } - if (!(((10 <= inParams.h_C) && (inParams.h_C <= 10000)))) { + if (!(((10 <= h_C) && (h_C <= 10000)))) { std::cout << "Warning: constraint violated" << std::endl; } - if (!((inParams.t_final < 86400))) { + if (!((t_final < 86400))) { std::cout << "Warning: constraint violated" << std::endl; } - if (!(((0.1 <= inParams.L) && (inParams.L <= 50)))) { + if (!(((0.1 <= L) && (L <= 50)))) { std::cout << "Warning: constraint violated" << std::endl; } - if (!(((950 < inParams.rho_W) && (inParams.rho_W <= 1000)))) { + if (!(((950 < rho_W) && (rho_W <= 1000)))) { std::cout << "Warning: constraint violated" << std::endl; } - if (!((inParams.A_C > 0))) { + if (!((A_C > 0))) { std::cout << "Warning: constraint violated" << std::endl; } - if (!((inParams.C_W > 0))) { + if (!((C_W > 0))) { std::cout << "Warning: constraint violated" << std::endl; } - if (!((inParams.h_C > 0))) { + if (!((h_C > 0))) { std::cout << "Warning: constraint violated" << std::endl; } - if (!(((0 < inParams.T_init) && (inParams.T_init < 100)))) { + if (!(((0 < T_init) && (T_init < 100)))) { std::cout << "Warning: constraint violated" << std::endl; } - if (!((inParams.t_final > 0))) { + if (!((t_final > 0))) { std::cout << "Warning: constraint violated" << std::endl; } - if (!((inParams.L > 0))) { + if (!((L > 0))) { std::cout << "Warning: constraint violated" << std::endl; } - if (!(((0 < inParams.T_C) && (inParams.T_C < 100)))) { + if (!(((0 < T_C) && (T_C < 100)))) { std::cout << "Warning: constraint violated" << std::endl; } - if (!(((0 < inParams.t_step) && (inParams.t_step < inParams.t_final)))) { + if (!(((0 < t_step) && (t_step < t_final)))) { std::cout << "Warning: constraint violated" << std::endl; } - if (!((inParams.rho_W > 0))) { + if (!((rho_W > 0))) { std::cout << "Warning: constraint violated" << std::endl; } - if (!((inParams.D > 0))) { + if (!((D > 0))) { std::cout << "Warning: constraint violated" << std::endl; } - if (!(((inParams.T_init <= inParams.T_W) && (inParams.T_W <= inParams.T_C)))) { + if (!(((T_init <= T_W) && (T_W <= T_C)))) { std::cout << "Warning: constraint violated" << std::endl; } - if (!((inParams.E_W >= 0))) { + if (!((E_W >= 0))) { std::cout << "Warning: constraint violated" << std::endl; } } diff --git a/code/stable/nopcm/src/cpp/OutputFormat.cpp b/code/stable/nopcm/src/cpp/OutputFormat.cpp index 642859bf9e..29b29a4ec2 100644 --- a/code/stable/nopcm/src/cpp/OutputFormat.cpp +++ b/code/stable/nopcm/src/cpp/OutputFormat.cpp @@ -19,9 +19,9 @@ void write_output(double T_W, double E_W) { ofstream outputfile; outputfile.open("output.txt", std::fstream::out); outputfile << "T_W = "; - outputfile << inParams.T_W << std::endl; + outputfile << T_W << std::endl; outputfile << "E_W = "; - outputfile << inParams.E_W << std::endl; + outputfile << E_W << std::endl; outputfile.close(); } diff --git a/code/stable/nopcm/src/csharp/Control.cs b/code/stable/nopcm/src/csharp/Control.cs index 26f31e9429..d6e219f6d3 100644 --- a/code/stable/nopcm/src/csharp/Control.cs +++ b/code/stable/nopcm/src/csharp/Control.cs @@ -7,21 +7,21 @@ public class Control { public static void Main(string[] args) { string filename = args[0]; - double inParams.A_C; - double inParams.C_W; - double inParams.h_C; - double inParams.T_init; - double inParams.t_final; - double inParams.L; - double inParams.T_C; - double inParams.t_step; - double inParams.rho_W; - double inParams.D; - double inParams.A_tol; - double inParams.R_tol; - double inParams.T_W; - double inParams.E_W; - InputFormat.get_input(filename, ref A_C, ref C_W, ref h_C, ref T_init, ref t_final, ref L, ref T_C, ref t_step, ref rho_W, ref D, ref A_tol, ref R_tol, ref T_W, ref E_W); + double A_C; + double C_W; + double h_C; + double T_init; + double t_final; + double L; + double T_C; + double t_step; + double rho_W; + double D; + double A_tol; + double R_tol; + double T_W; + double E_W; + InputFormat.get_input(filename, out A_C, out C_W, out h_C, out T_init, out t_final, out L, out T_C, out t_step, out rho_W, out D, out A_tol, out R_tol, out T_W, out E_W); InputParameters.input_constraints(A_C, C_W, h_C, T_init, t_final, L, T_C, t_step, rho_W, D, T_W, E_W); OutputFormat.write_output(T_W, E_W); } diff --git a/code/stable/nopcm/src/csharp/InputFormat.cs b/code/stable/nopcm/src/csharp/InputFormat.cs index 035f2a59d8..d498958afb 100644 --- a/code/stable/nopcm/src/csharp/InputFormat.cs +++ b/code/stable/nopcm/src/csharp/InputFormat.cs @@ -5,40 +5,40 @@ public class InputFormat { - public static void get_input(string filename, ref double A_C, ref double C_W, ref double h_C, ref double T_init, ref double t_final, ref double L, ref double T_C, ref double t_step, ref double rho_W, ref double D, ref double A_tol, ref double R_tol, ref double T_W, ref double E_W) { + public static void get_input(string filename, out double A_C, out double C_W, out double h_C, out double T_init, out double t_final, out double L, out double T_C, out double t_step, out double rho_W, out double D, out double A_tol, out double R_tol, out double T_W, out double E_W) { StreamReader infile; string line; List lines = new List(0); List linetokens = new List(0); infile = new StreamReader(filename); infile.ReadLine(); - inParams.A_C = Double.Parse(infile.ReadLine()); + A_C = Double.Parse(infile.ReadLine()); infile.ReadLine(); - inParams.C_W = Double.Parse(infile.ReadLine()); + C_W = Double.Parse(infile.ReadLine()); infile.ReadLine(); - inParams.h_C = Double.Parse(infile.ReadLine()); + h_C = Double.Parse(infile.ReadLine()); infile.ReadLine(); - inParams.T_init = Double.Parse(infile.ReadLine()); + T_init = Double.Parse(infile.ReadLine()); infile.ReadLine(); - inParams.t_final = Double.Parse(infile.ReadLine()); + t_final = Double.Parse(infile.ReadLine()); infile.ReadLine(); - inParams.L = Double.Parse(infile.ReadLine()); + L = Double.Parse(infile.ReadLine()); infile.ReadLine(); - inParams.T_C = Double.Parse(infile.ReadLine()); + T_C = Double.Parse(infile.ReadLine()); infile.ReadLine(); - inParams.t_step = Double.Parse(infile.ReadLine()); + t_step = Double.Parse(infile.ReadLine()); infile.ReadLine(); - inParams.rho_W = Double.Parse(infile.ReadLine()); + rho_W = Double.Parse(infile.ReadLine()); infile.ReadLine(); - inParams.D = Double.Parse(infile.ReadLine()); + D = Double.Parse(infile.ReadLine()); infile.ReadLine(); - inParams.A_tol = Double.Parse(infile.ReadLine()); + A_tol = Double.Parse(infile.ReadLine()); infile.ReadLine(); - inParams.R_tol = Double.Parse(infile.ReadLine()); + R_tol = Double.Parse(infile.ReadLine()); infile.ReadLine(); - inParams.T_W = Double.Parse(infile.ReadLine()); + T_W = Double.Parse(infile.ReadLine()); infile.ReadLine(); - inParams.E_W = Double.Parse(infile.ReadLine()); + E_W = Double.Parse(infile.ReadLine()); infile.Close(); } } diff --git a/code/stable/nopcm/src/csharp/InputParameters.cs b/code/stable/nopcm/src/csharp/InputParameters.cs index 9bb131b5f5..4ef06964dc 100644 --- a/code/stable/nopcm/src/csharp/InputParameters.cs +++ b/code/stable/nopcm/src/csharp/InputParameters.cs @@ -6,59 +6,59 @@ public class InputParameters { public static void input_constraints(double A_C, double C_W, double h_C, double T_init, double t_final, double L, double T_C, double t_step, double rho_W, double D, double T_W, double E_W) { - if (!((inParams.A_C <= 100000))) { + if (!((A_C <= 100000))) { Console.WriteLine("Warning: constraint violated"); } - if (!(((4170 < inParams.C_W) && (inParams.C_W < 4210)))) { + if (!(((4170 < C_W) && (C_W < 4210)))) { Console.WriteLine("Warning: constraint violated"); } - if (!(((10 <= inParams.h_C) && (inParams.h_C <= 10000)))) { + if (!(((10 <= h_C) && (h_C <= 10000)))) { Console.WriteLine("Warning: constraint violated"); } - if (!((inParams.t_final < 86400))) { + if (!((t_final < 86400))) { Console.WriteLine("Warning: constraint violated"); } - if (!(((0.1 <= inParams.L) && (inParams.L <= 50)))) { + if (!(((0.1 <= L) && (L <= 50)))) { Console.WriteLine("Warning: constraint violated"); } - if (!(((950 < inParams.rho_W) && (inParams.rho_W <= 1000)))) { + if (!(((950 < rho_W) && (rho_W <= 1000)))) { Console.WriteLine("Warning: constraint violated"); } - if (!((inParams.A_C > 0))) { + if (!((A_C > 0))) { Console.WriteLine("Warning: constraint violated"); } - if (!((inParams.C_W > 0))) { + if (!((C_W > 0))) { Console.WriteLine("Warning: constraint violated"); } - if (!((inParams.h_C > 0))) { + if (!((h_C > 0))) { Console.WriteLine("Warning: constraint violated"); } - if (!(((0 < inParams.T_init) && (inParams.T_init < 100)))) { + if (!(((0 < T_init) && (T_init < 100)))) { Console.WriteLine("Warning: constraint violated"); } - if (!((inParams.t_final > 0))) { + if (!((t_final > 0))) { Console.WriteLine("Warning: constraint violated"); } - if (!((inParams.L > 0))) { + if (!((L > 0))) { Console.WriteLine("Warning: constraint violated"); } - if (!(((0 < inParams.T_C) && (inParams.T_C < 100)))) { + if (!(((0 < T_C) && (T_C < 100)))) { Console.WriteLine("Warning: constraint violated"); } - if (!(((0 < inParams.t_step) && (inParams.t_step < inParams.t_final)))) { + if (!(((0 < t_step) && (t_step < t_final)))) { Console.WriteLine("Warning: constraint violated"); } - if (!((inParams.rho_W > 0))) { + if (!((rho_W > 0))) { Console.WriteLine("Warning: constraint violated"); } - if (!((inParams.D > 0))) { + if (!((D > 0))) { Console.WriteLine("Warning: constraint violated"); } - if (!(((inParams.T_init <= inParams.T_W) && (inParams.T_W <= inParams.T_C)))) { + if (!(((T_init <= T_W) && (T_W <= T_C)))) { Console.WriteLine("Warning: constraint violated"); } - if (!((inParams.E_W >= 0))) { + if (!((E_W >= 0))) { Console.WriteLine("Warning: constraint violated"); } } diff --git a/code/stable/nopcm/src/csharp/OutputFormat.cs b/code/stable/nopcm/src/csharp/OutputFormat.cs index d914131209..f480d887c2 100644 --- a/code/stable/nopcm/src/csharp/OutputFormat.cs +++ b/code/stable/nopcm/src/csharp/OutputFormat.cs @@ -9,9 +9,9 @@ public static void write_output(double T_W, double E_W) { StreamWriter outputfile; outputfile = new StreamWriter("output.txt", false); outputfile.Write("T_W = "); - outputfile.WriteLine(inParams.T_W); + outputfile.WriteLine(T_W); outputfile.Write("E_W = "); - outputfile.WriteLine(inParams.E_W); + outputfile.WriteLine(E_W); outputfile.Close(); } } diff --git a/code/stable/nopcm/src/java/SWHS/Control.java b/code/stable/nopcm/src/java/SWHS/Control.java index b31a60478d..6cc4b74a40 100644 --- a/code/stable/nopcm/src/java/SWHS/Control.java +++ b/code/stable/nopcm/src/java/SWHS/Control.java @@ -12,20 +12,20 @@ public class Control { public static void main(String[] args) throws Exception { String filename = args[0]; - double inParams.A_C; - double inParams.C_W; - double inParams.h_C; - double inParams.T_init; - double inParams.t_final; - double inParams.L; - double inParams.T_C; - double inParams.t_step; - double inParams.rho_W; - double inParams.D; - double inParams.A_tol; - double inParams.R_tol; - double inParams.T_W; - double inParams.E_W; + double A_C; + double C_W; + double h_C; + double T_init; + double t_final; + double L; + double T_C; + double t_step; + double rho_W; + double D; + double A_tol; + double R_tol; + double T_W; + double E_W; Object[] outputs = InputFormat.get_input(filename); A_C = (double)(outputs[0]); C_W = (double)(outputs[1]); diff --git a/code/stable/nopcm/src/java/SWHS/InputFormat.java b/code/stable/nopcm/src/java/SWHS/InputFormat.java index 9cb4e4912f..f6725ae0ef 100644 --- a/code/stable/nopcm/src/java/SWHS/InputFormat.java +++ b/code/stable/nopcm/src/java/SWHS/InputFormat.java @@ -32,33 +32,33 @@ public static Object[] get_input(String filename) throws Exception { ArrayList linetokens = new ArrayList(0); infile = new Scanner(new File(filename)); infile.nextLine(); - inParams.A_C = Double.parseDouble(infile.nextLine()); + A_C = Double.parseDouble(infile.nextLine()); infile.nextLine(); - inParams.C_W = Double.parseDouble(infile.nextLine()); + C_W = Double.parseDouble(infile.nextLine()); infile.nextLine(); - inParams.h_C = Double.parseDouble(infile.nextLine()); + h_C = Double.parseDouble(infile.nextLine()); infile.nextLine(); - inParams.T_init = Double.parseDouble(infile.nextLine()); + T_init = Double.parseDouble(infile.nextLine()); infile.nextLine(); - inParams.t_final = Double.parseDouble(infile.nextLine()); + t_final = Double.parseDouble(infile.nextLine()); infile.nextLine(); - inParams.L = Double.parseDouble(infile.nextLine()); + L = Double.parseDouble(infile.nextLine()); infile.nextLine(); - inParams.T_C = Double.parseDouble(infile.nextLine()); + T_C = Double.parseDouble(infile.nextLine()); infile.nextLine(); - inParams.t_step = Double.parseDouble(infile.nextLine()); + t_step = Double.parseDouble(infile.nextLine()); infile.nextLine(); - inParams.rho_W = Double.parseDouble(infile.nextLine()); + rho_W = Double.parseDouble(infile.nextLine()); infile.nextLine(); - inParams.D = Double.parseDouble(infile.nextLine()); + D = Double.parseDouble(infile.nextLine()); infile.nextLine(); - inParams.A_tol = Double.parseDouble(infile.nextLine()); + A_tol = Double.parseDouble(infile.nextLine()); infile.nextLine(); - inParams.R_tol = Double.parseDouble(infile.nextLine()); + R_tol = Double.parseDouble(infile.nextLine()); infile.nextLine(); - inParams.T_W = Double.parseDouble(infile.nextLine()); + T_W = Double.parseDouble(infile.nextLine()); infile.nextLine(); - inParams.E_W = Double.parseDouble(infile.nextLine()); + E_W = Double.parseDouble(infile.nextLine()); infile.close(); Object[] outputs = new Object[14]; diff --git a/code/stable/nopcm/src/java/SWHS/InputParameters.java b/code/stable/nopcm/src/java/SWHS/InputParameters.java index ba408f3586..72a6189744 100644 --- a/code/stable/nopcm/src/java/SWHS/InputParameters.java +++ b/code/stable/nopcm/src/java/SWHS/InputParameters.java @@ -11,59 +11,59 @@ public class InputParameters { public static void input_constraints(double A_C, double C_W, double h_C, double T_init, double t_final, double L, double T_C, double t_step, double rho_W, double D, double T_W, double E_W) throws Exception { - if (!((inParams.A_C <= 100000))) { + if (!((A_C <= 100000))) { System.out.println("Warning: constraint violated"); } - if (!(((4170 < inParams.C_W) && (inParams.C_W < 4210)))) { + if (!(((4170 < C_W) && (C_W < 4210)))) { System.out.println("Warning: constraint violated"); } - if (!(((10 <= inParams.h_C) && (inParams.h_C <= 10000)))) { + if (!(((10 <= h_C) && (h_C <= 10000)))) { System.out.println("Warning: constraint violated"); } - if (!((inParams.t_final < 86400))) { + if (!((t_final < 86400))) { System.out.println("Warning: constraint violated"); } - if (!(((0.1 <= inParams.L) && (inParams.L <= 50)))) { + if (!(((0.1 <= L) && (L <= 50)))) { System.out.println("Warning: constraint violated"); } - if (!(((950 < inParams.rho_W) && (inParams.rho_W <= 1000)))) { + if (!(((950 < rho_W) && (rho_W <= 1000)))) { System.out.println("Warning: constraint violated"); } - if (!((inParams.A_C > 0))) { + if (!((A_C > 0))) { System.out.println("Warning: constraint violated"); } - if (!((inParams.C_W > 0))) { + if (!((C_W > 0))) { System.out.println("Warning: constraint violated"); } - if (!((inParams.h_C > 0))) { + if (!((h_C > 0))) { System.out.println("Warning: constraint violated"); } - if (!(((0 < inParams.T_init) && (inParams.T_init < 100)))) { + if (!(((0 < T_init) && (T_init < 100)))) { System.out.println("Warning: constraint violated"); } - if (!((inParams.t_final > 0))) { + if (!((t_final > 0))) { System.out.println("Warning: constraint violated"); } - if (!((inParams.L > 0))) { + if (!((L > 0))) { System.out.println("Warning: constraint violated"); } - if (!(((0 < inParams.T_C) && (inParams.T_C < 100)))) { + if (!(((0 < T_C) && (T_C < 100)))) { System.out.println("Warning: constraint violated"); } - if (!(((0 < inParams.t_step) && (inParams.t_step < inParams.t_final)))) { + if (!(((0 < t_step) && (t_step < t_final)))) { System.out.println("Warning: constraint violated"); } - if (!((inParams.rho_W > 0))) { + if (!((rho_W > 0))) { System.out.println("Warning: constraint violated"); } - if (!((inParams.D > 0))) { + if (!((D > 0))) { System.out.println("Warning: constraint violated"); } - if (!(((inParams.T_init <= inParams.T_W) && (inParams.T_W <= inParams.T_C)))) { + if (!(((T_init <= T_W) && (T_W <= T_C)))) { System.out.println("Warning: constraint violated"); } - if (!((inParams.E_W >= 0))) { + if (!((E_W >= 0))) { System.out.println("Warning: constraint violated"); } } diff --git a/code/stable/nopcm/src/java/SWHS/OutputFormat.java b/code/stable/nopcm/src/java/SWHS/OutputFormat.java index 8d855b0a7b..1089ec0b37 100644 --- a/code/stable/nopcm/src/java/SWHS/OutputFormat.java +++ b/code/stable/nopcm/src/java/SWHS/OutputFormat.java @@ -14,9 +14,9 @@ public static void write_output(double T_W, double E_W) throws Exception { PrintWriter outputfile; outputfile = new PrintWriter(new FileWriter(new File("output.txt"), false)); outputfile.print("T_W = "); - outputfile.println(inParams.T_W); + outputfile.println(T_W); outputfile.print("E_W = "); - outputfile.println(inParams.E_W); + outputfile.println(E_W); outputfile.close(); } } diff --git a/code/stable/nopcm/src/python/InputFormat.py b/code/stable/nopcm/src/python/InputFormat.py index e305febe71..484a25a350 100644 --- a/code/stable/nopcm/src/python/InputFormat.py +++ b/code/stable/nopcm/src/python/InputFormat.py @@ -7,33 +7,33 @@ def get_input(filename): linetokens = [] infile = open(filename, "r") infile.readline() - inParams.A_C = float(infile.readline()) + A_C = float(infile.readline()) infile.readline() - inParams.C_W = float(infile.readline()) + C_W = float(infile.readline()) infile.readline() - inParams.h_C = float(infile.readline()) + h_C = float(infile.readline()) infile.readline() - inParams.T_init = float(infile.readline()) + T_init = float(infile.readline()) infile.readline() - inParams.t_final = float(infile.readline()) + t_final = float(infile.readline()) infile.readline() - inParams.L = float(infile.readline()) + L = float(infile.readline()) infile.readline() - inParams.T_C = float(infile.readline()) + T_C = float(infile.readline()) infile.readline() - inParams.t_step = float(infile.readline()) + t_step = float(infile.readline()) infile.readline() - inParams.rho_W = float(infile.readline()) + rho_W = float(infile.readline()) infile.readline() - inParams.D = float(infile.readline()) + D = float(infile.readline()) infile.readline() - inParams.A_tol = float(infile.readline()) + A_tol = float(infile.readline()) infile.readline() - inParams.R_tol = float(infile.readline()) + R_tol = float(infile.readline()) infile.readline() - inParams.T_W = float(infile.readline()) + T_W = float(infile.readline()) infile.readline() - inParams.E_W = float(infile.readline()) + E_W = float(infile.readline()) infile.close() return A_C, C_W, h_C, T_init, t_final, L, T_C, t_step, rho_W, D, A_tol, R_tol, T_W, E_W diff --git a/code/stable/nopcm/src/python/InputParameters.py b/code/stable/nopcm/src/python/InputParameters.py index 4020e873ce..0bdbf44896 100644 --- a/code/stable/nopcm/src/python/InputParameters.py +++ b/code/stable/nopcm/src/python/InputParameters.py @@ -3,42 +3,42 @@ import math def input_constraints(A_C, C_W, h_C, T_init, t_final, L, T_C, t_step, rho_W, D, T_W, E_W): - if (not((inParams.A_C <= 100000))) : + if (not((A_C <= 100000))) : print("Warning: constraint violated") - if (not(((4170 < inParams.C_W) and (inParams.C_W < 4210)))) : + if (not(((4170 < C_W) and (C_W < 4210)))) : print("Warning: constraint violated") - if (not(((10 <= inParams.h_C) and (inParams.h_C <= 10000)))) : + if (not(((10 <= h_C) and (h_C <= 10000)))) : print("Warning: constraint violated") - if (not((inParams.t_final < 86400))) : + if (not((t_final < 86400))) : print("Warning: constraint violated") - if (not(((0.1 <= inParams.L) and (inParams.L <= 50)))) : + if (not(((0.1 <= L) and (L <= 50)))) : print("Warning: constraint violated") - if (not(((950 < inParams.rho_W) and (inParams.rho_W <= 1000)))) : + if (not(((950 < rho_W) and (rho_W <= 1000)))) : print("Warning: constraint violated") - if (not((inParams.A_C > 0))) : + if (not((A_C > 0))) : print("Warning: constraint violated") - if (not((inParams.C_W > 0))) : + if (not((C_W > 0))) : print("Warning: constraint violated") - if (not((inParams.h_C > 0))) : + if (not((h_C > 0))) : print("Warning: constraint violated") - if (not(((0 < inParams.T_init) and (inParams.T_init < 100)))) : + if (not(((0 < T_init) and (T_init < 100)))) : print("Warning: constraint violated") - if (not((inParams.t_final > 0))) : + if (not((t_final > 0))) : print("Warning: constraint violated") - if (not((inParams.L > 0))) : + if (not((L > 0))) : print("Warning: constraint violated") - if (not(((0 < inParams.T_C) and (inParams.T_C < 100)))) : + if (not(((0 < T_C) and (T_C < 100)))) : print("Warning: constraint violated") - if (not(((0 < inParams.t_step) and (inParams.t_step < inParams.t_final)))) : + if (not(((0 < t_step) and (t_step < t_final)))) : print("Warning: constraint violated") - if (not((inParams.rho_W > 0))) : + if (not((rho_W > 0))) : print("Warning: constraint violated") - if (not((inParams.D > 0))) : + if (not((D > 0))) : print("Warning: constraint violated") - if (not(((inParams.T_init <= inParams.T_W) and (inParams.T_W <= inParams.T_C)))) : + if (not(((T_init <= T_W) and (T_W <= T_C)))) : print("Warning: constraint violated") - if (not((inParams.E_W >= 0))) : + if (not((E_W >= 0))) : print("Warning: constraint violated") diff --git a/code/stable/nopcm/src/python/OutputFormat.py b/code/stable/nopcm/src/python/OutputFormat.py index 61c00f20b4..4bd0e75913 100644 --- a/code/stable/nopcm/src/python/OutputFormat.py +++ b/code/stable/nopcm/src/python/OutputFormat.py @@ -5,9 +5,9 @@ def write_output(T_W, E_W): outputfile = open("output.txt", "w") print("T_W = ", end='', file=outputfile) - print(inParams.T_W, file=outputfile) + print(T_W, file=outputfile) print("E_W = ", end='', file=outputfile) - print(inParams.E_W, file=outputfile) + print(E_W, file=outputfile) outputfile.close() From 458678bb5f19ce4901441ad5ced7d74b992cee3f Mon Sep 17 00:00:00 2001 From: Brooks MacLachlan Date: Wed, 26 Jun 2019 17:48:38 -0400 Subject: [PATCH 08/11] Only do code rule for examples with code --- code/Makefile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/code/Makefile b/code/Makefile index f55bf5c84e..e5aa9e1b83 100644 --- a/code/Makefile +++ b/code/Makefile @@ -51,7 +51,7 @@ GEN_EXAMPLES = $(addsuffix $(GEN_E_SUFFIX), $(EXAMPLES)) TEST_EXAMPLES = $(addsuffix $(TEST_E_SUFFIX), $(EXAMPLES)) MOVE_DF_EXAMPLES = $(addsuffix $(MOVE_DF_E_SUFFIX), $(SRC_EXAMPLES)) TEX_EXAMPLES = $(addsuffix $(TEX_E_SUFFIX), $(EXAMPLES)) -CODE_EXAMPLES = $(addsuffix $(CODE_E_SUFFIX), $(EXAMPLES)) +CODE_EXAMPLES = $(addsuffix $(CODE_E_SUFFIX), $(SRC_EXAMPLES)) DCP_EXAMPLES = $(addsuffix $(DCP_E_SUFFIX), $(EXAMPLES)) EXAMPLE_GEN_TARGET = GEN TEST MOVE_DF TEX CODE DCP From 7a9b5743f04541323d538328a2618c8e7df29558 Mon Sep 17 00:00:00 2001 From: bmaclach Date: Thu, 27 Jun 2019 08:29:09 -0400 Subject: [PATCH 09/11] All outputs get declared for inOutFunc (#1629) * All outputs get declared for inOutFunc * Updated stable --- .../Language/Drasil/Code/Imperative/Import.hs | 41 ++++++++++--------- .../Code/Imperative/LanguageRenderer.hs | 15 +++++-- .../LanguageRenderer/CSharpRenderer.hs | 6 +-- .../LanguageRenderer/CppRenderer.hs | 22 +++++----- .../LanguageRenderer/JavaRenderer.hs | 10 ++--- .../LanguageRenderer/PythonRenderer.hs | 2 +- .../Drasil/Code/Imperative/Symantics.hs | 2 +- code/drasil-code/Test/FileTests.hs | 8 ++-- code/drasil-code/Test/HelloWorld.hs | 8 ++-- code/drasil-code/Test/Helper.hs | 2 +- code/drasil-code/Test/PatternTest.hs | 2 +- code/stable/nopcm/src/cpp/Control.cpp | 28 ++++++------- code/stable/nopcm/src/csharp/Control.cs | 28 ++++++------- code/stable/nopcm/src/java/SWHS/Control.java | 28 ++++++------- .../nopcm/src/java/SWHS/InputFormat.java | 15 +++++++ 15 files changed, 120 insertions(+), 97 deletions(-) diff --git a/code/drasil-code/Language/Drasil/Code/Imperative/Import.hs b/code/drasil-code/Language/Drasil/Code/Imperative/Import.hs index 9de98b31d7..6c272e2a2b 100644 --- a/code/drasil-code/Language/Drasil/Code/Imperative/Import.hs +++ b/code/drasil-code/Language/Drasil/Code/Imperative/Import.hs @@ -76,8 +76,8 @@ chooseLogging LogAll = loggedAssign chooseLogging _ = \x y -> return $ assign x y initLogFileVar :: (RenderSym repr) => Logging -> [repr (Statement repr)] -initLogFileVar LogVar = [varDec "outfile" outfile] -initLogFileVar LogAll = [varDec "outfile" outfile] +initLogFileVar LogVar = [varDec $ var "outfile" outfile] +initLogFileVar LogAll = [varDec $ var "outfile" outfile] initLogFileVar _ = [] @@ -363,7 +363,7 @@ genOutputFormat = do ] ) (outputs $ csi $ codeSpec g) mthd <- publicMethod (mState void) "write_output" parms (return [block $ [ - varDec l_outfile outfile, + varDec v_outfile, openFileW v_outfile (litString "output.txt") ] ++ concat outp ++ [ closeFile v_outfile ]]) return $ Just mthd @@ -423,7 +423,7 @@ loggedMethod n vals b = g <- ask rest <- b return $ block [ - varDec l_outfile outfile, + varDec v_outfile, openFileA v_outfile (litString $ logName g), printFileStr v_outfile ("function " ++ n ++ "("), printParams vals v_outfile, @@ -474,14 +474,15 @@ getInputDecl :: (RenderSym repr) => Reader (State repr) (Maybe (repr ( getInputDecl = do g <- ask let l_params = "inParams" - getDecl :: (RenderSym repr) => Structure -> [CodeChunk] -> Maybe (repr - (Statement repr)) - getDecl _ [] = Nothing - getDecl Loose ins = Just $ multi $ map (\x -> varDec (codeName x) - (convType $ codeType x)) ins - getDecl AsClass _ = Just $ extObjDecNewVoid l_params "InputParameters" - (obj "InputParameters") - return $ getDecl (inStruct g) (inputs $ codeSpec g) + getDecl :: (RenderSym repr) => Structure -> [CodeChunk] -> + Reader (State repr) (Maybe (repr (Statement repr))) + getDecl _ [] = return Nothing + getDecl Loose ins = do + vals <- mapM (\x -> variable (codeName x) (convType $ codeType x)) ins + return $ Just $ multi $ map varDec vals + getDecl AsClass _ = return $ Just $ extObjDecNewVoid l_params + "InputParameters" (obj "InputParameters") + getDecl (inStruct g) (inputs $ codeSpec g) getFuncCall :: (RenderSym repr) => String -> repr (StateType repr) -> Reader (State repr) [ParamData repr] -> @@ -798,12 +799,10 @@ genFunc (FDef (FuncDef n i o s)) = do g <- ask parms <- getParams i stmts <- mapM convStmt s + vals <- mapM (\x -> variable (codeName x) (convType $ codeType x)) + (fstdecl (sysinfodb $ csi $ codeSpec g) s \\ i) publicMethod (mState $ convType o) n parms - (return [block $ - map (\x -> varDec (codeName x) (convType $ codeType x)) - (fstdecl (sysinfodb $ csi $ codeSpec g) s \\ i) - ++ stmts - ]) + (return [block $ map varDec vals ++ stmts]) genFunc (FData (FuncData n ddef)) = genDataFunc n ddef genFunc (FCD cd) = genCalcFunc cd @@ -839,7 +838,9 @@ convStmt (FTry t c) = do convStmt FContinue = return continue convStmt (FDec v (C.List t)) = return $ listDec (codeName v) 0 (listType dynamic_ (convType t)) -convStmt (FDec v t) = return $ varDec (codeName v) (convType t) +convStmt (FDec v t) = do + val <- variable (codeName v) (convType t) + return $ varDec val convStmt (FProcCall n l) = do e' <- convExpr (FCall (asExpr n) l) return $ valState e' @@ -863,8 +864,8 @@ readData :: (RenderSym repr) => DataDesc -> Reader (State repr) readData ddef = do inD <- mapM inData ddef return [block $ [ - varDec l_infile infile, - varDec l_line string, + varDec v_infile, + varDec v_line, listDec l_lines 0 (listType dynamic_ string), listDec l_linetokens 0 (listType dynamic_ string), openFileR v_infile v_filename ] ++ diff --git a/code/drasil-code/Language/Drasil/Code/Imperative/LanguageRenderer.hs b/code/drasil-code/Language/Drasil/Code/Imperative/LanguageRenderer.hs index ecd85b076b..9083f22b86 100644 --- a/code/drasil-code/Language/Drasil/Code/Imperative/LanguageRenderer.hs +++ b/code/drasil-code/Language/Drasil/Code/Imperative/LanguageRenderer.hs @@ -28,8 +28,8 @@ module Language.Drasil.Code.Imperative.LanguageRenderer ( constDecDefDocD, notNullDocD, listIndexExistsDocD, funcDocD, castDocD, sizeDocD, listAccessDocD, listSetDocD, objAccessDocD, castObjDocD, includeD, breakDocD, continueDocD, staticDocD, dynamicDocD, privateDocD, publicDocD, - addCommentsDocD, valList, appendToBody, getterName, setterName, - setMain, setEmpty, statementsToStateVars + addCommentsDocD, valList, prependToBody, appendToBody, surroundBody, + getterName, setterName, setMain, setEmpty, statementsToStateVars ) where import Utils.Drasil (capitalize, indent, indentList) @@ -314,8 +314,8 @@ plusPlusDocD v = valDoc v <> text "++" plusPlusDocD' :: ValData -> Doc -> Doc plusPlusDocD' v plusOp = valDoc v <+> equals <+> valDoc v <+> plusOp <+> int 1 -varDecDocD :: Label -> TypeData -> Doc -varDecDocD l st = typeDoc st <+> text l +varDecDocD :: ValData -> Doc +varDecDocD v = typeDoc (valType v) <+> valDoc v varDecDefDocD :: Label -> TypeData -> ValData -> Doc varDecDefDocD l st v = typeDoc st <+> text l <+> equals <+> valDoc v @@ -655,10 +655,17 @@ dashes s l = replicate (l - length s) '-' valList :: [ValData] -> Doc valList vs = hcat (intersperse (text ", ") (map valDoc vs)) +prependToBody :: (Doc, Terminator) -> Doc -> Doc +prependToBody s b = vcat [fst $ statementDocD s, maybeBlank, b] + where maybeBlank = if isEmpty b then empty else blank + appendToBody :: Doc -> (Doc, Terminator) -> Doc appendToBody b s = vcat [b, maybeBlank, fst $ statementDocD s] where maybeBlank = if isEmpty b then empty else blank +surroundBody :: (Doc, Terminator) -> Doc -> (Doc, Terminator) -> Doc +surroundBody p b a = prependToBody p (appendToBody b a) + getterName :: String -> String getterName s = "Get" ++ capitalize s diff --git a/code/drasil-code/Language/Drasil/Code/Imperative/LanguageRenderer/CSharpRenderer.hs b/code/drasil-code/Language/Drasil/Code/Imperative/LanguageRenderer/CSharpRenderer.hs index 185aa10e3a..c7ea8ef06e 100644 --- a/code/drasil-code/Language/Drasil/Code/Imperative/LanguageRenderer/CSharpRenderer.hs +++ b/code/drasil-code/Language/Drasil/Code/Imperative/LanguageRenderer/CSharpRenderer.hs @@ -38,7 +38,7 @@ import Language.Drasil.Code.Imperative.LanguageRenderer ( notNullDocD, listIndexExistsDocD, funcDocD, castDocD, listSetDocD, listAccessDocD, objAccessDocD, castObjDocD, breakDocD, continueDocD, staticDocD, dynamicDocD, privateDocD, publicDocD, dot, new, observerListName, - doubleSlash, addCommentsDocD, valList, appendToBody, getterName, setterName, + doubleSlash, addCommentsDocD, valList, surroundBody, getterName, setterName, setMain, setEmpty, statementsToStateVars) import Language.Drasil.Code.Imperative.Helpers (Terminator(..), FuncData(..), fd, ModData(..), md, TypeData(..), td, ValData(..), vd, updateValDoc, liftA4, @@ -346,7 +346,7 @@ instance StatementSym CSharpCode where (&++) v = mkSt <$> fmap plusPlusDocD v (&~-) v = v &= (v #- litInt 1) - varDec l t = mkSt <$> fmap (varDecDocD l) t + varDec v = mkSt <$> fmap varDecDocD v varDecDef l t v = mkSt <$> liftA2 (varDecDefDocD l) t v listDec l n t = mkSt <$> liftA2 (listDecDocD l) (litInt n) t -- this means that the type you declare must already be a list. Not sure how I feel about this. On the bright side, it also means you don't need to pass permanence listDecDef l t vs = mkSt <$> lift1List (listDecDefDocD l) t vs @@ -520,7 +520,7 @@ instance MethodSym CSharpCode where function n = method n "" inOutFunc n s p ins [v] b = function n s p (mState (fmap valType v)) - (map stateParam ins) (liftA2 appendToBody b $ returnState v) + (map stateParam ins) (liftA3 surroundBody (varDec v) b (returnState v)) inOutFunc n s p ins outs b = function n s p (mState void) (nub $ map (\v -> if v `elem` outs then fmap csRef (stateParam v) else stateParam v) ins ++ map (fmap csRef . stateParam) outs) b diff --git a/code/drasil-code/Language/Drasil/Code/Imperative/LanguageRenderer/CppRenderer.hs b/code/drasil-code/Language/Drasil/Code/Imperative/LanguageRenderer/CppRenderer.hs index c5d10fb011..72c931c7a6 100644 --- a/code/drasil-code/Language/Drasil/Code/Imperative/LanguageRenderer/CppRenderer.hs +++ b/code/drasil-code/Language/Drasil/Code/Imperative/LanguageRenderer/CppRenderer.hs @@ -36,7 +36,7 @@ import Language.Drasil.Code.Imperative.LanguageRenderer ( objVarDocD, inlineIfDocD, funcAppDocD, funcDocD, castDocD, objAccessDocD, castObjDocD, breakDocD, continueDocD, staticDocD, dynamicDocD, privateDocD, publicDocD, classDec, dot, observerListName, doubleSlash, addCommentsDocD, - valList, appendToBody, getterName, setterName, setEmpty) + valList, surroundBody, getterName, setterName, setEmpty) import Language.Drasil.Code.Imperative.Helpers (Pair(..), Terminator(..), ScopeTag (..), FuncData(..), fd, ModData(..), md, MethodData(..), mthd, StateVarData(..), svd, TypeData(..), td, ValData(..), vd, angles, blank, @@ -337,7 +337,7 @@ instance (Pair p) => StatementSym (p CppSrcCode CppHdrCode) where (&++) v = pair ((&++) $ pfst v) ((&++) $ psnd v) (&~-) v = pair ((&~-) $ pfst v) ((&~-) $ psnd v) - varDec l t = pair (varDec l $ pfst t) (varDec l $ psnd t) + varDec v = pair (varDec $ pfst v) (varDec $ psnd v) varDecDef l t v = pair (varDecDef l (pfst t) (pfst v)) (varDecDef l (psnd t) (psnd v)) listDec l n t = pair (listDec l n $ pfst t) (listDec l n $ psnd t) @@ -844,7 +844,7 @@ instance StatementSym CppSrcCode where (&++) v = mkSt <$> fmap plusPlusDocD v (&~-) v = v &= (v #- litInt 1) - varDec l t = mkSt <$> fmap (varDecDocD l) t + varDec v = mkSt <$> fmap varDecDocD v varDecDef l t v = mkSt <$> liftA2 (varDecDefDocD l) t v listDec l n t = mkSt <$> liftA2 (cppListDecDoc l) (litInt n) t -- this means that the type you declare must already be a list. Not sure how I feel about this. On the bright side, it also means you don't need to pass permanence listDecDef l t vs = mkSt <$> liftA2 (cppListDecDefDoc l) t (liftList @@ -924,9 +924,9 @@ instance StatementSym CppSrcCode where in multi [ valState $ vnew $. func "clear" void [], - varDec l_ss (obj "std::stringstream"), + varDec v_ss, valState $ objMethodCall string v_ss "str" [s], - varDec l_word string, + varDec v_word, while (funcApp "std::getline" string [v_ss, v_word, litChar d]) (oneLiner $ valState $ vnew $. listAppend v_word) ] @@ -995,7 +995,7 @@ instance ControlStatementSym CppSrcCode where getFileInputAll f v = let l_line = "nextLine" v_line = var l_line string in - multi [varDec l_line string, + multi [varDec v_line, while (funcApp "std::getline" string [f, v_line]) (oneLiner $ valState $ v $. listAppend v_line)] @@ -1031,9 +1031,9 @@ instance MethodSym CppSrcCode where pubMethod n c = method n c public dynamic_ constructor n = method n n public dynamic_ (construct n) destructor n vs = - let i = "i" + let i = var "i" int deleteStatements = map (fmap destructSts) vs - loopIndexDec = varDec i int + loopIndexDec = varDec i dbody = if all (isEmpty . fst . unCPPSC) deleteStatements then return empty else bodyStatements $ loopIndexDec : deleteStatements in pubMethod ('~':n) n void [] dbody @@ -1042,7 +1042,7 @@ instance MethodSym CppSrcCode where (cppsFunction n) t (liftList paramListDocD ps) b blockStart blockEnd) inOutFunc n s p ins [v] b = function n s p (mState (fmap valType v)) - (map (fmap getParam) ins) (liftA2 appendToBody b $ returnState v) + (map (fmap getParam) ins) (liftA3 surroundBody (varDec v) b (returnState v)) inOutFunc n s p ins outs b = function n s p (mState void) (nub $ map (\v -> if v `elem` outs then pointerParam v else fmap getParam v) ins ++ map pointerParam outs) b @@ -1357,7 +1357,7 @@ instance StatementSym CppHdrCode where (&++) _ = return (mkStNoEnd empty) (&~-) _ = return (mkStNoEnd empty) - varDec _ _ = return (mkStNoEnd empty) + varDec _ = return (mkStNoEnd empty) varDecDef _ _ _ = return (mkStNoEnd empty) listDec _ _ _ = return (mkStNoEnd empty) listDecDef _ _ _ = return (mkStNoEnd empty) @@ -1488,7 +1488,7 @@ instance MethodSym CppHdrCode where function n = method n "" inOutFunc n s p ins [v] b = function n s p (mState (fmap valType v)) - (map (fmap getParam) ins) (liftA2 appendToBody b $ returnState v) + (map (fmap getParam) ins) b inOutFunc n s p ins outs b = function n s p (mState void) (nub $ map (\v -> if v `elem` outs then pointerParam v else fmap getParam v) ins ++ map pointerParam outs) b diff --git a/code/drasil-code/Language/Drasil/Code/Imperative/LanguageRenderer/JavaRenderer.hs b/code/drasil-code/Language/Drasil/Code/Imperative/LanguageRenderer/JavaRenderer.hs index 7769370488..4c375d91e5 100644 --- a/code/drasil-code/Language/Drasil/Code/Imperative/LanguageRenderer/JavaRenderer.hs +++ b/code/drasil-code/Language/Drasil/Code/Imperative/LanguageRenderer/JavaRenderer.hs @@ -37,7 +37,7 @@ import Language.Drasil.Code.Imperative.LanguageRenderer ( funcAppDocD, extFuncAppDocD, stateObjDocD, listStateObjDocD, notNullDocD, funcDocD, castDocD, objAccessDocD, castObjDocD, breakDocD, continueDocD, staticDocD, dynamicDocD, privateDocD, publicDocD, dot, new, forLabel, - observerListName, doubleSlash, addCommentsDocD, valList, appendToBody, + observerListName, doubleSlash, addCommentsDocD, valList, surroundBody, getterName, setterName, setMain, setEmpty, statementsToStateVars) import Language.Drasil.Code.Imperative.Helpers (Terminator(..), FuncData(..), fd, ModData(..), md, TypeData(..), td, ValData(..), vd, angles, liftA4, @@ -350,7 +350,7 @@ instance StatementSym JavaCode where (&++) v = mkSt <$> fmap plusPlusDocD v (&~-) v = v &= (v #- litInt 1) - varDec l t = mkSt <$> fmap (varDecDocD l) t + varDec v = mkSt <$> fmap varDecDocD v varDecDef l t v = mkSt <$> liftA2 (varDecDefDocD l) t v listDec l n t = mkSt <$> liftA2 (listDecDocD l) (litInt n) t -- this means that the type you declare must already be a list. Not sure how I feel about this. On the bright side, it also means you don't need to pass permanence listDecDef l t vs = mkSt <$> liftA2 (jListDecDef l) t (liftList @@ -531,10 +531,9 @@ instance MethodSym JavaCode where inOutFunc n s p ins [] b = function n s p (mState void) (map stateParam ins) b inOutFunc n s p ins [v] b = function n s p (mState (fmap valType v)) - (map stateParam ins) (liftA2 appendToBody b (returnState v)) + (map stateParam ins) (liftA3 surroundBody (varDec v) b (returnState v)) inOutFunc n s p ins outs b = function n s p jArrayType - (map stateParam ins) (liftA2 appendToBody b (multi ( - varDecDef "outputs" jArrayType + (map stateParam ins) (liftA3 surroundBody decls b (multi (varDecDef "outputs" jArrayType (var ("new Object[" ++ show (length outs) ++ "]") jArrayType) : assignArray 0 outs ++ [returnVar "outputs" jArrayType]))) @@ -543,6 +542,7 @@ instance MethodSym JavaCode where assignArray _ [] = [] assignArray c (v:vs) = (var ("outputs[" ++ show c ++ "]") (fmap valType v) &= v) : assignArray (c+1) vs + decls = multi $ map varDec outs instance StateVarSym JavaCode where diff --git a/code/drasil-code/Language/Drasil/Code/Imperative/LanguageRenderer/PythonRenderer.hs b/code/drasil-code/Language/Drasil/Code/Imperative/LanguageRenderer/PythonRenderer.hs index 8796a384a9..b5a745259a 100644 --- a/code/drasil-code/Language/Drasil/Code/Imperative/LanguageRenderer/PythonRenderer.hs +++ b/code/drasil-code/Language/Drasil/Code/Imperative/LanguageRenderer/PythonRenderer.hs @@ -327,7 +327,7 @@ instance StatementSym PythonCode where (&++) v = mkStNoEnd <$> liftA2 plusPlusDocD' v plusOp (&~-) v = v &= (v #- litInt 1) - varDec _ _ = return (mkStNoEnd empty) + varDec _ = return (mkStNoEnd empty) varDecDef l _ v = mkStNoEnd <$> fmap (pyVarDecDef l) v listDec l _ t = mkStNoEnd <$> fmap (pyListDec l) (listType static_ t) listDecDef l _ vs = mkStNoEnd <$> fmap (pyListDecDef l) (liftList diff --git a/code/drasil-code/Language/Drasil/Code/Imperative/Symantics.hs b/code/drasil-code/Language/Drasil/Code/Imperative/Symantics.hs index 424e127276..aa144a0b68 100644 --- a/code/drasil-code/Language/Drasil/Code/Imperative/Symantics.hs +++ b/code/drasil-code/Language/Drasil/Code/Imperative/Symantics.hs @@ -333,7 +333,7 @@ class (ValueSym repr, Selector repr, SelectorFunction repr, FunctionSym repr) multiAssign :: [repr (Value repr)] -> [repr (Value repr)] -> repr (Statement repr) - varDec :: Label -> repr (StateType repr) -> repr (Statement repr) + varDec :: repr (Value repr) -> repr (Statement repr) varDecDef :: Label -> repr (StateType repr) -> repr (Value repr) -> repr (Statement repr) listDec :: Label -> Integer -> repr (StateType repr) -> diff --git a/code/drasil-code/Test/FileTests.hs b/code/drasil-code/Test/FileTests.hs index b000b8a72f..004f3f71b3 100644 --- a/code/drasil-code/Test/FileTests.hs +++ b/code/drasil-code/Test/FileTests.hs @@ -16,9 +16,9 @@ fileTestMethod = mainMethod "FileTests" (body [writeStory, block [readStory], writeStory :: (RenderSym repr) => repr (Block repr) writeStory = block [ varDecDef "e" int (litInt 5), - varDec "f" float, + varDec $ var "f" float, var "f" float &= castObj (cast float int) (var "e" int), - varDec "fileToWrite" outfile, + varDec $ var "fileToWrite" outfile, openFileW (var "fileToWrite" outfile) (litString "testText.txt"), printFile (var "fileToWrite" outfile) int (litInt 0), @@ -28,9 +28,9 @@ writeStory = block [ printFileStrLn (var "fileToWrite" outfile) "!!", closeFile (var "fileToWrite" outfile), - varDec "fileToRead" infile, + varDec $ var "fileToRead" infile, openFileR (var "fileToRead" infile) (litString "testText.txt"), - varDec "fileLine" string, + varDec $ var "fileLine" string, getFileInputLine (var "fileToRead" infile) (var "fileLine" string), discardFileLine (var "fileToRead" infile), listDec "fileContents" 0 (listType dynamic_ string)] diff --git a/code/drasil-code/Test/HelloWorld.hs b/code/drasil-code/Test/HelloWorld.hs index fa956000fb..d57fe4fc27 100644 --- a/code/drasil-code/Test/HelloWorld.hs +++ b/code/drasil-code/Test/HelloWorld.hs @@ -25,7 +25,7 @@ helloWorldMain = mainMethod "HelloWorld" (body [ helloInitVariables, helloInitVariables :: (RenderSym repr) => repr (Block repr) helloInitVariables = block [comment "Initializing variables", - varDec "a" int, + varDec $ var "a" int, varDecDef "b" int (litInt 5), listDecDef "myOtherList" (listType static_ float) [litFloat 1.0, litFloat 1.5], varDecDef "oneIndex" int (indexOf (var "myOtherList" (listType static_ float)) (litFloat 1.0)), @@ -34,7 +34,7 @@ helloInitVariables = block [comment "Initializing variables", valState (objAccess (var "myOtherList" (listType static_ float)) (listAdd (var "myOtherList" (listType static_ float)) (litInt 2) (litFloat 2.0))), valState (objAccess (var "myOtherList" (listType static_ float)) (listAppend (litFloat 2.5))), - varDec "e" float, + varDec $ var "e" float, var "e" int &= objAccess (var "myOtherList" (listType static_ float)) (listAccess float (litInt 1)), valState (objAccess (var "myOtherList" (listType static_ float)) (listSet (litInt 1) (litFloat 17.4))), listDec "myName" 7 (listType static_ string), @@ -50,8 +50,8 @@ helloListSlice = listSlice (listType static_ float) (var "mySlicedList" (listTyp helloIfBody :: (RenderSym repr) => repr (Body repr) helloIfBody = addComments "If body" (body [ block [ - varDec "c" int, - varDec "d" int, + varDec $ var "c" int, + varDec $ var "d" int, assign (var "a" int) (litInt 5), var "b" int &= (var "a" int #+ litInt 2), var "c" int &= (var "b" int #+ litInt 3), diff --git a/code/drasil-code/Test/Helper.hs b/code/drasil-code/Test/Helper.hs index 1bac1bbbd5..5795ef22f0 100644 --- a/code/drasil-code/Test/Helper.hs +++ b/code/drasil-code/Test/Helper.hs @@ -13,7 +13,7 @@ doubleAndAdd :: (RenderSym repr) => repr (Method repr) doubleAndAdd = function "doubleAndAdd" public static_ (mState float) [stateParam $ var "num1" float, stateParam $ var "num2" float] (bodyStatements [ - varDec "doubledSum" float, + varDec $ var "doubledSum" float, var "doubledSum" float &= ((litFloat 2.0 #* var "num1" float) #+ (litFloat 2.0 #* var "num2" float)), returnVar "doubledSum" float]) \ No newline at end of file diff --git a/code/drasil-code/Test/PatternTest.hs b/code/drasil-code/Test/PatternTest.hs index 6cbf2268d1..6cb39964d9 100644 --- a/code/drasil-code/Test/PatternTest.hs +++ b/code/drasil-code/Test/PatternTest.hs @@ -13,7 +13,7 @@ patternTest = packMods "PatternTest" [fileDoc (buildModule "PatternTest" ["Obser patternTestMainMethod :: (RenderSym repr) => repr (Method repr) patternTestMainMethod = mainMethod "PatternTest" (body [block [ - varDec "n" int, + varDec $ var "n" int, initState "myFSM" "Off", changeState "myFSM" "On", checkState "myFSM" diff --git a/code/stable/nopcm/src/cpp/Control.cpp b/code/stable/nopcm/src/cpp/Control.cpp index b69fc5c030..b3843d5aec 100644 --- a/code/stable/nopcm/src/cpp/Control.cpp +++ b/code/stable/nopcm/src/cpp/Control.cpp @@ -19,20 +19,20 @@ using std::ofstream; int main(int argc, const char *argv[]) { string filename = argv[1]; - double A_C; - double C_W; - double h_C; - double T_init; - double t_final; - double L; - double T_C; - double t_step; - double rho_W; - double D; - double A_tol; - double R_tol; - double T_W; - double E_W; + double inParams.A_C; + double inParams.C_W; + double inParams.h_C; + double inParams.T_init; + double inParams.t_final; + double inParams.L; + double inParams.T_C; + double inParams.t_step; + double inParams.rho_W; + double inParams.D; + double inParams.A_tol; + double inParams.R_tol; + double inParams.T_W; + double inParams.E_W; get_input(filename, A_C, C_W, h_C, T_init, t_final, L, T_C, t_step, rho_W, D, A_tol, R_tol, T_W, E_W); input_constraints(A_C, C_W, h_C, T_init, t_final, L, T_C, t_step, rho_W, D, T_W, E_W); write_output(T_W, E_W); diff --git a/code/stable/nopcm/src/csharp/Control.cs b/code/stable/nopcm/src/csharp/Control.cs index 1a1d64c7c9..26f31e9429 100644 --- a/code/stable/nopcm/src/csharp/Control.cs +++ b/code/stable/nopcm/src/csharp/Control.cs @@ -7,20 +7,20 @@ public class Control { public static void Main(string[] args) { string filename = args[0]; - double A_C; - double C_W; - double h_C; - double T_init; - double t_final; - double L; - double T_C; - double t_step; - double rho_W; - double D; - double A_tol; - double R_tol; - double T_W; - double E_W; + double inParams.A_C; + double inParams.C_W; + double inParams.h_C; + double inParams.T_init; + double inParams.t_final; + double inParams.L; + double inParams.T_C; + double inParams.t_step; + double inParams.rho_W; + double inParams.D; + double inParams.A_tol; + double inParams.R_tol; + double inParams.T_W; + double inParams.E_W; InputFormat.get_input(filename, ref A_C, ref C_W, ref h_C, ref T_init, ref t_final, ref L, ref T_C, ref t_step, ref rho_W, ref D, ref A_tol, ref R_tol, ref T_W, ref E_W); InputParameters.input_constraints(A_C, C_W, h_C, T_init, t_final, L, T_C, t_step, rho_W, D, T_W, E_W); OutputFormat.write_output(T_W, E_W); diff --git a/code/stable/nopcm/src/java/SWHS/Control.java b/code/stable/nopcm/src/java/SWHS/Control.java index 6cc4b74a40..b31a60478d 100644 --- a/code/stable/nopcm/src/java/SWHS/Control.java +++ b/code/stable/nopcm/src/java/SWHS/Control.java @@ -12,20 +12,20 @@ public class Control { public static void main(String[] args) throws Exception { String filename = args[0]; - double A_C; - double C_W; - double h_C; - double T_init; - double t_final; - double L; - double T_C; - double t_step; - double rho_W; - double D; - double A_tol; - double R_tol; - double T_W; - double E_W; + double inParams.A_C; + double inParams.C_W; + double inParams.h_C; + double inParams.T_init; + double inParams.t_final; + double inParams.L; + double inParams.T_C; + double inParams.t_step; + double inParams.rho_W; + double inParams.D; + double inParams.A_tol; + double inParams.R_tol; + double inParams.T_W; + double inParams.E_W; Object[] outputs = InputFormat.get_input(filename); A_C = (double)(outputs[0]); C_W = (double)(outputs[1]); diff --git a/code/stable/nopcm/src/java/SWHS/InputFormat.java b/code/stable/nopcm/src/java/SWHS/InputFormat.java index 366356f0b5..9cb4e4912f 100644 --- a/code/stable/nopcm/src/java/SWHS/InputFormat.java +++ b/code/stable/nopcm/src/java/SWHS/InputFormat.java @@ -11,6 +11,21 @@ public class InputFormat { public static Object[] get_input(String filename) throws Exception { + double A_C; + double C_W; + double h_C; + double T_init; + double t_final; + double L; + double T_C; + double t_step; + double rho_W; + double D; + double A_tol; + double R_tol; + double T_W; + double E_W; + Scanner infile; String line; ArrayList lines = new ArrayList(0); From c62c268db809b8de78287f01064d13c706f0edc5 Mon Sep 17 00:00:00 2001 From: Sam Crawford <35857611+samm82@users.noreply.github.com> Date: Thu, 27 Jun 2019 14:45:22 -0400 Subject: [PATCH 10/11] Formatting from Projectile (#1634) * Added column for SI name in Table of Units * Updated definition of pi * Capitalized 1D, 2D, and 3D in table of A and A * Linted --- code/drasil-data/Data/Drasil/Concepts/Math.hs | 2 +- .../Data/Drasil/Concepts/Physics.hs | 25 ++++-------- .../Drasil/Sections/TableOfUnits.hs | 14 +++---- code/drasil-example/Drasil/SSP/Body.hs | 13 +++--- .../drasil-lang/Language/Drasil/NounPhrase.hs | 40 +++++++++---------- code/stable/gamephys/SRS/Chipmunk_SRS.tex | 20 +++++----- .../stable/gamephys/Website/Chipmunk_SRS.html | 23 +++++++---- code/stable/glassbr/SRS/GlassBR_SRS.tex | 14 +++---- code/stable/glassbr/Website/GlassBR_SRS.html | 16 +++++--- code/stable/nopcm/SRS/NoPCM_SRS.tex | 18 ++++----- code/stable/nopcm/Website/NoPCM_SRS.html | 21 ++++++---- code/stable/ssp/SRS/SSP_SRS.tex | 24 +++++------ code/stable/ssp/Website/SSP_SRS.html | 27 ++++++++----- code/stable/swhs/SRS/SWHS_SRS.tex | 18 ++++----- code/stable/swhs/Website/SWHS_SRS.html | 21 ++++++---- code/stable/tiny/SRS/Tiny_SRS.tex | 10 ++--- code/stable/tiny/Website/Tiny_SRS.html | 10 +++-- 17 files changed, 172 insertions(+), 144 deletions(-) diff --git a/code/drasil-data/Data/Drasil/Concepts/Math.hs b/code/drasil-data/Data/Drasil/Concepts/Math.hs index 20eeee9b77..af3a800d94 100644 --- a/code/drasil-data/Data/Drasil/Concepts/Math.hs +++ b/code/drasil-data/Data/Drasil/Concepts/Math.hs @@ -44,7 +44,7 @@ number = dcc "number" (cn' "number") "A mathematica parameter = dcc "parameter" (cn' "parameter") "A quantity whose value is selected depending on particular circumstances" --FIXME: Should "parameter" be in math? perp = dcc "perp" (cn' "perpendicular") "At right angles" -pi_ = dcc "pi" (cn' "circumference to diameter ratio") "The ratio of a circle's circumference to its diameter" +pi_ = dcc "pi" (cn' "ratio of circumference to diameter for any circle") "The ratio of a circle's circumference to its diameter" probability = dcc "probability" (cnIES "probability") "The likelihood of an event to occur" rate = dcc "rate" (cn' "rate") "Ratio that compares two quantities having different units of measure" shape = dcc "shape" (cn' "shape") "The outline of an area or figure" diff --git a/code/drasil-data/Data/Drasil/Concepts/Physics.hs b/code/drasil-data/Data/Drasil/Concepts/Physics.hs index cfaabfb2a7..9405ebdea9 100644 --- a/code/drasil-data/Data/Drasil/Concepts/Physics.hs +++ b/code/drasil-data/Data/Drasil/Concepts/Physics.hs @@ -1,19 +1,11 @@ -module Data.Drasil.Concepts.Physics - ( rigidBody, velocity, friction, elasticity, energy, mechEnergy, collision, space - , cartesian, rightHand, restitutionCoef, acceleration, pressure, height - , momentOfInertia, force, impulseS, impulseV, displacement - , gravitationalAccel, gravitationalConst, position, distance - , time, torque, weight, fbd, angular, linear, tension, compression, stress - , strain , angDisp, angVelo, angAccel, linDisp, linVelo, linAccel, joint - , damping , cohesion, isotropy, twoD, threeD, physicCon, physicCon', kEnergy, chgInVelocity - , potEnergy - ) where +module Data.Drasil.Concepts.Physics where + --This is obviously a bad name, but for now it will do until we come -- up with a better one. import Language.Drasil import Utils.Drasil -import Data.Drasil.IdeaDicts (physics) +import Data.Drasil.IdeaDicts (mathematics, physics) import Data.Drasil.Concepts.Documentation (property, value) import Control.Lens((^.)) --need for parametrization hack @@ -27,7 +19,7 @@ physicCon = [rigidBody, velocity, friction, elasticity, energy, mechEnergy, coll joint, damping, pressure, cohesion, isotropy, kEnergy, chgInVelocity, potEnergy] physicCon' :: [CI] -physicCon' = [twoD, threeD] +physicCon' = [oneD, twoD, threeD] rigidBody, velocity, friction, elasticity, energy, mechEnergy, collision, space, cartesian, rightHand, restitutionCoef, acceleration, height, @@ -37,7 +29,10 @@ rigidBody, velocity, friction, elasticity, energy, mechEnergy, collision, space, strain, angDisp, angVelo, angAccel, linDisp, linVelo, linAccel, joint, damping, pressure,cohesion, isotropy, kEnergy, chgInVelocity, potEnergy:: ConceptChunk -twoD, threeD :: CI +oneD, twoD, threeD :: CI +oneD = commonIdeaWithDict "oneD" (cn "one-dimensional") "1D" [mathematics, physics] +twoD = commonIdeaWithDict "twoD" (cn "two-dimensional") "2D" [mathematics, physics] +threeD = commonIdeaWithDict "threeD" (cn "three-dimensional") "3D" [mathematics, physics] rigidBody = dcc "rigidBody" (cnIES "rigid body") "A solid body in which deformation is neglected." @@ -166,7 +161,3 @@ isotropy = dccWDS "isotropy" (cn "isotropy") (S "A condition where the" +:+ chgInVelocity = dccWDS "chgInVelocity" (cn "change in velocity") (S "The" +:+ phrase chgInVelocity +:+ S "of a" +:+ phrase rigidBody) - -twoD = commonIdeaWithDict "twoD" (pn "two-dimensional") "2D" [physics] - -threeD = commonIdeaWithDict "threeD" (pn "three-dimensional") "3D" [physics] \ No newline at end of file diff --git a/code/drasil-docLang/Drasil/Sections/TableOfUnits.hs b/code/drasil-docLang/Drasil/Sections/TableOfUnits.hs index dad1a20592..691eca0bf7 100644 --- a/code/drasil-docLang/Drasil/Sections/TableOfUnits.hs +++ b/code/drasil-docLang/Drasil/Sections/TableOfUnits.hs @@ -1,6 +1,6 @@ -- Standard code to make a table of units -- First true example of a (small!) recipe. -module Drasil.Sections.TableOfUnits(tableOfUnits, unit_table) where +module Drasil.Sections.TableOfUnits (tableOfUnits) where import Control.Lens ((^.)) import Prelude hiding (id) @@ -9,14 +9,12 @@ import Data.Drasil.Concepts.Documentation (symbol_, description) -- | Table of units section builder. Takes a list of units and an introduction tableOfUnits :: IsUnit s => [s] -> Contents -> Section -tableOfUnits u intro = Section (S "Table of Units") [Con intro, Con $ LlC (unit_table u)] +tableOfUnits u intro = Section (S "Table of Units") [Con intro, Con $ LlC (unitTable u)] (makeSecRef "ToU" "ToU") -- | Creates the actual table of units from a list of units -unit_table :: IsUnit s => [s] -> LabelledContent -unit_table u = llcc (makeTabRef "ToU") $ Table - (map atStart [symbol_, description]) (mkTable - [Sy . usymb, - \x -> (x ^. defn) +:+ sParen (phrase x) - ] u) +unitTable :: IsUnit s => [s] -> LabelledContent +unitTable u = llcc (makeTabRef "ToU") $ Table + [atStart symbol_, atStart description, S "SI Name"] + (mkTable [Sy . usymb, (^. defn), phrase] u) (S "Table of Units") False diff --git a/code/drasil-example/Drasil/SSP/Body.hs b/code/drasil-example/Drasil/SSP/Body.hs index 7c948a0a31..d8af3a2aa1 100644 --- a/code/drasil-example/Drasil/SSP/Body.hs +++ b/code/drasil-example/Drasil/SSP/Body.hs @@ -275,12 +275,13 @@ purposeDoc pname = -- SECTION 2.2 -- -- Scope of Requirements automatically generated in IScope scpIncl :: Sentence -scpIncl = S "stability analysis of a" +:+ introduceAbb twoD +:+ - phrase soil +:+ S "mass" `sC` S "composed of a single homogeneous" +:+ phrase layer +:+ S "with" +:+ phrase constant +:+. plural mtrlPrpty +:+ S "The" +:+ - phrase soil +:+ S "mass is assumed to extend infinitely in the third" +:+. phrase dimension +:+ S "The" +:+ phrase analysis +:+ S "will be at an" +:+ - S "instant in" +:+ phrase time :+: S ";" +:+ plural factor +:+ S "that" +:+ - S "may change the" +:+ plural soilPrpty +:+ S "over" +:+ phrase time +:+ - S "will not be considered" +scpIncl = foldlSent_ [S "stability analysis of a", phrase twoD, sParen(getAcc twoD), + phrase soil, S "mass" `sC` S "composed of a single homogeneous", phrase layer, + S "with", phrase constant +:+. plural mtrlPrpty, S "The", phrase soil, + S "mass is assumed to extend infinitely in the third" +:+. phrase dimension, + S "The", phrase analysis, S "will be at an instant in", phrase time :+: S ";", + plural factor, S "that", S "may change the", plural soilPrpty, S "over", phrase time, + S "will not be considered"] -- SECTION 2.3 -- -- Characteristics of the Intended Reader generated in IChar diff --git a/code/drasil-lang/Language/Drasil/NounPhrase.hs b/code/drasil-lang/Language/Drasil/NounPhrase.hs index cd116fa5e7..e4888ef068 100644 --- a/code/drasil-lang/Language/Drasil/NounPhrase.hs +++ b/code/drasil-lang/Language/Drasil/NounPhrase.hs @@ -33,17 +33,17 @@ type Capitalization = Sentence --Using type synonyms for clarity. type PluralString = String instance NounPhrase NP where - phraseNP (ProperNoun n _) = S n - phraseNP (CommonNoun n _ _) = S n - phraseNP (Phrase n _ _ _) = n - pluralNP n@(ProperNoun _ p) = sPlur (phraseNP n) p - pluralNP n@(CommonNoun _ p _) = sPlur (phraseNP n) p - pluralNP (Phrase _ p _ _) = p - sentenceCase n@ProperNoun {} _ = phraseNP n + phraseNP (ProperNoun n _) = S n + phraseNP (CommonNoun n _ _) = S n + phraseNP (Phrase n _ _ _) = n + pluralNP n@(ProperNoun _ p) = sPlur (phraseNP n) p + pluralNP n@(CommonNoun _ p _) = sPlur (phraseNP n) p + pluralNP (Phrase _ p _ _) = p + sentenceCase n@ProperNoun {} _ = phraseNP n sentenceCase n@(CommonNoun _ _ r) f = cap (f n) r sentenceCase n@(Phrase _ _ r _) f = cap (f n) r - titleCase n@ProperNoun {} _ = phraseNP n - titleCase n@CommonNoun {} f = cap (f n) CapWords + titleCase n@ProperNoun {} _ = phraseNP n + titleCase n@CommonNoun {} f = cap (f n) CapWords titleCase n@(Phrase _ _ _ r) f = cap (f n) r -- ===Constructors=== -- @@ -214,23 +214,23 @@ findHyph :: String -> String findHyph "" = "" findHyph [x] = [x] findHyph (x:y:xs) - | x == '-' = '-' : (toUpper y : xs) - | otherwise = x : findHyph (y:xs) + | x == '-' = '-' : (toUpper y : xs) + | otherwise = x : findHyph (y:xs) capFirstWord :: String -> String -capFirstWord (c:cs) - | not (isLetter c) = c : cs - | not (isLatin1 c) = c : cs - | otherwise = toUpper c : cs capFirstWord "" = "" +capFirstWord (c:cs) + | not (isLetter c) = c : cs + | not (isLatin1 c) = c : cs + | otherwise = toUpper c : cs capWords :: String -> String -capWords (c:cs) - | not (isLetter c) = c : cs - | not (isLatin1 c) = c : cs - | (c : cs) `elem` doNotCaps = toLower c : cs - | otherwise = toUpper c : cs capWords "" = "" +capWords (c:cs) + | not (isLetter c) = c : cs + | not (isLatin1 c) = c : cs + | (c : cs) `elem` doNotCaps = toLower c : cs + | otherwise = toUpper c : cs doNotCaps :: [String] doNotCaps = ["a", "an", "the", "at", "by", "for", "in", "of", diff --git a/code/stable/gamephys/SRS/Chipmunk_SRS.tex b/code/stable/gamephys/SRS/Chipmunk_SRS.tex index 8742fdc922..7779625d7b 100644 --- a/code/stable/gamephys/SRS/Chipmunk_SRS.tex +++ b/code/stable/gamephys/SRS/Chipmunk_SRS.tex @@ -33,23 +33,23 @@ \section{Reference Material} \subsection{Table of Units} \label{Sec:ToU} The unit system used throughout is SI (Système International d'Unités). In addition to the basic units, several derived units are also used. For each unit, the table lists the symbol, a description and the SI name. -\begin{longtable}{l l} +\begin{longtable}{l l l} \toprule -Symbol & Description +Symbol & Description & SI Name \\ \midrule \endhead -J & energy (joule) +J & energy & joule \\ -kg & mass (kilogram) +kg & mass & kilogram \\ -m & length (metre) +m & length & metre \\ -N & force (newton) +N & force & newton \\ -rad & angle (radian) +rad & angle & radian \\ -s & time (second) +s & time & second \\ \bottomrule \caption{} @@ -198,9 +198,9 @@ \subsection{Abbreviations and Acronyms} \\ \midrule \endhead -2D & two-dimensional +2D & Two-Dimensional \\ -3D & three-dimensional +3D & Three-Dimensional \\ A & Assumption \\ diff --git a/code/stable/gamephys/Website/Chipmunk_SRS.html b/code/stable/gamephys/Website/Chipmunk_SRS.html index d6f45b026c..9f440d2559 100644 --- a/code/stable/gamephys/Website/Chipmunk_SRS.html +++ b/code/stable/gamephys/Website/Chipmunk_SRS.html @@ -30,30 +30,37 @@

Table of Units

Symbol Description + SI Name J - energy (joule) + energy + joule kg - mass (kilogram) + mass + kilogram m - length (metre) + length + metre N - force (newton) + force + newton rad - angle (radian) + angle + radian s - time (second) + time + second @@ -398,11 +405,11 @@

Abbreviations and Acronyms

2D - two-dimensional + Two-Dimensional 3D - three-dimensional + Three-Dimensional A diff --git a/code/stable/glassbr/SRS/GlassBR_SRS.tex b/code/stable/glassbr/SRS/GlassBR_SRS.tex index 726f02e0d3..164dfaf12c 100644 --- a/code/stable/glassbr/SRS/GlassBR_SRS.tex +++ b/code/stable/glassbr/SRS/GlassBR_SRS.tex @@ -33,21 +33,21 @@ \section{Reference Material} \subsection{Table of Units} \label{Sec:ToU} The unit system used throughout is SI (Système International d'Unités). In addition to the basic units, several derived units are also used. For each unit, the table lists the symbol, a description and the SI name. -\begin{longtable}{l l} +\begin{longtable}{l l l} \toprule -Symbol & Description +Symbol & Description & SI Name \\ \midrule \endhead -kg & mass (kilogram) +kg & mass & kilogram \\ -m & length (metre) +m & length & metre \\ -N & force (newton) +N & force & newton \\ -Pa & pressure (pascal) +Pa & pressure & pascal \\ -s & time (second) +s & time & second \\ \bottomrule \caption{} diff --git a/code/stable/glassbr/Website/GlassBR_SRS.html b/code/stable/glassbr/Website/GlassBR_SRS.html index e3e35e3ad9..08f936c30a 100644 --- a/code/stable/glassbr/Website/GlassBR_SRS.html +++ b/code/stable/glassbr/Website/GlassBR_SRS.html @@ -30,26 +30,32 @@

Table of Units

Symbol Description + SI Name kg - mass (kilogram) + mass + kilogram m - length (metre) + length + metre N - force (newton) + force + newton Pa - pressure (pascal) + pressure + pascal s - time (second) + time + second diff --git a/code/stable/nopcm/SRS/NoPCM_SRS.tex b/code/stable/nopcm/SRS/NoPCM_SRS.tex index 72e5de52fb..69e3685ec0 100644 --- a/code/stable/nopcm/SRS/NoPCM_SRS.tex +++ b/code/stable/nopcm/SRS/NoPCM_SRS.tex @@ -33,23 +33,23 @@ \section{Reference Material} \subsection{Table of Units} \label{Sec:ToU} The unit system used throughout is SI (Système International d'Unités). In addition to the basic units, several derived units are also used. For each unit, the table lists the symbol, a description and the SI name. -\begin{longtable}{l l} +\begin{longtable}{l l l} \toprule -Symbol & Description +Symbol & Description & SI Name \\ \midrule \endhead -${}^{\circ}$C & temperature (centigrade) +${}^{\circ}$C & temperature & centigrade \\ -J & energy (joule) +J & energy & joule \\ -kg & mass (kilogram) +kg & mass & kilogram \\ -m & length (metre) +m & length & metre \\ -s & time (second) +s & time & second \\ -W & power (watt) +W & power & watt \\ \bottomrule \caption{} @@ -130,7 +130,7 @@ \subsection{Table of Symbols} \\ ${V_{W}}$ & Volume of water & $\text{m}^{3}$ \\ -$π$ & Circumference to diameter ratio & -- +$π$ & Ratio of circumference to diameter for any circle & -- \\ $ρ$ & Density & $\frac{\text{kg}}{\text{m}^{3}}$ \\ diff --git a/code/stable/nopcm/Website/NoPCM_SRS.html b/code/stable/nopcm/Website/NoPCM_SRS.html index 531e8b172e..76109b6050 100644 --- a/code/stable/nopcm/Website/NoPCM_SRS.html +++ b/code/stable/nopcm/Website/NoPCM_SRS.html @@ -32,30 +32,37 @@

Table of Units

Symbol Description + SI Name °C - temperature (centigrade) + temperature + centigrade J - energy (joule) + energy + joule kg - mass (kilogram) + mass + kilogram m - length (metre) + length + metre s - time (second) + time + second W - power (watt) + power + watt @@ -243,7 +250,7 @@

Table of Symbols

π - Circumference to diameter ratio + Ratio of circumference to diameter for any circle -- diff --git a/code/stable/ssp/SRS/SSP_SRS.tex b/code/stable/ssp/SRS/SSP_SRS.tex index bd583a7372..4dbc021b4e 100644 --- a/code/stable/ssp/SRS/SSP_SRS.tex +++ b/code/stable/ssp/SRS/SSP_SRS.tex @@ -33,23 +33,23 @@ \section{Reference Material} \subsection{Table of Units} \label{Sec:ToU} The unit system used throughout is SI (Système International d'Unités). In addition to the basic units, several derived units are also used. For each unit, the table lists the symbol, a description and the SI name. -\begin{longtable}{l l} +\begin{longtable}{l l l} \toprule -Symbol & Description +Symbol & Description & SI Name \\ \midrule \endhead -${}^{\circ}$ & angle (degree) +${}^{\circ}$ & angle & degree \\ -kg & mass (kilogram) +kg & mass & kilogram \\ -m & length (metre) +m & length & metre \\ -N & force (newton) +N & force & newton \\ -Pa & pressure (pascal) +Pa & pressure & pascal \\ -s & time (second) +s & time & second \\ \bottomrule \caption{} @@ -218,7 +218,7 @@ \subsection{Table of Symbols} \\ $λ$ & Proportionality Constant: for the interslice normal to shear force ratio & -- \\ -$π$ & Circumference to Diameter Ratio: The ratio of a circle's circumference to its diameter & -- +$π$ & Ratio of Circumference to Diameter for Any Circle: The ratio of a circle's circumference to its diameter & -- \\ $ρ$ & Density: mass per unit volume & $\frac{\text{kg}}{\text{m}^{3}}$ \\ @@ -258,9 +258,9 @@ \subsection{Abbreviations and Acronyms} \\ \midrule \endhead -2D & two-dimensional +2D & Two-Dimensional \\ -3D & three-dimensional +3D & Three-Dimensional \\ A & Assumption \\ @@ -1491,7 +1491,7 @@ \subsubsection{Data Definitions} \\ \midrule \\ Description & \begin{symbDescription} \item{$\mathbf{f}$ is the interslice normal to shear force ratio variation function (Unitless)} - \item{$π$ is the circumference to diameter ratio (Unitless)} + \item{$π$ is the ratio of circumference to diameter for any circle (Unitless)} \item{${\mathbf{x}_{slip}}$ is the x-coordinates of the slip surface (m)} \item{$i$ is the index (Unitless)} \item{$n$ is the number of slices (Unitless)} diff --git a/code/stable/ssp/Website/SSP_SRS.html b/code/stable/ssp/Website/SSP_SRS.html index 45d3c0cfae..c451f638ae 100644 --- a/code/stable/ssp/Website/SSP_SRS.html +++ b/code/stable/ssp/Website/SSP_SRS.html @@ -34,30 +34,37 @@

Table of Units

Symbol Description + SI Name ° - angle (degree) + angle + degree kg - mass (kilogram) + mass + kilogram m - length (metre) + length + metre N - force (newton) + force + newton Pa - pressure (pascal) + pressure + pascal s - time (second) + time + second @@ -586,7 +593,7 @@

Table of Symbols

π - Circumference to Diameter Ratio: The ratio of a circle's circumference to its diameter + Ratio of Circumference to Diameter for Any Circle: The ratio of a circle's circumference to its diameter -- @@ -684,11 +691,11 @@

Abbreviations and Acronyms

2D - two-dimensional + Two-Dimensional 3D - three-dimensional + Three-Dimensional A @@ -3261,7 +3268,7 @@

Data Definitions

f is the interslice normal to shear force ratio variation function (Unitless)
  • - π is the circumference to diameter ratio (Unitless) + π is the ratio of circumference to diameter for any circle (Unitless)
  • xslip is the x-coordinates of the slip surface (m) diff --git a/code/stable/swhs/SRS/SWHS_SRS.tex b/code/stable/swhs/SRS/SWHS_SRS.tex index 2202665949..ced5759909 100644 --- a/code/stable/swhs/SRS/SWHS_SRS.tex +++ b/code/stable/swhs/SRS/SWHS_SRS.tex @@ -33,23 +33,23 @@ \section{Reference Material} \subsection{Table of Units} \label{Sec:ToU} The unit system used throughout is SI (Système International d'Unités). In addition to the basic units, several derived units are also used. For each unit, the table lists the symbol, a description and the SI name. -\begin{longtable}{l l} +\begin{longtable}{l l l} \toprule -Symbol & Description +Symbol & Description & SI Name \\ \midrule \endhead -${}^{\circ}$C & temperature (centigrade) +${}^{\circ}$C & temperature & centigrade \\ -J & energy (joule) +J & energy & joule \\ -kg & mass (kilogram) +kg & mass & kilogram \\ -m & length (metre) +m & length & metre \\ -s & time (second) +s & time & second \\ -W & power (watt) +W & power & watt \\ \bottomrule \caption{} @@ -178,7 +178,7 @@ \subsection{Table of Symbols} \\ $η$ & ODE parameter & -- \\ -$π$ & Circumference to diameter ratio & -- +$π$ & Ratio of circumference to diameter for any circle & -- \\ $ρ$ & Density & $\frac{\text{kg}}{\text{m}^{3}}$ \\ diff --git a/code/stable/swhs/Website/SWHS_SRS.html b/code/stable/swhs/Website/SWHS_SRS.html index 9f00da0e19..32b08d6450 100644 --- a/code/stable/swhs/Website/SWHS_SRS.html +++ b/code/stable/swhs/Website/SWHS_SRS.html @@ -36,30 +36,37 @@

    Table of Units

    Symbol Description + SI Name °C - temperature (centigrade) + temperature + centigrade J - energy (joule) + energy + joule kg - mass (kilogram) + mass + kilogram m - length (metre) + length + metre s - time (second) + time + second W - power (watt) + power + watt @@ -369,7 +376,7 @@

    Table of Symbols

    π - Circumference to diameter ratio + Ratio of circumference to diameter for any circle -- diff --git a/code/stable/tiny/SRS/Tiny_SRS.tex b/code/stable/tiny/SRS/Tiny_SRS.tex index bce915e900..fccd02beb6 100644 --- a/code/stable/tiny/SRS/Tiny_SRS.tex +++ b/code/stable/tiny/SRS/Tiny_SRS.tex @@ -28,17 +28,17 @@ \section{Reference Material} \subsection{Table of Units} \label{Sec:ToU} The unit system used throughout is SI (Système International d'Unités). In addition to the basic units, several derived units are also used. For each unit, the table lists the symbol, a description and the SI name. -\begin{longtable}{l l} +\begin{longtable}{l l l} \toprule -Symbol & Description +Symbol & Description & SI Name \\ \midrule \endhead -${}^{\circ}$C & temperature (centigrade) +${}^{\circ}$C & temperature & centigrade \\ -m & length (metre) +m & length & metre \\ -W & power (watt) +W & power & watt \\ \bottomrule \caption{} diff --git a/code/stable/tiny/Website/Tiny_SRS.html b/code/stable/tiny/Website/Tiny_SRS.html index 3c6e0d826a..a12428936c 100644 --- a/code/stable/tiny/Website/Tiny_SRS.html +++ b/code/stable/tiny/Website/Tiny_SRS.html @@ -28,18 +28,22 @@

    Table of Units

    Symbol Description + SI Name °C - temperature (centigrade) + temperature + centigrade m - length (metre) + length + metre W - power (watt) + power + watt From a654a7a2ddeaac98ff2cf4030f4b966ac41164a8 Mon Sep 17 00:00:00 2001 From: bmaclach Date: Thu, 27 Jun 2019 14:47:50 -0400 Subject: [PATCH 11/11] Remove Statements from GOOL Modules (#1642) * Removed statements from modules * Updated tests and Import.hs --- .../Language/Drasil/Code/Imperative/Import.hs | 4 ++-- .../Drasil/Code/Imperative/LanguageRenderer.hs | 8 ++------ .../LanguageRenderer/CSharpRenderer.hs | 9 ++++----- .../Imperative/LanguageRenderer/CppRenderer.hs | 8 ++++---- .../Imperative/LanguageRenderer/JavaRenderer.hs | 9 ++++----- .../LanguageRenderer/PythonRenderer.hs | 17 +++++------------ .../Drasil/Code/Imperative/Symantics.hs | 4 ++-- code/drasil-code/Test/FileTests.hs | 2 +- code/drasil-code/Test/HelloWorld.hs | 2 +- code/drasil-code/Test/Helper.hs | 2 +- code/drasil-code/Test/Observer.hs | 2 +- code/drasil-code/Test/PatternTest.hs | 2 +- 12 files changed, 28 insertions(+), 41 deletions(-) diff --git a/code/drasil-code/Language/Drasil/Code/Imperative/Import.hs b/code/drasil-code/Language/Drasil/Code/Imperative/Import.hs index 7bde4e69bd..bad2273db2 100644 --- a/code/drasil-code/Language/Drasil/Code/Imperative/Import.hs +++ b/code/drasil-code/Language/Drasil/Code/Imperative/Import.hs @@ -201,7 +201,7 @@ genInputModNoClass :: (RenderSym repr) => Reader (State repr) genInputModNoClass = do inpDer <- genInputDerived inpConstr <- genInputConstraints - return [ buildModule "InputParameters" [] [] + return [ buildModule "InputParameters" [] (catMaybes [inpDer, inpConstr]) [] ] @@ -447,7 +447,7 @@ genModule n maybeMs maybeCs = do updateState = withReader (\s -> s { currentModule = n }) cs <- maybe (return []) updateState maybeCs ms <- maybe (return []) updateState maybeMs - return $ buildModule n ls [] ms cs + return $ buildModule n ls ms cs genMain :: (RenderSym repr) => Reader (State repr) (repr (Module repr)) diff --git a/code/drasil-code/Language/Drasil/Code/Imperative/LanguageRenderer.hs b/code/drasil-code/Language/Drasil/Code/Imperative/LanguageRenderer.hs index 9083f22b86..68bd35cca6 100644 --- a/code/drasil-code/Language/Drasil/Code/Imperative/LanguageRenderer.hs +++ b/code/drasil-code/Language/Drasil/Code/Imperative/LanguageRenderer.hs @@ -29,7 +29,7 @@ module Language.Drasil.Code.Imperative.LanguageRenderer ( sizeDocD, listAccessDocD, listSetDocD, objAccessDocD, castObjDocD, includeD, breakDocD, continueDocD, staticDocD, dynamicDocD, privateDocD, publicDocD, addCommentsDocD, valList, prependToBody, appendToBody, surroundBody, - getterName, setterName, setMain, setEmpty, statementsToStateVars + getterName, setterName, setMain, setEmpty ) where import Utils.Drasil (capitalize, indent, indentList) @@ -676,8 +676,4 @@ setMain :: (Doc, Bool) -> (Doc, Bool) setMain (d, _) = (d, True) setEmpty :: (Doc, Terminator) -> (Doc, Terminator) -setEmpty (d, _) = (d, Empty) - --- Hack because modules accept Statement representations of their state variables. Modules should be redesigned/rethought -statementsToStateVars :: Doc -> Doc -> Doc -> (Doc, Terminator) -> Doc -statementsToStateVars s p end (v, _) = s <+> p <+> v <> end \ No newline at end of file +setEmpty (d, _) = (d, Empty) \ No newline at end of file diff --git a/code/drasil-code/Language/Drasil/Code/Imperative/LanguageRenderer/CSharpRenderer.hs b/code/drasil-code/Language/Drasil/Code/Imperative/LanguageRenderer/CSharpRenderer.hs index f4650a9f3b..d1752ae0a1 100644 --- a/code/drasil-code/Language/Drasil/Code/Imperative/LanguageRenderer/CSharpRenderer.hs +++ b/code/drasil-code/Language/Drasil/Code/Imperative/LanguageRenderer/CSharpRenderer.hs @@ -39,7 +39,7 @@ import Language.Drasil.Code.Imperative.LanguageRenderer ( listAccessDocD, objAccessDocD, castObjDocD, breakDocD, continueDocD, staticDocD, dynamicDocD, privateDocD, publicDocD, dot, new, observerListName, doubleSlash, addCommentsDocD, valList, surroundBody, getterName, setterName, - setMain, setEmpty, statementsToStateVars) + setMain, setEmpty) import Language.Drasil.Code.Imperative.Helpers (Terminator(..), FuncData(..), fd, ModData(..), md, TypeData(..), td, ValData(..), vd, updateValDoc, liftA4, liftA5, liftA6, liftA7, liftList, lift1List, lift3Pair, lift4Pair, @@ -547,10 +547,9 @@ instance ClassSym CSharpCode where instance ModuleSym CSharpCode where type Module CSharpCode = ModData - buildModule n _ vs ms cs = fmap (md n (any (snd . unCSC) ms || - any (snd . unCSC) cs)) (liftList moduleDocD (if null vs && null ms then cs - else pubClass n Nothing (map (liftA4 statementsToStateVars public static_ - endStatement) vs) ms : cs)) + buildModule n _ ms cs = fmap (md n (any (snd . unCSC) ms || + any (snd . unCSC) cs)) (liftList moduleDocD (if null ms then cs + else pubClass n Nothing [] ms : cs)) cstop :: Doc -> Doc -> Doc cstop end inc = vcat [ diff --git a/code/drasil-code/Language/Drasil/Code/Imperative/LanguageRenderer/CppRenderer.hs b/code/drasil-code/Language/Drasil/Code/Imperative/LanguageRenderer/CppRenderer.hs index 72c931c7a6..b41726b77f 100644 --- a/code/drasil-code/Language/Drasil/Code/Imperative/LanguageRenderer/CppRenderer.hs +++ b/code/drasil-code/Language/Drasil/Code/Imperative/LanguageRenderer/CppRenderer.hs @@ -547,8 +547,8 @@ instance (Pair p) => ClassSym (p CppSrcCode CppHdrCode) where instance (Pair p) => ModuleSym (p CppSrcCode CppHdrCode) where type Module (p CppSrcCode CppHdrCode) = ModData - buildModule n l vs ms cs = pair (buildModule n l (map pfst vs) (map pfst ms) - (map pfst cs)) (buildModule n l (map psnd vs) (map psnd ms) (map psnd cs)) + buildModule n l ms cs = pair (buildModule n l (map pfst ms) (map pfst cs)) + (buildModule n l (map psnd ms) (map psnd cs)) ----------------- -- Source File -- @@ -1079,7 +1079,7 @@ instance ClassSym CppSrcCode where instance ModuleSym CppSrcCode where type Module CppSrcCode = ModData - buildModule n l _ ms cs = fmap (md n (any (snd . unCPPSC) cs || + buildModule n l ms cs = fmap (md n (any (snd . unCPPSC) cs || any (isMainMthd . unCPPSC) ms)) (if all (isEmpty . fst . unCPPSC) cs && all (isEmpty . mthdDoc . unCPPSC) ms then return empty else liftA5 cppModuleDoc (liftList vcat (map include l)) @@ -1519,7 +1519,7 @@ instance ClassSym CppHdrCode where instance ModuleSym CppHdrCode where type Module CppHdrCode = ModData - buildModule n l _ ms cs = fmap (md n (any (snd . unCPPHC) cs || + buildModule n l ms cs = fmap (md n (any (snd . unCPPHC) cs || any (snd . unCPPHC) methods)) (if all (isEmpty . fst . unCPPHC) cs && all (isEmpty . mthdDoc . unCPPHC) ms then return empty else liftA5 cppModuleDoc (liftList vcat (map include l)) (if not (null l) && any diff --git a/code/drasil-code/Language/Drasil/Code/Imperative/LanguageRenderer/JavaRenderer.hs b/code/drasil-code/Language/Drasil/Code/Imperative/LanguageRenderer/JavaRenderer.hs index 4c375d91e5..f8d2922882 100644 --- a/code/drasil-code/Language/Drasil/Code/Imperative/LanguageRenderer/JavaRenderer.hs +++ b/code/drasil-code/Language/Drasil/Code/Imperative/LanguageRenderer/JavaRenderer.hs @@ -38,7 +38,7 @@ import Language.Drasil.Code.Imperative.LanguageRenderer ( funcDocD, castDocD, objAccessDocD, castObjDocD, breakDocD, continueDocD, staticDocD, dynamicDocD, privateDocD, publicDocD, dot, new, forLabel, observerListName, doubleSlash, addCommentsDocD, valList, surroundBody, - getterName, setterName, setMain, setEmpty, statementsToStateVars) + getterName, setterName, setMain, setEmpty) import Language.Drasil.Code.Imperative.Helpers (Terminator(..), FuncData(..), fd, ModData(..), md, TypeData(..), td, ValData(..), vd, angles, liftA4, liftA5, liftA6, liftA7, liftList, lift1List, lift3Pair, lift4Pair, @@ -567,10 +567,9 @@ instance ClassSym JavaCode where instance ModuleSym JavaCode where type Module JavaCode = ModData - buildModule n _ vs ms cs = fmap (md n (any (snd . unJC) ms || - any (snd . unJC) cs)) (liftList moduleDocD (if null vs && null ms then cs - else pubClass n Nothing (map (liftA4 statementsToStateVars public static_ - endStatement) vs) ms : cs)) + buildModule n _ ms cs = fmap (md n (any (snd . unJC) ms || + any (snd . unJC) cs)) (liftList moduleDocD (if null ms then cs + else pubClass n Nothing [] ms : cs)) enumsEqualInts :: Bool enumsEqualInts = False diff --git a/code/drasil-code/Language/Drasil/Code/Imperative/LanguageRenderer/PythonRenderer.hs b/code/drasil-code/Language/Drasil/Code/Imperative/LanguageRenderer/PythonRenderer.hs index b5a745259a..abdd7773f4 100644 --- a/code/drasil-code/Language/Drasil/Code/Imperative/LanguageRenderer/PythonRenderer.hs +++ b/code/drasil-code/Language/Drasil/Code/Imperative/LanguageRenderer/PythonRenderer.hs @@ -510,12 +510,11 @@ instance ClassSym PythonCode where instance ModuleSym PythonCode where type Module PythonCode = ModData - buildModule n ls vs fs cs = fmap (md n (any (snd . unPC) fs || + buildModule n ls fs cs = fmap (md n (any (snd . unPC) fs || any (snd . unPC) cs)) (if all (isEmpty . fst . unPC) cs && all (isEmpty . fst . unPC) fs then return empty else - liftA4 pyModule (liftList pyModuleImportList (map - include ls)) (liftList pyModuleVarList (map state vs)) (liftList - methodListDocD fs) (liftList pyModuleClassList cs)) + liftA3 pyModule (liftList pyModuleImportList (map include ls)) + (liftList methodListDocD fs) (liftList pyModuleClassList cs)) -- convenience imp, incl, initName :: Label @@ -628,22 +627,16 @@ pyClass n pn fs = vcat [ pyModuleImportList :: [Doc] -> Doc pyModuleImportList = vcat -pyModuleVarList :: [(Doc, Terminator)] -> Doc -pyModuleVarList vs = vcat (map fst vs) - pyModuleClassList :: [(Doc, Bool)] -> Doc pyModuleClassList cs = vibcat $ map fst cs -pyModule :: Doc -> Doc -> Doc -> Doc -> Doc -pyModule ls vs fs cs = +pyModule :: Doc -> Doc -> Doc -> Doc +pyModule ls fs cs = libs $+$ - vars $+$ funcs $+$ cs where libs | isEmpty ls = empty | otherwise = ls $+$ blank - vars | isEmpty vs = empty - | otherwise = vs $+$ blank funcs | isEmpty fs = empty | otherwise = fs $+$ blank diff --git a/code/drasil-code/Language/Drasil/Code/Imperative/Symantics.hs b/code/drasil-code/Language/Drasil/Code/Imperative/Symantics.hs index aa144a0b68..3d2f4cfc46 100644 --- a/code/drasil-code/Language/Drasil/Code/Imperative/Symantics.hs +++ b/code/drasil-code/Language/Drasil/Code/Imperative/Symantics.hs @@ -539,5 +539,5 @@ class (StateVarSym repr, MethodSym repr) => ClassSym repr where class (ClassSym repr) => ModuleSym repr where type Module repr - buildModule :: Label -> [Library] -> [repr (Statement repr)] -> - [repr (Method repr)] -> [repr (Class repr)] -> repr (Module repr) + buildModule :: Label -> [Library] -> [repr (Method repr)] -> + [repr (Class repr)] -> repr (Module repr) diff --git a/code/drasil-code/Test/FileTests.hs b/code/drasil-code/Test/FileTests.hs index 004f3f71b3..d53eb7ccf2 100644 --- a/code/drasil-code/Test/FileTests.hs +++ b/code/drasil-code/Test/FileTests.hs @@ -7,7 +7,7 @@ import Language.Drasil.Code (PackageSym(..), RenderSym(..), PermanenceSym(..), import Prelude hiding (return,print,log,exp,sin,cos,tan) fileTests :: (PackageSym repr) => repr (Package repr) -fileTests = packMods "FileTests" [fileDoc (buildModule "FileTests" [] [] [fileTestMethod] [])] +fileTests = packMods "FileTests" [fileDoc (buildModule "FileTests" [] [fileTestMethod] [])] fileTestMethod :: (RenderSym repr) => repr (Method repr) fileTestMethod = mainMethod "FileTests" (body [writeStory, block [readStory], diff --git a/code/drasil-code/Test/HelloWorld.hs b/code/drasil-code/Test/HelloWorld.hs index d57fe4fc27..c68f6a93bc 100644 --- a/code/drasil-code/Test/HelloWorld.hs +++ b/code/drasil-code/Test/HelloWorld.hs @@ -14,7 +14,7 @@ import Test.Helper (helper) helloWorld :: (PackageSym repr) => repr (Package repr) helloWorld = packMods "HelloWorld" [fileDoc (buildModule "HelloWorld" - ["Helper"] [] [helloWorldMain] []), helper] + ["Helper"] [helloWorldMain] []), helper] helloWorldMain :: (RenderSym repr) => repr (Method repr) helloWorldMain = mainMethod "HelloWorld" (body [ helloInitVariables, diff --git a/code/drasil-code/Test/Helper.hs b/code/drasil-code/Test/Helper.hs index 5795ef22f0..efc3421669 100644 --- a/code/drasil-code/Test/Helper.hs +++ b/code/drasil-code/Test/Helper.hs @@ -7,7 +7,7 @@ import Language.Drasil.Code.Imperative.Symantics ( import Prelude hiding (return,print,log,exp,sin,cos,tan) helper :: (RenderSym repr) => repr (RenderFile repr) -helper = fileDoc (buildModule "Helper" [] [] [doubleAndAdd] []) +helper = fileDoc (buildModule "Helper" [] [doubleAndAdd] []) doubleAndAdd :: (RenderSym repr) => repr (Method repr) doubleAndAdd = function "doubleAndAdd" public static_ (mState float) diff --git a/code/drasil-code/Test/Observer.hs b/code/drasil-code/Test/Observer.hs index afaa67cd17..8b18780771 100644 --- a/code/drasil-code/Test/Observer.hs +++ b/code/drasil-code/Test/Observer.hs @@ -7,7 +7,7 @@ import Language.Drasil.Code.Imperative.Symantics ( import Prelude hiding (return,print,log,exp,sin,cos,tan) observer :: (RenderSym repr) => repr (RenderFile repr) -observer = fileDoc (buildModule "Observer" [] [] [] [helperClass]) +observer = fileDoc (buildModule "Observer" [] [] [helperClass]) helperClass :: (RenderSym repr) => repr (Class repr) helperClass = pubClass "Observer" Nothing [stateVar 0 "x" public dynamic_ int] [observerConstructor, printNumMethod] diff --git a/code/drasil-code/Test/PatternTest.hs b/code/drasil-code/Test/PatternTest.hs index 6cb39964d9..323d60e26f 100644 --- a/code/drasil-code/Test/PatternTest.hs +++ b/code/drasil-code/Test/PatternTest.hs @@ -9,7 +9,7 @@ import Prelude hiding (return,print,log,exp,sin,cos,tan) import Test.Observer (observer) patternTest :: (PackageSym repr) => repr (Package repr) -patternTest = packMods "PatternTest" [fileDoc (buildModule "PatternTest" ["Observer"] [] [patternTestMainMethod] []), observer] +patternTest = packMods "PatternTest" [fileDoc (buildModule "PatternTest" ["Observer"] [patternTestMainMethod] []), observer] patternTestMainMethod :: (RenderSym repr) => repr (Method repr) patternTestMainMethod = mainMethod "PatternTest" (body [block [