diff --git a/code/drasil-gool/lib/Drasil/GOOL/CodeInfoOO.hs b/code/drasil-gool/lib/Drasil/GOOL/CodeInfoOO.hs index 88814d7cf8..ea77876367 100644 --- a/code/drasil-gool/lib/Drasil/GOOL/CodeInfoOO.hs +++ b/code/drasil-gool/lib/Drasil/GOOL/CodeInfoOO.hs @@ -256,6 +256,7 @@ instance List CodeInfoOO where instance Set CodeInfoOO where contains = execute2 setAdd = execute2 + setRemove = execute2 instance InternalList CodeInfoOO where listSlice' b e s _ vl = zoom lensMStoVS $ do diff --git a/code/drasil-gool/lib/Drasil/GOOL/CodeInfoProc.hs b/code/drasil-gool/lib/Drasil/GOOL/CodeInfoProc.hs index 133b934989..7ffff2f993 100644 --- a/code/drasil-gool/lib/Drasil/GOOL/CodeInfoProc.hs +++ b/code/drasil-gool/lib/Drasil/GOOL/CodeInfoProc.hs @@ -209,6 +209,7 @@ instance List CodeInfoProc where instance Set CodeInfoProc where contains = execute2 setAdd = execute2 + setRemove = execute2 instance InternalList CodeInfoProc where listSlice' b e s _ vl = zoom lensMStoVS $ do diff --git a/code/drasil-gool/lib/Drasil/GOOL/InterfaceCommon.hs b/code/drasil-gool/lib/Drasil/GOOL/InterfaceCommon.hs index 777d4de6bf..bf0493d09d 100644 --- a/code/drasil-gool/lib/Drasil/GOOL/InterfaceCommon.hs +++ b/code/drasil-gool/lib/Drasil/GOOL/InterfaceCommon.hs @@ -289,6 +289,12 @@ class (ValueSym r) => Set r where -- | Inserts a value into a set -- Arguments are: Set, Value setAdd :: SValue r -> SValue r -> SValue r + -- | Removes a value from a set + -- Arguments are: Set, Value + setRemove :: SValue r -> SValue r -> SValue r + -- | Removes a value from a set + -- Arguments are: Set, Set + --setUnion :: SValue r -> SValue r -> SValue r class (ValueSym r) => InternalList r where listSlice' :: Maybe (SValue r) -> Maybe (SValue r) -> Maybe (SValue r) diff --git a/code/drasil-gool/lib/Drasil/GOOL/LanguageRenderer/CSharpRenderer.hs b/code/drasil-gool/lib/Drasil/GOOL/LanguageRenderer/CSharpRenderer.hs index db4f5e23e8..622a059421 100644 --- a/code/drasil-gool/lib/Drasil/GOOL/LanguageRenderer/CSharpRenderer.hs +++ b/code/drasil-gool/lib/Drasil/GOOL/LanguageRenderer/CSharpRenderer.hs @@ -66,7 +66,7 @@ import qualified Drasil.GOOL.LanguageRenderer.LanguagePolymorphic as G ( minusOp, multOp, divideOp, moduloOp, var, staticVar, objVar, arrayElem, litChar, litDouble, litInt, litString, valueOf, arg, argsList, objAccess, objMethodCall, call, funcAppMixedArgs, selfFuncAppMixedArgs, newObjMixedArgs, - lambda, func, get, set, setAddFunc, setAdd, listAdd, listAppend, listAccess, listSet, getFunc, + lambda, func, get, set, setMethodFunc, setAdd, setRemove, listAdd, listAppend, listAccess, listSet, getFunc, setFunc, listAppendFunc, stmt, loopStmt, emptyStmt, assign, subAssign, increment, objDecNew, print, closeFile, returnStmt, valStmt, comment, throw, ifCond, tryCatch, construct, param, method, getMethod, @@ -447,6 +447,7 @@ instance List CSharpCode where instance Set CSharpCode where contains = CP.contains csContains setAdd = G.setAdd + setRemove = G.setRemove instance InternalList CSharpCode where listSlice' = M.listSlice @@ -463,7 +464,8 @@ instance InternalListFunc CSharpCode where listSetFunc = CP.listSetFunc R.listSetFunc instance InternalSetFunc CSharpCode where - setAddFunc _ = G.setAddFunc csListAppend + setAddFunc _ = G.setMethodFunc csListAppend + setRemoveFunc _ = G.setMethodFunc csListRemove instance ThunkSym CSharpCode where type Thunk CSharpCode = CommonThunk VS @@ -779,7 +781,7 @@ csLambdaSep = text "=>" csSystem, csConsole, csGeneric, csDiagnostics, csIO, csList, csSet, csInt, csFloat, csBool, csChar, csParse, csReader, csWriter, csReadLine, csWrite, csWriteLine, - csIndex, csContains, csListAdd, csListAppend, csClose, csEOS, csSplit, csMain, + csIndex, csContains, csListAdd, csListAppend, csListRemove, csClose, csEOS, csSplit, csMain, csFunc :: String csSystem = "System" csConsole = "Console" @@ -802,6 +804,7 @@ csIndex = "IndexOf" csContains = "Contains" csListAdd = "Insert" csListAppend = "Add" +csListRemove = "Remove" csClose = "Close" csEOS = "EndOfStream" csSplit = "Split" diff --git a/code/drasil-gool/lib/Drasil/GOOL/LanguageRenderer/CppRenderer.hs b/code/drasil-gool/lib/Drasil/GOOL/LanguageRenderer/CppRenderer.hs index 4886531efb..240a97a74e 100644 --- a/code/drasil-gool/lib/Drasil/GOOL/LanguageRenderer/CppRenderer.hs +++ b/code/drasil-gool/lib/Drasil/GOOL/LanguageRenderer/CppRenderer.hs @@ -73,7 +73,7 @@ import qualified Drasil.GOOL.LanguageRenderer.LanguagePolymorphic as G ( minusOp, multOp, divideOp, moduloOp, var, staticVar, objVar, arrayElem, litChar, litDouble, litInt, litString, valueOf, arg, argsList, objAccess, objMethodCall, funcAppMixedArgs, selfFuncAppMixedArgs, newObjMixedArgs, - lambda, func, get, set, setAdd, setAddFunc, listAdd, listAppend, listAccess, listSet, getFunc, + lambda, func, get, set, setAdd, setRemove, setMethodFunc, listAdd, listAppend, listAccess, listSet, getFunc, setFunc, listAppendFunc, stmt, loopStmt, emptyStmt, assign, subAssign, increment, objDecNew, print, closeFile, returnStmt, valStmt, comment, throw, ifCond, tryCatch, construct, param, method, getMethod, setMethod, function, @@ -465,6 +465,7 @@ instance (Pair p) => List (p CppSrcCode CppHdrCode) where instance (Pair p) => Set (p CppSrcCode CppHdrCode) where contains = pair2 contains contains setAdd = pair2 setAdd setAdd + setRemove = pair2 setRemove setRemove instance (Pair p) => InternalList (p CppSrcCode CppHdrCode) where listSlice' b e s vr vl = pair2 @@ -487,6 +488,7 @@ instance (Pair p) => InternalListFunc (p CppSrcCode CppHdrCode) where instance (Pair p) => InternalSetFunc (p CppSrcCode CppHdrCode) where setAddFunc = pair2 setAddFunc setAddFunc + setRemoveFunc = pair2 setRemoveFunc setRemoveFunc instance ThunkSym (p CppSrcCode CppHdrCode) where type Thunk (p CppSrcCode CppHdrCode) = CommonThunk VS @@ -1391,6 +1393,7 @@ instance List CppSrcCode where instance Set CppSrcCode where contains = CP.containsInt cppIndex cppIterEnd setAdd = G.setAdd + setRemove = G.setRemove instance InternalList CppSrcCode where listSlice' = M.listSlice @@ -1407,7 +1410,8 @@ instance InternalListFunc CppSrcCode where listSetFunc = CP.listSetFunc cppListSetDoc instance InternalSetFunc CppSrcCode where - setAddFunc _ = G.setAddFunc cppListAdd + setAddFunc _ = G.setMethodFunc cppListAdd + setRemoveFunc _ = G.setMethodFunc cppListRemove instance ThunkSym CppSrcCode where type Thunk CppSrcCode = CommonThunk VS @@ -2099,6 +2103,7 @@ instance List CppHdrCode where instance Set CppHdrCode where contains _ _ = mkStateVal void empty setAdd _ _ = mkStateVal void empty + setRemove _ _ = mkStateVal void empty instance InternalList CppHdrCode where listSlice' _ _ _ _ _ = toState $ toCode empty @@ -2116,6 +2121,7 @@ instance InternalListFunc CppHdrCode where instance InternalSetFunc CppHdrCode where setAddFunc _ _ = funcFromData empty void + setRemoveFunc _ _ = funcFromData empty void instance ThunkSym CppHdrCode where type Thunk CppHdrCode = CommonThunk VS @@ -2508,7 +2514,7 @@ ptrAccess' = text ptrAccess nmSpc, ptrAccess, cppFor, std, algorithm, cppString, vector, sstream, stringstream, fstream, iostream, limits, mathh, cassert, cppBool, cppInfile, cppOutfile, cppIterator, cppOpen, stod, stof, cppIgnore, numLimits, streamsize, max, - endl, cin, cout, cppIndex, cppListAccess, cppListAdd, cppListAppend, + endl, cin, cout, cppIndex, cppListAccess, cppListAdd, cppListRemove, cppListAppend, cppIterBegin, cppIterEnd, cppR, cppW, cppA, cppGetLine, cppClose, cppClear, cppStr, mathDefines, cppSet, cppIn, cppConst :: String nmSpc = "::" @@ -2542,6 +2548,7 @@ cout = stdAccess "cout" cppIndex= "find" cppListAccess = "at" cppListAdd = "insert" +cppListRemove = "erase" cppListAppend = "push_back" cppIterBegin = "begin" cppIterEnd = "end" diff --git a/code/drasil-gool/lib/Drasil/GOOL/LanguageRenderer/JavaRenderer.hs b/code/drasil-gool/lib/Drasil/GOOL/LanguageRenderer/JavaRenderer.hs index 3ee7c0e55e..9f684edfee 100644 --- a/code/drasil-gool/lib/Drasil/GOOL/LanguageRenderer/JavaRenderer.hs +++ b/code/drasil-gool/lib/Drasil/GOOL/LanguageRenderer/JavaRenderer.hs @@ -68,7 +68,7 @@ import qualified Drasil.GOOL.LanguageRenderer.LanguagePolymorphic as G ( minusOp, multOp, divideOp, moduloOp, var, staticVar, objVar, arrayElem, litChar, litDouble, litInt, litString, valueOf, arg, argsList, objAccess, objMethodCall, funcAppMixedArgs, selfFuncAppMixedArgs, newObjMixedArgs, - lambda, func, get, set, listAdd, setAdd, setAddFunc, listAppend, listAccess, listSet, getFunc, + lambda, func, get, set, listAdd, setAdd, setRemove, setMethodFunc, listAppend, listAccess, listSet, getFunc, setFunc, listAppendFunc, stmt, loopStmt, emptyStmt, assign, subAssign, increment, objDecNew, print, closeFile, returnStmt, valStmt, comment, throw, ifCond, tryCatch, construct, param, method, getMethod, setMethod, function, @@ -476,6 +476,7 @@ instance List JavaCode where instance Set JavaCode where contains = CP.contains jContains setAdd = G.setAdd + setRemove = G.setRemove instance InternalList JavaCode where listSlice' = M.listSlice @@ -492,7 +493,8 @@ instance InternalListFunc JavaCode where listSetFunc = jListSetFunc instance InternalSetFunc JavaCode where - setAddFunc _ = G.setAddFunc jListAdd + setAddFunc _ = G.setMethodFunc jListAdd + setRemoveFunc _ = G.setMethodFunc jListRemove instance ThunkSym JavaCode where type Thunk JavaCode = CommonThunk VS @@ -820,7 +822,7 @@ jLambdaSep = text "->" arrayList, jBool, jBool', jInteger, jObject, jScanner, jContains, jPrintWriter, jFile, jFileWriter, jIOExc, jFNFExc, jArrays, jSet, jAsList, jSetOf, jStdIn, jStdOut, jPrintLn, jEquals, jParseInt, jParseDbl, jParseFloat, jIndex, - jListAdd, jListAccess, jListSet, jClose, jNext, jNextLine, jNextBool, + jListAdd, jListRemove, jListAccess, jListSet, jClose, jNext, jNextLine, jNextBool, jHasNextLine, jCharAt, jSplit, io, util :: String arrayList = "ArrayList" jBool = "boolean" @@ -847,6 +849,7 @@ jParseDbl = CP.doubleRender `access` "parseDouble" jParseFloat = CP.floatRender `access` "parseFloat" jIndex = "indexOf" jListAdd = "add" +jListRemove = "remove" jListAccess = "get" jListSet = "set" jClose = "close" diff --git a/code/drasil-gool/lib/Drasil/GOOL/LanguageRenderer/JuliaRenderer.hs b/code/drasil-gool/lib/Drasil/GOOL/LanguageRenderer/JuliaRenderer.hs index ab452bb974..1a7bfafb5d 100644 --- a/code/drasil-gool/lib/Drasil/GOOL/LanguageRenderer/JuliaRenderer.hs +++ b/code/drasil-gool/lib/Drasil/GOOL/LanguageRenderer/JuliaRenderer.hs @@ -30,7 +30,7 @@ import Drasil.GOOL.RendererClassesCommon (CommonRenderSym, ImportSym(..), ImportElim, RenderBody(..), BodyElim, RenderBlock(..), BlockElim, RenderType(..), InternalTypeElim, UnaryOpSym(..), BinaryOpSym(..), OpElim(uOpPrec, bOpPrec), RenderVariable(..), InternalVarElim(variableBind), - RenderValue(..), ValueElim(..), InternalListFunc(..), RenderFunction(..), + RenderValue(..), ValueElim(..), InternalListFunc(..), InternalSetFunc(..), RenderFunction(..), FunctionElim(functionType), InternalAssignStmt(..), InternalIOStmt(..), InternalControlStmt(..), RenderStatement(..), StatementElim(statementTerm), RenderVisibility(..), VisibilityElim, MethodTypeSym(..), RenderParam(..), @@ -401,6 +401,7 @@ instance List JuliaCode where instance Set JuliaCode where contains s e = funcApp "in" bool [e, s] setAdd = CP.listAppend + setRemove = CP.listAppend instance InternalList JuliaCode where listSlice' b e s vn vo = jlListSlice vn vo b e (fromMaybe (litInt 1) s) @@ -418,6 +419,10 @@ instance InternalListFunc JuliaCode where listAccessFunc = CP.listAccessFunc listSetFunc = CP.listSetFunc R.listSetFunc +instance InternalSetFunc JuliaCode where + setAddFunc = listAppendFunc + setRemoveFunc = listAppendFunc + instance ThunkSym JuliaCode where type Thunk JuliaCode = CommonThunk VS diff --git a/code/drasil-gool/lib/Drasil/GOOL/LanguageRenderer/LanguagePolymorphic.hs b/code/drasil-gool/lib/Drasil/GOOL/LanguageRenderer/LanguagePolymorphic.hs index bf08781856..f3a08f86fd 100644 --- a/code/drasil-gool/lib/Drasil/GOOL/LanguageRenderer/LanguagePolymorphic.hs +++ b/code/drasil-gool/lib/Drasil/GOOL/LanguageRenderer/LanguagePolymorphic.hs @@ -10,8 +10,8 @@ module Drasil.GOOL.LanguageRenderer.LanguagePolymorphic (fileFromData, classVarCheckStatic, arrayElem, local, litChar, litDouble, litInt, litString, valueOf, arg, argsList, call, funcAppMixedArgs, selfFuncAppMixedArgs, newObjMixedArgs, lambda, objAccess, objMethodCall, func, get, set, listAdd, - listAppend, setAdd, listAccess, listSet, getFunc, setFunc, - listAppendFunc, setAddFunc, stmt, loopStmt, emptyStmt, assign, subAssign, increment, + listAppend, setAdd, setRemove, listAccess, listSet, getFunc, setFunc, + listAppendFunc, setMethodFunc, stmt, loopStmt, emptyStmt, assign, subAssign, increment, objDecNew, print, closeFile, returnStmt, valStmt, comment, throw, ifCond, tryCatch, construct, param, method, getMethod, setMethod, initStmts, function, docFuncRepr, docFunc, buildClass, implementingClass, docClass, @@ -50,7 +50,7 @@ import Drasil.GOOL.RendererClassesCommon (CommonRenderSym, RenderType(..), BlockCommentSym(..)) import qualified Drasil.GOOL.RendererClassesCommon as S (RenderValue(call), InternalListFunc (listAddFunc, listAppendFunc, listAccessFunc, listSetFunc), - RenderStatement(stmt), InternalIOStmt(..), InternalSetFunc (setAddFunc)) + RenderStatement(stmt), InternalIOStmt(..), InternalSetFunc (setAddFunc, setRemoveFunc)) import qualified Drasil.GOOL.RendererClassesCommon as RC (BodyElim(..), BlockElim(..), InternalVarElim(variable), ValueElim(value, valueInt), FunctionElim(..), StatementElim(statement), BlockCommentElim(..)) @@ -308,9 +308,12 @@ listAdd v i vToAdd = v $. S.listAddFunc v (IC.intToIndex i) vToAdd listAppend :: (OORenderSym r) => SValue r -> SValue r -> SValue r listAppend v vToApp = v $. S.listAppendFunc v vToApp -setAdd :: (OORenderSym r, S.InternalSetFunc r) => SValue r -> SValue r -> SValue r +setAdd :: (OORenderSym r) => SValue r -> SValue r -> SValue r setAdd v vToApp = v $. S.setAddFunc v vToApp +setRemove :: (OORenderSym r) => SValue r -> SValue r -> SValue r +setRemove v vToApp = v $. S.setRemoveFunc v vToApp + listAccess :: (CommonRenderSym r) => SValue r -> SValue r -> SValue r listAccess v i = do v' <- v @@ -341,8 +344,8 @@ setFunc t v toVal = v >>= (\vr -> IG.func (setterName $ variableName vr) t listAppendFunc :: (OORenderSym r) => Label -> SValue r -> VSFunction r listAppendFunc f v = IG.func f (IC.listType $ onStateValue valueType v) [v] -setAddFunc :: (OORenderSym r) => Label -> SValue r -> VSFunction r -setAddFunc f v = IG.func f (IC.setType $ onStateValue valueType v) [v] +setMethodFunc :: (OORenderSym r) => Label -> SValue r -> VSFunction r +setMethodFunc f v = IG.func f (IC.setType $ onStateValue valueType v) [v] -- Statements -- diff --git a/code/drasil-gool/lib/Drasil/GOOL/LanguageRenderer/PythonRenderer.hs b/code/drasil-gool/lib/Drasil/GOOL/LanguageRenderer/PythonRenderer.hs index 2e763dce55..7d5dc18e2c 100644 --- a/code/drasil-gool/lib/Drasil/GOOL/LanguageRenderer/PythonRenderer.hs +++ b/code/drasil-gool/lib/Drasil/GOOL/LanguageRenderer/PythonRenderer.hs @@ -66,11 +66,11 @@ import qualified Drasil.GOOL.LanguageRenderer.LanguagePolymorphic as G ( minusOp, multOp, divideOp, moduloOp, var, staticVar, objVar, arrayElem, litChar, litDouble, litInt, litString, valueOf, arg, argsList, objAccess, objMethodCall, call, funcAppMixedArgs, selfFuncAppMixedArgs, newObjMixedArgs, - lambda, func, get, set, listAdd, setAdd, setAddFunc, listAppend, listAccess, listSet, getFunc, - setFunc, listAppendFunc, stmt, loopStmt, emptyStmt, assign, subAssign, - increment, objDecNew, print, closeFile, returnStmt, valStmt, comment, throw, - ifCond, tryCatch, construct, param, method, getMethod, setMethod, function, - buildClass, implementingClass, commentedClass, modFromData, fileDoc, + lambda, func, get, set, listAdd, setAdd, setRemove, setMethodFunc, listAppend, + listAccess, listSet, getFunc, setFunc, listAppendFunc, stmt, loopStmt, emptyStmt, + assign, subAssign, increment, objDecNew, print, closeFile, returnStmt, valStmt, + comment, throw, ifCond, tryCatch, construct, param, method, getMethod, setMethod, + function, buildClass, implementingClass, commentedClass, modFromData, fileDoc, fileFromData, local) import qualified Drasil.GOOL.LanguageRenderer.CommonPseudoOO as CP (int, constructor, doxFunc, doxClass, doxMod, extVar, classVar, objVarSelf, @@ -458,6 +458,7 @@ instance List PythonCode where instance Set PythonCode where contains a b = typeBinExpr (inPrec pyIn) bool b a setAdd = G.setAdd + setRemove = G.setRemove instance InternalList PythonCode where listSlice' b e s vn vo = pyListSlice vn vo (getVal b) (getVal e) (getVal s) @@ -477,7 +478,8 @@ instance InternalListFunc PythonCode where listSetFunc = CP.listSetFunc R.listSetFunc instance InternalSetFunc PythonCode where - setAddFunc _ = G.setAddFunc pyAdd + setAddFunc _ = G.setMethodFunc pyAdd + setRemoveFunc _ = G.setMethodFunc pyRemove instance ThunkSym PythonCode where type Thunk PythonCode = CommonThunk VS @@ -840,7 +842,7 @@ pyInputFunc = text "input()" -- raw_input() for < Python 3.0 pyPrintFunc = text printLabel pyListSize, pyIndex, pyInsert, pyAppendFunc, pyReadline, pyReadlines, pyClose, - pySplit, pyRange, pyRstrip, pyMath, pyIn, pyAdd :: String + pySplit, pyRange, pyRstrip, pyMath, pyIn, pyAdd, pyRemove :: String pyListSize = "len" pyIndex = "index" pyInsert = "insert" @@ -854,6 +856,7 @@ pyRstrip = "rstrip" pyMath = "math" pyIn = "in" pyAdd = "add" +pyRemove = "remove" pyDef, pyLambdaDec, pyElseIf, pyRaise, pyExcept :: Doc pyDef = text "def" diff --git a/code/drasil-gool/lib/Drasil/GOOL/LanguageRenderer/SwiftRenderer.hs b/code/drasil-gool/lib/Drasil/GOOL/LanguageRenderer/SwiftRenderer.hs index e5e81133a2..aeb5073462 100644 --- a/code/drasil-gool/lib/Drasil/GOOL/LanguageRenderer/SwiftRenderer.hs +++ b/code/drasil-gool/lib/Drasil/GOOL/LanguageRenderer/SwiftRenderer.hs @@ -69,7 +69,7 @@ import qualified Drasil.GOOL.LanguageRenderer.LanguagePolymorphic as G ( minusOp, multOp, divideOp, moduloOp, var, staticVar, objVar, arrayElem, litChar, litDouble, litInt, litString, valueOf, arg, argsList, objAccess, objMethodCall, call, funcAppMixedArgs, selfFuncAppMixedArgs, newObjMixedArgs, - lambda, func, get, set, setAdd, setAddFunc, listAdd, listAppend, listAccess, listSet, getFunc, + lambda, func, get, set, setAdd, setRemove, setMethodFunc, listAdd, listAppend, listAccess, listSet, getFunc, setFunc, listAppendFunc, stmt, loopStmt, emptyStmt, assign, subAssign, increment, objDecNew, print, returnStmt, valStmt, comment, throw, ifCond, tryCatch, construct, param, method, getMethod, setMethod, initStmts, @@ -463,6 +463,7 @@ instance List SwiftCode where instance Set SwiftCode where contains = CP.contains swiftContains setAdd = G.setAdd + setRemove = G.setRemove instance InternalList SwiftCode where listSlice' b e s vn vo = swiftListSlice vn vo b e (fromMaybe (litInt 1) s) @@ -481,7 +482,8 @@ instance InternalListFunc SwiftCode where listSetFunc = CP.listSetFunc R.listSetFunc instance InternalSetFunc SwiftCode where - setAddFunc _ = G.setAddFunc swiftListAdd + setAddFunc _ = G.setMethodFunc swiftListAdd + setRemoveFunc _ = G.setMethodFunc swiftListRemove instance ThunkSym SwiftCode where type Thunk SwiftCode = CommonThunk VS @@ -907,7 +909,7 @@ swiftUnwrap' = text swiftUnwrap swiftMain, swiftFoundation, swiftMath, swiftNil, swiftInt, swiftChar, swiftURL, swiftFileHdl, swiftRetType, swiftVoid, swiftCommLine, swiftSearchDir, swiftPathMask, swiftArgs, swiftWrite, swiftIndex, - swiftStride, swiftMap, swiftListAdd, swiftListAppend, swiftReadLine, + swiftStride, swiftMap, swiftListAdd, swiftListRemove, swiftListAppend, swiftReadLine, swiftSeekEnd, swiftClose, swiftJoined, swiftAppendPath, swiftUrls, swiftSplit, swiftData, swiftEncoding, swiftOf, swiftFrom, swiftTo, swiftBy, swiftAt, swiftTerm, swiftFor, swiftIn, swiftContentsOf, swiftWriteTo, swiftSep, @@ -931,6 +933,7 @@ swiftIndex = "firstIndex" swiftStride = "stride" swiftMap = "map" swiftListAdd = "insert" +swiftListRemove = "remove" swiftListAppend = "append" swiftReadLine = "readLine" swiftSeekEnd = "seekToEnd" diff --git a/code/drasil-gool/lib/Drasil/GOOL/RendererClassesCommon.hs b/code/drasil-gool/lib/Drasil/GOOL/RendererClassesCommon.hs index bfcbdfa7fe..9fb9d50d32 100644 --- a/code/drasil-gool/lib/Drasil/GOOL/RendererClassesCommon.hs +++ b/code/drasil-gool/lib/Drasil/GOOL/RendererClassesCommon.hs @@ -35,7 +35,7 @@ class (AssignStatement r, DeclStatement r, IOStatement r, r, Argument r, Literal r, MathConstant r, VariableValue r, CommandLineArgs r, NumericExpression r, BooleanExpression r, Comparison r, List r, InternalList r, VectorExpression r, TypeElim r, VariableElim r, RenderBlock r, - BlockElim r, RenderBody r, BodyElim r, InternalListFunc r, RenderFunction r, + BlockElim r, RenderBody r, BodyElim r, InternalListFunc r, InternalSetFunc r, RenderFunction r, FunctionElim r, OpElim r, RenderParam r, ParamElim r, RenderVisibility r, VisibilityElim r, InternalAssignStmt r, InternalIOStmt r, InternalControlStmt r, RenderStatement r, StatementElim r, RenderType r, @@ -172,6 +172,7 @@ class InternalListFunc r where class InternalSetFunc r where -- | Set, Value setAddFunc :: SValue r -> SValue r -> VSFunction r + setRemoveFunc :: SValue r -> SValue r -> VSFunction r class RenderFunction r where funcFromData :: Doc -> VSType r -> VSFunction r