1280729 · project-m36 · git.iko.soy

git.iko.soy/project-m36

on master help sign in

fix basic error in mkEmptyRelVars called by StaticOptimizer resulting in broken MultipleExpr execution

1280729AgentM7 years ago

src/lib/ProjectM36/RelationalExpression.hs+17−10

compare with master

unifiedsplit

@@ -42,6 +42,8 @@ import Data.Time.Calendar

42import qualified Data.List.NonEmpty as NE

43import Data.Functor.Identity

45+--import Debug.Trace

46+

45data DatabaseContextExprDetails = CountUpdatedTuples

47data DatabaseContextExprDetails = CountUpdatedTuples

47databaseContextExprDetailsFunc :: DatabaseContextExprDetails -> ResultAccumFunc

49databaseContextExprDetailsFunc :: DatabaseContextExprDetails -> ResultAccumFunc

@@ -362,7 +364,6 @@ evalRelationalExpr (Extend tupleExpression relExpr) = do

362--helper function to process relation variable creation/assignment

364--helper function to process relation variable creation/assignment

363setRelVar :: RelVarName -> GraphRefRelationalExpr -> DatabaseContextEvalMonad ()

365setRelVar :: RelVarName -> GraphRefRelationalExpr -> DatabaseContextEvalMonad ()

364setRelVar relVarName relExpr = do

366setRelVar relVarName relExpr = do

365−

366 currentContext <- getStateContext

367 currentContext <- getStateContext

367 --prevent recursive relvar definition

368 --prevent recursive relvar definition

368 let newRelVars = M.insert relVarName relExpr $ relationVariables currentContext

369 let newRelVars = M.insert relVarName relExpr $ relationVariables currentContext

@@ -417,13 +418,15 @@ evalGraphRefDatabaseContextExpr (Assign relVarName expr) = do

417 graph <- re_graph <$> dbcRelationalExprEnv

418 graph <- re_graph <$> dbcRelationalExprEnv

418 context <- getStateContext

419 context <- getStateContext

419 let existingRelVar = M.lookup relVarName (relationVariables context)

420 let existingRelVar = M.lookup relVarName (relationVariables context)

421+ reEnv = freshGraphRefRelationalExprEnv (Just context) graph

420 case existingRelVar of

422 case existingRelVar of

421 Nothing -> do

423 Nothing -> do

424+ case runGraphRefRelationalExprM reEnv (typeForGraphRefRelationalExpr expr) of

425+ Left err -> dbErr err

422− setRelVar relVarName expr

426+ Right _ -> setRelVar relVarName expr

423 Just existingRel -> do

427 Just existingRel -> do

424 let eExpectedType = runGraphRefRelationalExprM reEnv (typeForGraphRefRelationalExpr existingRel)

428 let eExpectedType = runGraphRefRelationalExprM reEnv (typeForGraphRefRelationalExpr existingRel)

425 eNewExprType = runGraphRefRelationalExprM reEnv (typeForGraphRefRelationalExpr expr)

429 eNewExprType = runGraphRefRelationalExprM reEnv (typeForGraphRefRelationalExpr expr)

426− reEnv = freshGraphRefRelationalExprEnv (Just context) graph

427 case eExpectedType of

430 case eExpectedType of

428 Left err -> dbErr err

431 Left err -> dbErr err

429 Right expectedType ->

432 Right expectedType ->

@@ -453,11 +456,11 @@ evalGraphRefDatabaseContextExpr (Update relVarName atomExprMap pred') = do

453 tmpAttr attr = "_tmp_" <> attr --this could certainly be improved to verify that there is no attribute name conflict

456 tmpAttr attr = "_tmp_" <> attr --this could certainly be improved to verify that there is no attribute name conflict

454 updateAttr nam atomExpr = Extend (AttributeExtendTupleExpr (tmpAttr nam) atomExpr)

457 updateAttr nam atomExpr = Extend (AttributeExtendTupleExpr (tmpAttr nam) atomExpr)

455 projectAndRename attr expr = Rename (tmpAttr attr) attr (Project (InvertedAttributeNames (S.singleton attr)) expr)

458 projectAndRename attr expr = Rename (tmpAttr attr) attr (Project (InvertedAttributeNames (S.singleton attr)) expr)

456− --TODO restrictedPortion = Restrict pred'

459+ restrictedPortion = Restrict pred' rvExpr

457 updated = foldr (\(oldname, atomExpr) accum ->

460 updated = foldr (\(oldname, atomExpr) accum ->

458 let procAtomExpr = runProcessExprM UncommittedContextMarker (processAtomExpr atomExpr) in

461 let procAtomExpr = runProcessExprM UncommittedContextMarker (processAtomExpr atomExpr) in

459 updateAttr oldname procAtomExpr accum

462 updateAttr oldname procAtomExpr accum

460− ) rvExpr (M.toList atomExprMap)

463+ ) restrictedPortion (M.toList atomExprMap)

461 -- the atomExprMap could reference other attributes, so we must perform multi-pass folds

464 -- the atomExprMap could reference other attributes, so we must perform multi-pass folds

462 updatedPortion = foldr projectAndRename updated (M.keys atomExprMap)

465 updatedPortion = foldr projectAndRename updated (M.keys atomExprMap)

463 setRelVar relVarName (Union unrestrictedPortion updatedPortion)

466 setRelVar relVarName (Union unrestrictedPortion updatedPortion)

@@ -472,6 +475,8 @@ evalGraphRefDatabaseContextExpr (AddInclusionDependency newDepName newDep) = do

472 dbErr (InclusionDependencyNameInUseError newDepName)

475 dbErr (InclusionDependencyNameInUseError newDepName)

473 else do

476 else do

474 let potentialContext = currContext { inclusionDependencies = newDeps }

477 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

475 case checkConstraints potentialContext transId graph of

480 case checkConstraints potentialContext transId graph of

476 Left err -> dbErr err

481 Left err -> dbErr err

477 Right _ ->

482 Right _ ->

@@ -873,7 +878,7 @@ predicateRestrictionFilter _ (RelationalExprPredicate relExpr) = do

873

878

874predicateRestrictionFilter attrs (AttributeEqualityPredicate attrName atomExpr) = do

879predicateRestrictionFilter attrs (AttributeEqualityPredicate attrName atomExpr) = do

875 env <- askEnv

880 env <- askEnv

876− let attrs' = envAttributes env

881+ let attrs' = A.union attrs (envAttributes env)

877 ctxtup' = envTuple env

882 ctxtup' = envTuple env

878 atomExprType <- typeForGraphRefAtomExpr attrs' atomExpr

883 atomExprType <- typeForGraphRefAtomExpr attrs' atomExpr

879 attr <- lift $ except $ case A.attributeForName attrName attrs of

884 attr <- lift $ except $ case A.attributeForName attrName attrs of

@@ -1045,7 +1050,8 @@ typeForGraphRefAtomExpr attrs (AttributeAtomExpr attrName) = do

1045 Right attr -> pure (A.atomType attr)

1050 Right attr -> pure (A.atomType attr)

1046 Left _ -> case atomForAttributeName attrName envTup of

1051 Left _ -> case atomForAttributeName attrName envTup of

1047 Right atom -> pure (atomTypeForAtom atom)

1052 Right atom -> pure (atomTypeForAtom atom)

1053+ Left _ -> --throwError (traceStack (show ("typeForGRAtomExpr", attrs, envTup)) err)

1048− Left _ -> throwError err

1054+ throwError err

1049 Left err -> throwError err

1055 Left err -> throwError err

1050

1056

1051typeForGraphRefAtomExpr _ (NakedAtomExpr atom) = pure (atomTypeForAtom atom)

1057typeForGraphRefAtomExpr _ (NakedAtomExpr atom) = pure (atomTypeForAtom atom)

@@ -1305,7 +1311,8 @@ typeForGraphRefRelationalExpr (RelationVariable rvName tid) = do

1305 relVars <- relationVariables <$> gfDatabaseContextForMarker tid

1311 relVars <- relationVariables <$> gfDatabaseContextForMarker tid

1306 case M.lookup rvName relVars of

1312 case M.lookup rvName relVars of

1307 Nothing -> throwError (RelVarNotDefinedError rvName)

1313 Nothing -> throwError (RelVarNotDefinedError rvName)

1314+ Just rvExpr ->

1308− Just rvExpr -> typeForGraphRefRelationalExpr rvExpr

1315+ typeForGraphRefRelationalExpr rvExpr

1309typeForGraphRefRelationalExpr (Project attrNames expr) = do

1316typeForGraphRefRelationalExpr (Project attrNames expr) = do

1310 exprType' <- typeForGraphRefRelationalExpr expr

1317 exprType' <- typeForGraphRefRelationalExpr expr

1311 projectionAttrs <- evalGraphRefAttributeNames attrNames expr

1318 projectionAttrs <- evalGraphRefAttributeNames attrNames expr

@@ -1360,7 +1367,7 @@ evalGraphRefAttributeNames attrNames expr = do

1360 InvertedAttributeNames names -> do

1367 InvertedAttributeNames names -> do

1361 let nonExistentAttributeNames = A.attributeNamesNotContained names typeNameSet

1368 let nonExistentAttributeNames = A.attributeNamesNotContained names typeNameSet

1362 if not (S.null nonExistentAttributeNames) then

1369 if not (S.null nonExistentAttributeNames) then

1363− throwError (AttributeNamesMismatchError nonExistentAttributeNames)

1370+ throwError $ AttributeNamesMismatchError nonExistentAttributeNames

1364 else

1371 else

1365 pure (A.nonMatchingAttributeNameSet names typeNameSet)

1372 pure (A.nonMatchingAttributeNameSet names typeNameSet)

1366

1373

@@ -1392,7 +1399,7 @@ evalGraphRefAttributeExpr (NakedAttributeExpr attr) = pure attr

1392mkEmptyRelVars :: RelationVariables -> RelationVariables

1399mkEmptyRelVars :: RelationVariables -> RelationVariables

1393mkEmptyRelVars rvMap = M.map mkEmptyRelVar rvMap

1400mkEmptyRelVars rvMap = M.map mkEmptyRelVar rvMap

1394 where

1401 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

1396 mkEmptyRelVar (MakeStaticRelation attrs _) = MakeStaticRelation attrs emptyTupleSet

1403 mkEmptyRelVar (MakeStaticRelation attrs _) = MakeStaticRelation attrs emptyTupleSet

1397 mkEmptyRelVar (ExistingRelation rel) = ExistingRelation (emptyRelationWithAttrs (attributes rel))

1404 mkEmptyRelVar (ExistingRelation rel) = ExistingRelation (emptyRelationWithAttrs (attributes rel))

1398 mkEmptyRelVar rv@RelationVariable{} = Restrict (NotPredicate TruePredicate) rv

1405 mkEmptyRelVar rv@RelationVariable{} = Restrict (NotPredicate TruePredicate) rv

test/TransactionGraph/Persist.hs+1−1

@@ -57,7 +57,7 @@ testDBSimplePersistence = TestCase $ withSystemTempDirectory "m36testdb" $ \temp

57 Left err -> assertFailure (show err)

58 Right context' -> do

59 freshId' <- nextRandom

60− let newdiscon = DisconnectedTransaction (transactionId headTrans) (Schemas context' M.empty) NoOperation

60+ let newdiscon = DisconnectedTransaction (transactionId headTrans) (Schemas context' M.empty) False

61 addTrans = addDisconnectedTransaction stamp' freshId' "master" newdiscon graph

62 --add a transaction to the graph

63 case addTrans of

test/TutorialD/Interpreter/TestBase.hs+7−7

@@ -28,13 +28,13 @@ executeTutorialD sessionId conn tutd = case parseTutorialD tutd of

28 Right parsed -> do

29 result <- evalTutorialD sessionId conn UnsafeEvaluation parsed

30 case result of

31− QuitResult -> putStrLn "yyy" >> assertFailure "quit?"

31+ QuitResult -> assertFailure "quit?"

32− DisplayResult _ -> putStrLn "xxx" >> assertFailure "display?"

32+ DisplayResult _ -> assertFailure "display?"

33− DisplayIOResult _ -> putStrLn "z" >> assertFailure "displayIO?"

33+ DisplayIOResult _ -> assertFailure "displayIO?"

34− DisplayRelationResult _ -> putStrLn "Y" >> assertFailure "displayrelation?"

34+ DisplayRelationResult _ -> assertFailure "displayrelation?"

35− DisplayDataFrameResult _ -> putStrLn "DF" >> assertFailure "displaydataframe?"

35+ DisplayDataFrameResult _ -> assertFailure "displaydataframe?"

36− DisplayParseErrorResult _ _ -> putStrLn "X" >> assertFailure "displayparseerrorresult?"

36+ DisplayParseErrorResult _ _ -> assertFailure "displayparseerrorresult?"

37− DisplayErrorResult err -> putStrLn "asd" >> assertFailure (show tutd ++ ": " ++ show err)

37+ DisplayErrorResult err -> assertFailure (show tutd ++ ": " ++ show err)

38 QuietSuccessResult -> pure ()

40expectTutorialDErr :: SessionId -> Connection -> (Text -> Bool) -> Text -> IO ()