@@ -195,7 +195,8 @@ evalRelationalExpr (Restrict predicateExpr relExpr) = do
195195 eFilterFunc <- predicateRestrictionFilter (attributes rel) predicateExpr
196196 case eFilterFunc of
197197 Left err -> return $ Left err
198− Right filterfunc -> return $ restrict filterfunc rel
198+ Right filterfunc -> do
199+ pure (restrict filterfunc rel)
199200
200201evalRelationalExpr (Equals relExprA relExprB) = do
201202 evaldA <- evalRelationalExpr relExprA
@@ -334,7 +335,7 @@ evalDatabaseContextExpr (Update relVarName atomExprMap restrictionPredicateExpr)
334335 if cardinality restrictedPortion == Finite 0 then
335336 pure Nothing
336337 else do
337− unrestrictedPortion <- restrict (not . predicateFunc) rel
338+ unrestrictedPortion <- restrict (\tup -> predicateFunc tup >>= pure . not) rel
338339 updatedPortion <- relMap (updateTupleWithAtomExprs atomExprMap context) restrictedPortion
339340 updatedRel <- union updatedPortion unrestrictedPortion
340341 pure (Just updatedRel)
@@ -614,52 +615,73 @@ liftE v = do
614615 Right val -> pure val
615616
616617{- used for restrictions- take the restrictionpredicate and return the corresponding filter function -}
617−predicateRestrictionFilter :: Attributes -> RestrictionPredicateExpr -> RelationalExprState (Either RelationalError (RelationTuple -> Bool))
618+predicateRestrictionFilter :: Attributes -> RestrictionPredicateExpr -> RelationalExprState (Either RelationalError RestrictionFilter)
618619predicateRestrictionFilter attrs (AndPredicate expr1 expr2) = do
619620 runExceptT $ do
620621 expr1v <- liftE (predicateRestrictionFilter attrs expr1)
621622 expr2v <- liftE (predicateRestrictionFilter attrs expr2)
622− pure (\x -> expr1v x && expr2v x)
623+ pure (\x -> do
624+ ev1 <- expr1v x
625+ ev2 <- expr2v x
626+ pure (ev1 && ev2))
623627
624628predicateRestrictionFilter attrs (OrPredicate expr1 expr2) = do
625629 runExceptT $ do
626630 expr1v <- liftE (predicateRestrictionFilter attrs expr1)
627631 expr2v <- liftE (predicateRestrictionFilter attrs expr2)
628− pure (\x -> expr1v x || expr2v x)
632+ pure (\x -> do
633+ ev1 <- expr1v x
634+ ev2 <- expr2v x
635+ pure (ev1 || ev2))
629636
630−predicateRestrictionFilter _ TruePredicate = pure (Right (\_ -> True))
637+predicateRestrictionFilter _ TruePredicate = pure (Right (\_ -> pure True))
631638
632639predicateRestrictionFilter attrs (NotPredicate expr) = do
633640 runExceptT $ do
634641 exprv <- liftE (predicateRestrictionFilter attrs expr)
635− pure (\x -> not (exprv x))
636−
637−predicateRestrictionFilter _ (RelationalExprPredicate relExpr) = runExceptT $ do
638− --merge attrs into to state attributes
639− rel <- liftE (evalRelationalExpr relExpr)
640− if rel == relationTrue then
641− pure (\_ -> True)
642− else if rel == relationFalse then
643− pure (\_ -> False)
644− else
645− throwE (PredicateExpressionError "Relational restriction filter must evaluate to 'true' or 'false'")
642+ pure (\x -> do
643+ ev <- exprv x
644+ pure (not ev))
645+
646+--optimization opportunity: if the subexpression does not reference attributes in the top-level expression, then it need only be evaluated once, statically, outside the tuple filter- see historical implementation here
647+predicateRestrictionFilter _ (RelationalExprPredicate relExpr) = do
648+ rstate <- ask
649+ pure (Right (\tup -> case runReader (evalRelationalExpr relExpr) (mergeTuplesIntoRelationalExprState tup rstate) of
650+ Left err -> Left err
651+ Right rel -> if arity rel /= 0 then
652+ Left (PredicateExpressionError "Relational restriction filter must evaluate to 'true' or 'false'")
653+ else
654+ pure (rel == relationTrue)))
646655
647656predicateRestrictionFilter attrs (AttributeEqualityPredicate attrName atomExpr) = do
648− --merge attrs into the state attributes
649657 rstate <- ask
658+ let (attrs', ctxtup') = case rstate of
659+ RelationalExprStateElems _ -> (attrs, emptyTuple)
660+ RelationalExprStateAttrsElems _ _ -> (attrs, emptyTuple)
661+ RelationalExprStateTupleElems _ ctxtup -> (A.union attrs (tupleAttributes ctxtup), ctxtup)
650662 runExceptT $ do
651− atomExprType <- liftE (typeFromAtomExpr attrs atomExpr)
652− attr <- either throwE pure (A.attributeForName attrName attrs)
663+ atomExprType <- liftE (typeFromAtomExpr attrs' atomExpr)
664+ attr <- either throwE pure $ case A.attributeForName attrName attrs of
665+ Right attr -> Right attr
666+ Left (NoSuchAttributeNamesError _) -> case A.attributeForName attrName (tupleAttributes ctxtup') of
667+ Right ctxattr -> Right ctxattr
668+ Left err2@(NoSuchAttributeNamesError _) -> Left err2
669+ Left err -> Left err
670+ Left err -> Left err
653671 if atomExprType /= A.atomType attr then
654672 throwE (TupleAttributeTypeMismatchError (A.attributesFromList [attr]))
655673 else
656− pure $ \tupleIn -> case atomForAttributeName attrName tupleIn of
657− Left _ -> False
658− Right atomIn ->
659− let atomEvald = runReader (evalAtomExpr tupleIn atomExpr) rstate in
660− case atomEvald of
661− Right atomCmp -> atomCmp == atomIn
662− Left _ -> False
674+ pure $ \tupleIn -> let evalAndCmp atomIn = case atomEvald of
675+ Right atomCmp -> atomCmp == atomIn
676+ Left _ -> False
677+ atomEvald = runReader (evalAtomExpr tupleIn atomExpr) rstate
678+ in
679+ pure $ case atomForAttributeName attrName tupleIn of
680+ Left (NoSuchAttributeNamesError _) -> case atomForAttributeName attrName ctxtup' of
681+ Left _ -> False
682+ Right ctxatom -> evalAndCmp ctxatom
683+ Left _ -> False
684+ Right atomIn -> evalAndCmp atomIn
663685-- in the future, it would be useful to do typechecking on the attribute and atom expr filters in advance
664686predicateRestrictionFilter attrs (AtomExprPredicate atomExpr) = do
665687 --merge attrs into the state attributes
@@ -670,13 +692,13 @@ predicateRestrictionFilter attrs (AtomExprPredicate atomExpr) = do
670692 throwE (AtomTypeMismatchError aType BoolAtomType)
671693 else
672694 pure (\tupleIn -> do
673− case runReader (evalAtomExpr tupleIn atomExpr) rstate of
695+ pure $ case runReader (evalAtomExpr tupleIn atomExpr) rstate of
674696 Left _ -> False
675697 Right boolAtomValue -> boolAtomValue == BoolAtom True)
676698
677699tupleExprCheckNewAttrName :: AttributeName -> Relation -> Either RelationalError Relation
678−tupleExprCheckNewAttrName attrName rel = if isRight $ attributeForName attrName rel then
679− Left $ AttributeNameInUseError attrName
700+tupleExprCheckNewAttrName attrName rel = if isRight (attributeForName attrName rel) then
701+ Left (error "SPAMMIT" $ AttributeNameInUseError attrName)
680702 else
681703 Right rel
682704
@@ -742,19 +764,18 @@ evalAtomExpr tupIn cons@(ConstructedAtomExpr dConsName dConsArgs ()) = runExcept
742764
743765typeFromAtomExpr :: Attributes -> AtomExpr -> RelationalExprState (Either RelationalError AtomType)
744766typeFromAtomExpr attrs (AttributeAtomExpr attrName) = do
745− --first, check if the attribute is in the immediate attributes
746767 rstate <- ask
747768 case A.atomTypeForAttributeName attrName attrs of
748769 Right aType -> pure (Right aType)
749770 Left err@(NoSuchAttributeNamesError _) -> case rstate of
750771 RelationalExprStateAttrsElems _ attrs' -> case A.attributeForName attrName attrs' of
751− Left err' -> pure (Left err')
772+ Left err' -> pure (error "SPAMMO2" $ Left err')
752773 Right attr -> pure (Right (A.atomType attr))
753− RelationalExprStateElems _ -> pure (Left err)
774+ RelationalExprStateElems _ -> pure (error (show attrs) $ Left err)
754775 RelationalExprStateTupleElems _ tup -> case atomForAttributeName attrName tup of
755− Left err' -> pure (Left err')
776+ Left err' -> pure (error "STAMP" $ Left err')
756777 Right atom -> pure (Right (atomTypeForAtom atom))
757− Left err -> pure (Left err)
778+ Left err -> pure (error "GONK" $ Left err)
758779typeFromAtomExpr _ (NakedAtomExpr atom) = pure (Right (atomTypeForAtom atom))
759780typeFromAtomExpr attrs (FunctionAtomExpr funcName atomArgs _) = do
760781 context <- liftM stateElemsContext ask
@@ -795,7 +816,7 @@ verifyAtomExprTypes relIn (AttributeAtomExpr attrName) expectedType = runExceptT
795816 RelationalExprStateTupleElems _ _ -> throwE err
796817 RelationalExprStateElems _ -> throwE err
797818 RelationalExprStateAttrsElems _ attrs -> case A.attributeForName attrName attrs of
798− Left err' -> throwE err'
819+ Left err' -> throwE (error "GONK" err')
799820 Right attrType -> either throwE pure (atomTypeVerify expectedType (A.atomType attrType))
800821 Left err -> throwE err
801822verifyAtomExprTypes _ (NakedAtomExpr atom) expectedType = pure (atomTypeVerify expectedType (atomTypeForAtom atom))