@@ -91,18 +91,9 @@ getStateContext = do
9191
9292putStateContext :: DatabaseContext -> DatabaseState ()
9393putStateContext ctx = do
94− (_, accum, flag) <- get
95− put (ctx, accum, flag)
94+ (_, accum, _) <- get
95+ put (ctx, accum, True)
9696
97−-- indicates that the underlying database context has changed and warrants a new commit
98−putDirtyFlag :: DatabaseState ()
99−putDirtyFlag = do
100− (ctx, accum, flag) <- get
101− if flag then
102− pure ()
103− else
104− put (ctx, accum, True)
105−
10697type RelationalExprState a = Reader RelationalExprStateElems a
10798
10899stateElemsContext :: RelationalExprStateElems -> DatabaseContext
@@ -248,18 +239,20 @@ setRelVar relVarName rel = do
248239 Just err -> return $ Just err
249240 Nothing -> do
250241 putStateContext potentialContext
251− putDirtyFlag
252242 return Nothing
253243
254244-- it is not an error to delete a relvar which does not exist, just like it is not an error to insert a pre-existing tuple into a relation
255245deleteRelVar :: RelVarName -> DatabaseState (Maybe RelationalError)
256246deleteRelVar relVarName = do
257247 currContext <- getStateContext
258− let newRelVars = M.delete relVarName (relationVariables currContext)
259− newContext = currContext { relationVariables = newRelVars }
260− putStateContext newContext
261− putDirtyFlag
262− pure Nothing
248+ let relVars = relationVariables currContext
249+ if M.notMember relVarName relVars then
250+ pure Nothing
251+ else do
252+ let newRelVars = M.delete relVarName relVars
253+ newContext = currContext { relationVariables = newRelVars }
254+ putStateContext newContext
255+ pure Nothing
263256
264257evalDatabaseContextExpr :: DatabaseContextExpr -> DatabaseState (Maybe RelationalError)
265258evalDatabaseContextExpr NoOperation = pure Nothing
@@ -272,7 +265,7 @@ evalDatabaseContextExpr (Define relVarName attrExprs) = do
272265 err:_ -> pure (Just err)
273266 [] -> case M.member relVarName relvars of
274267 True -> return (Just (RelVarAlreadyDefinedError relVarName))
275− False -> setRelVar relVarName emptyRelation >> putDirtyFlag >> pure Nothing
268+ False -> setRelVar relVarName emptyRelation >> pure Nothing
276269 where
277270 attrs = A.attributesFromList (rights eAttrs)
278271 emptyRelation = Relation attrs emptyTupleSet
@@ -297,14 +290,34 @@ evalDatabaseContextExpr (Assign relVarName expr) = do
297290 else
298291 return $ Just (RelVarAssignmentTypeMismatchError expectedAttributes foundAttributes)
299292
300−evalDatabaseContextExpr (Insert relVarName relExpr) = evalDatabaseContextExpr $ Assign relVarName (Union relExpr (RelationVariable relVarName ()))
293+evalDatabaseContextExpr (Insert relVarName relExpr) = do
294+ context <- getStateContext
295+ let unionexp = Union relExpr rv
296+ rv = RelationVariable relVarName ()
297+ unioned = runReader (evalRelationalExpr unionexp) (RelationalExprStateElems context)
298+ origRel = runReader (evalRelationalExpr rv) (RelationalExprStateElems context)
299+ case unioned of
300+ Left err -> pure (Just err)
301+ Right unioned' -> case origRel of
302+ Left err -> pure (Just err)
303+ Right origRel' -> if cardinality unioned' == cardinality origRel' then --no tuples actually inserted
304+ pure Nothing
305+ else
306+ evalDatabaseContextExpr $ Assign relVarName (ExistingRelation unioned')
301307
302308evalDatabaseContextExpr (Delete relVarName predicate) = do
303309 context <- getStateContext
304− let updatedRel = runReader (evalRelationalExpr (Restrict (NotPredicate predicate) (RelationVariable relVarName ()))) (RelationalExprStateElems context)
310+ let rv = RelationVariable relVarName ()
311+ let updatedRel = runReader (evalRelationalExpr (Restrict (NotPredicate predicate) rv)) (RelationalExprStateElems context)
312+ origRel = runReader (evalRelationalExpr rv) (RelationalExprStateElems context)
305313 case updatedRel of
306− Left err -> return $ Just err
307− Right rel -> setRelVar relVarName rel
314+ Left err -> pure (Just err)
315+ Right updatedRel' -> case origRel of
316+ Left err -> pure (Just err)
317+ Right origRel' -> if cardinality origRel' == cardinality updatedRel' then
318+ pure Nothing
319+ else
320+ setRelVar relVarName updatedRel'
308321
309322--union of restricted+updated portion and the unrestricted+unupdated portion
310323evalDatabaseContextExpr (Update relVarName atomExprMap restrictionPredicateExpr) = do
@@ -316,15 +329,19 @@ evalDatabaseContextExpr (Update relVarName atomExprMap restrictionPredicateExpr)
316329 case runReader (predicateRestrictionFilter (attributes rel) restrictionPredicateExpr) (RelationalExprStateElems context) of
317330 Left err -> return $ Just err
318331 Right predicateFunc -> do
319− case makeUpdatedRel rel of
320− Left err -> return $ Just err
321− Right updatedRel -> setRelVar relVarName updatedRel
322− where
323− makeUpdatedRel relin = do
324− restrictedPortion <- restrict predicateFunc relin
325− unrestrictedPortion <- restrict (not . predicateFunc) relin
326− updatedPortion <- relMap (updateTupleWithAtomExprs atomExprMap context) restrictedPortion
327− union updatedPortion unrestrictedPortion
332+ let ret = do
333+ restrictedPortion <- restrict predicateFunc rel
334+ if cardinality restrictedPortion == Finite 0 then
335+ pure Nothing
336+ else do
337+ unrestrictedPortion <- restrict (not . predicateFunc) rel
338+ updatedPortion <- relMap (updateTupleWithAtomExprs atomExprMap context) restrictedPortion
339+ updatedRel <- union updatedPortion unrestrictedPortion
340+ pure (Just updatedRel)
341+ case ret of
342+ Left err -> pure (Just err)
343+ Right Nothing -> pure Nothing
344+ Right (Just updatedRel) -> setRelVar relVarName updatedRel
328345
329346evalDatabaseContextExpr (AddInclusionDependency newDepName newDep) = do
330347 currContext <- getStateContext