@@ -42,6 +42,8 @@ import Data.Time.Calendar
4242import qualified Data.List.NonEmpty as NE
4343import Data.Functor.Identity
4444
45+--import Debug.Trace
46+
4547data DatabaseContextExprDetails = CountUpdatedTuples
4648
4749databaseContextExprDetailsFunc :: DatabaseContextExprDetails -> ResultAccumFunc
@@ -362,7 +364,6 @@ evalRelationalExpr (Extend tupleExpression relExpr) = do
362364--helper function to process relation variable creation/assignment
363365setRelVar :: RelVarName -> GraphRefRelationalExpr -> DatabaseContextEvalMonad ()
364366setRelVar relVarName relExpr = do
365−
366367 currentContext <- getStateContext
367368 --prevent recursive relvar definition
368369 let newRelVars = M.insert relVarName relExpr $ relationVariables currentContext
@@ -417,13 +418,15 @@ evalGraphRefDatabaseContextExpr (Assign relVarName expr) = do
417418 graph <- re_graph <$> dbcRelationalExprEnv
418419 context <- getStateContext
419420 let existingRelVar = M.lookup relVarName (relationVariables context)
421+ reEnv = freshGraphRefRelationalExprEnv (Just context) graph
420422 case existingRelVar of
421423 Nothing -> do
422− setRelVar relVarName expr
424+ case runGraphRefRelationalExprM reEnv (typeForGraphRefRelationalExpr expr) of
425+ Left err -> dbErr err
426+ Right _ -> setRelVar relVarName expr
423427 Just existingRel -> do
424428 let eExpectedType = runGraphRefRelationalExprM reEnv (typeForGraphRefRelationalExpr existingRel)
425429 eNewExprType = runGraphRefRelationalExprM reEnv (typeForGraphRefRelationalExpr expr)
426− reEnv = freshGraphRefRelationalExprEnv (Just context) graph
427430 case eExpectedType of
428431 Left err -> dbErr err
429432 Right expectedType ->
@@ -453,11 +456,11 @@ evalGraphRefDatabaseContextExpr (Update relVarName atomExprMap pred') = do
453456 tmpAttr attr = "_tmp_" <> attr --this could certainly be improved to verify that there is no attribute name conflict
454457 updateAttr nam atomExpr = Extend (AttributeExtendTupleExpr (tmpAttr nam) atomExpr)
455458 projectAndRename attr expr = Rename (tmpAttr attr) attr (Project (InvertedAttributeNames (S.singleton attr)) expr)
456− --TODO restrictedPortion = Restrict pred'
459+ restrictedPortion = Restrict pred' rvExpr
457460 updated = foldr (\(oldname, atomExpr) accum ->
458461 let procAtomExpr = runProcessExprM UncommittedContextMarker (processAtomExpr atomExpr) in
459462 updateAttr oldname procAtomExpr accum
460− ) rvExpr (M.toList atomExprMap)
463+ ) restrictedPortion (M.toList atomExprMap)
461464 -- the atomExprMap could reference other attributes, so we must perform multi-pass folds
462465 updatedPortion = foldr projectAndRename updated (M.keys atomExprMap)
463466 setRelVar relVarName (Union unrestrictedPortion updatedPortion)
@@ -472,6 +475,8 @@ evalGraphRefDatabaseContextExpr (AddInclusionDependency newDepName newDep) = do
472475 dbErr (InclusionDependencyNameInUseError newDepName)
473476 else do
474477 let potentialContext = currContext { inclusionDependencies = newDeps }
478+ -- if the potential context passes all constraints, then save it
479+ -- potential optimization: validate only the new constraint- all old constraints must already hold
475480 case checkConstraints potentialContext transId graph of
476481 Left err -> dbErr err
477482 Right _ ->
@@ -873,7 +878,7 @@ predicateRestrictionFilter _ (RelationalExprPredicate relExpr) = do
873878
874879predicateRestrictionFilter attrs (AttributeEqualityPredicate attrName atomExpr) = do
875880 env <- askEnv
876− let attrs' = envAttributes env
881+ let attrs' = A.union attrs (envAttributes env)
877882 ctxtup' = envTuple env
878883 atomExprType <- typeForGraphRefAtomExpr attrs' atomExpr
879884 attr <- lift $ except $ case A.attributeForName attrName attrs of
@@ -1045,7 +1050,8 @@ typeForGraphRefAtomExpr attrs (AttributeAtomExpr attrName) = do
10451050 Right attr -> pure (A.atomType attr)
10461051 Left _ -> case atomForAttributeName attrName envTup of
10471052 Right atom -> pure (atomTypeForAtom atom)
1048− Left _ -> throwError err
1053+ Left _ -> --throwError (traceStack (show ("typeForGRAtomExpr", attrs, envTup)) err)
1054+ throwError err
10491055 Left err -> throwError err
10501056
10511057typeForGraphRefAtomExpr _ (NakedAtomExpr atom) = pure (atomTypeForAtom atom)
@@ -1305,7 +1311,8 @@ typeForGraphRefRelationalExpr (RelationVariable rvName tid) = do
13051311 relVars <- relationVariables <$> gfDatabaseContextForMarker tid
13061312 case M.lookup rvName relVars of
13071313 Nothing -> throwError (RelVarNotDefinedError rvName)
1308− Just rvExpr -> typeForGraphRefRelationalExpr rvExpr
1314+ Just rvExpr ->
1315+ typeForGraphRefRelationalExpr rvExpr
13091316typeForGraphRefRelationalExpr (Project attrNames expr) = do
13101317 exprType' <- typeForGraphRefRelationalExpr expr
13111318 projectionAttrs <- evalGraphRefAttributeNames attrNames expr
@@ -1360,7 +1367,7 @@ evalGraphRefAttributeNames attrNames expr = do
13601367 InvertedAttributeNames names -> do
13611368 let nonExistentAttributeNames = A.attributeNamesNotContained names typeNameSet
13621369 if not (S.null nonExistentAttributeNames) then
1363− throwError (AttributeNamesMismatchError nonExistentAttributeNames)
1370+ throwError $ AttributeNamesMismatchError nonExistentAttributeNames
13641371 else
13651372 pure (A.nonMatchingAttributeNameSet names typeNameSet)
13661373
@@ -1392,7 +1399,7 @@ evalGraphRefAttributeExpr (NakedAttributeExpr attr) = pure attr
13921399mkEmptyRelVars :: RelationVariables -> RelationVariables
13931400mkEmptyRelVars rvMap = M.map mkEmptyRelVar rvMap
13941401 where
1395− mkEmptyRelVar (MakeRelationFromExprs mAttrs _) = MakeRelationFromExprs mAttrs []
1402+ mkEmptyRelVar expr@MakeRelationFromExprs{} = expr --do not truncate here because we might lose essential type information in emptying the tuples
13961403 mkEmptyRelVar (MakeStaticRelation attrs _) = MakeStaticRelation attrs emptyTupleSet
13971404 mkEmptyRelVar (ExistingRelation rel) = ExistingRelation (emptyRelationWithAttrs (attributes rel))
13981405 mkEmptyRelVar rv@RelationVariable{} = Restrict (NotPredicate TruePredicate) rv