module ProjectM36.WithNameExpr where
import ProjectM36.Base
import Data.List (find)

-- substitute all instances of With-based macros to remove macro context
-- ideally, we would use a different relational expr type to "prove" that the with macros can no longer exist

-- | 
lookup :: RelVarName -> WithNamesAssocsBase a -> Maybe (RelationalExprBase a)
lookup :: forall a.
RelVarName -> WithNamesAssocsBase a -> Maybe (RelationalExprBase a)
lookup RelVarName
matchrv WithNamesAssocsBase a
assocs =
  forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(WithNameExpr RelVarName
rv a
_, RelationalExprBase a
_) -> RelVarName
rv forall a. Eq a => a -> a -> Bool
== RelVarName
matchrv) WithNamesAssocsBase a
assocs

-- | Drop macros into the relational expression wherever they are referenced.
substituteWithNameMacros ::
  GraphRefWithNameAssocs ->
  GraphRefRelationalExpr ->
  GraphRefRelationalExpr
substituteWithNameMacros :: GraphRefWithNameAssocs
-> GraphRefRelationalExpr -> GraphRefRelationalExpr
substituteWithNameMacros GraphRefWithNameAssocs
_ e :: GraphRefRelationalExpr
e@MakeRelationFromExprs{} = GraphRefRelationalExpr
e
substituteWithNameMacros GraphRefWithNameAssocs
_ e :: GraphRefRelationalExpr
e@MakeStaticRelation{} = GraphRefRelationalExpr
e
substituteWithNameMacros GraphRefWithNameAssocs
_ e :: GraphRefRelationalExpr
e@ExistingRelation{} = GraphRefRelationalExpr
e
substituteWithNameMacros GraphRefWithNameAssocs
_ e :: GraphRefRelationalExpr
e@RelationValuedAttribute{} = GraphRefRelationalExpr
e
substituteWithNameMacros GraphRefWithNameAssocs
macros e :: GraphRefRelationalExpr
e@(RelationVariable RelVarName
rvname GraphRefTransactionMarker
tid) =
  let
    macroFilt :: (WithNameExprBase GraphRefTransactionMarker, b) -> Bool
macroFilt (WithNameExpr RelVarName
macroName GraphRefTransactionMarker
macroTid, b
_) = RelVarName
rvname forall a. Eq a => a -> a -> Bool
== RelVarName
macroName Bool -> Bool -> Bool
&& GraphRefTransactionMarker
tidforall a. Eq a => a -> a -> Bool
== GraphRefTransactionMarker
macroTid in
  case forall a. (a -> Bool) -> [a] -> [a]
filter forall {b}. (WithNameExprBase GraphRefTransactionMarker, b) -> Bool
macroFilt GraphRefWithNameAssocs
macros of
    [] -> GraphRefRelationalExpr
e
    [(WithNameExprBase GraphRefTransactionMarker
_,GraphRefRelationalExpr
replacement)] -> GraphRefRelationalExpr
replacement
    GraphRefWithNameAssocs
_ -> forall a. HasCallStack => [Char] -> a
error [Char]
"more than one macro matched!"
substituteWithNameMacros GraphRefWithNameAssocs
macros (Project AttributeNamesBase GraphRefTransactionMarker
attrs GraphRefRelationalExpr
expr) =
  forall a.
AttributeNamesBase a
-> RelationalExprBase a -> RelationalExprBase a
Project (GraphRefWithNameAssocs
-> AttributeNamesBase GraphRefTransactionMarker
-> AttributeNamesBase GraphRefTransactionMarker
substituteWithNameMacrosAttributeNames GraphRefWithNameAssocs
macros AttributeNamesBase GraphRefTransactionMarker
attrs) (GraphRefWithNameAssocs
-> GraphRefRelationalExpr -> GraphRefRelationalExpr
substituteWithNameMacros GraphRefWithNameAssocs
macros GraphRefRelationalExpr
expr)
substituteWithNameMacros GraphRefWithNameAssocs
macros (Union GraphRefRelationalExpr
exprA GraphRefRelationalExpr
exprB) =
  forall a.
RelationalExprBase a
-> RelationalExprBase a -> RelationalExprBase a
Union (GraphRefWithNameAssocs
-> GraphRefRelationalExpr -> GraphRefRelationalExpr
substituteWithNameMacros GraphRefWithNameAssocs
macros GraphRefRelationalExpr
exprA) (GraphRefWithNameAssocs
-> GraphRefRelationalExpr -> GraphRefRelationalExpr
substituteWithNameMacros GraphRefWithNameAssocs
macros GraphRefRelationalExpr
exprB)
substituteWithNameMacros GraphRefWithNameAssocs
macros (Join GraphRefRelationalExpr
exprA GraphRefRelationalExpr
exprB) =
  forall a.
RelationalExprBase a
-> RelationalExprBase a -> RelationalExprBase a
Join (GraphRefWithNameAssocs
-> GraphRefRelationalExpr -> GraphRefRelationalExpr
substituteWithNameMacros GraphRefWithNameAssocs
macros GraphRefRelationalExpr
exprA) (GraphRefWithNameAssocs
-> GraphRefRelationalExpr -> GraphRefRelationalExpr
substituteWithNameMacros GraphRefWithNameAssocs
macros GraphRefRelationalExpr
exprB)
substituteWithNameMacros GraphRefWithNameAssocs
macros (Rename Set (RelVarName, RelVarName)
attrs GraphRefRelationalExpr
expr) =
  forall a.
Set (RelVarName, RelVarName)
-> RelationalExprBase a -> RelationalExprBase a
Rename Set (RelVarName, RelVarName)
attrs (GraphRefWithNameAssocs
-> GraphRefRelationalExpr -> GraphRefRelationalExpr
substituteWithNameMacros GraphRefWithNameAssocs
macros GraphRefRelationalExpr
expr)
substituteWithNameMacros GraphRefWithNameAssocs
macros (Difference GraphRefRelationalExpr
exprA GraphRefRelationalExpr
exprB) =
  forall a.
RelationalExprBase a
-> RelationalExprBase a -> RelationalExprBase a
Difference (GraphRefWithNameAssocs
-> GraphRefRelationalExpr -> GraphRefRelationalExpr
substituteWithNameMacros GraphRefWithNameAssocs
macros GraphRefRelationalExpr
exprA) (GraphRefWithNameAssocs
-> GraphRefRelationalExpr -> GraphRefRelationalExpr
substituteWithNameMacros GraphRefWithNameAssocs
macros GraphRefRelationalExpr
exprB)
substituteWithNameMacros GraphRefWithNameAssocs
macros (Group AttributeNamesBase GraphRefTransactionMarker
attrs RelVarName
attr GraphRefRelationalExpr
expr) =
  forall a.
AttributeNamesBase a
-> RelVarName -> RelationalExprBase a -> RelationalExprBase a
Group AttributeNamesBase GraphRefTransactionMarker
attrs RelVarName
attr (GraphRefWithNameAssocs
-> GraphRefRelationalExpr -> GraphRefRelationalExpr
substituteWithNameMacros GraphRefWithNameAssocs
macros GraphRefRelationalExpr
expr)  
substituteWithNameMacros GraphRefWithNameAssocs
macros (Ungroup RelVarName
attr GraphRefRelationalExpr
expr) =
  forall a.
RelVarName -> RelationalExprBase a -> RelationalExprBase a
Ungroup RelVarName
attr (GraphRefWithNameAssocs
-> GraphRefRelationalExpr -> GraphRefRelationalExpr
substituteWithNameMacros GraphRefWithNameAssocs
macros GraphRefRelationalExpr
expr)  
substituteWithNameMacros GraphRefWithNameAssocs
macros (Restrict RestrictionPredicateExprBase GraphRefTransactionMarker
pred' GraphRefRelationalExpr
expr) =
  forall a.
RestrictionPredicateExprBase a
-> RelationalExprBase a -> RelationalExprBase a
Restrict (GraphRefWithNameAssocs
-> RestrictionPredicateExprBase GraphRefTransactionMarker
-> RestrictionPredicateExprBase GraphRefTransactionMarker
substituteWithNameMacrosRestrictionPredicate GraphRefWithNameAssocs
macros RestrictionPredicateExprBase GraphRefTransactionMarker
pred') (GraphRefWithNameAssocs
-> GraphRefRelationalExpr -> GraphRefRelationalExpr
substituteWithNameMacros GraphRefWithNameAssocs
macros GraphRefRelationalExpr
expr)  
substituteWithNameMacros GraphRefWithNameAssocs
macros (Equals GraphRefRelationalExpr
exprA GraphRefRelationalExpr
exprB) =
  forall a.
RelationalExprBase a
-> RelationalExprBase a -> RelationalExprBase a
Equals (GraphRefWithNameAssocs
-> GraphRefRelationalExpr -> GraphRefRelationalExpr
substituteWithNameMacros GraphRefWithNameAssocs
macros GraphRefRelationalExpr
exprA) (GraphRefWithNameAssocs
-> GraphRefRelationalExpr -> GraphRefRelationalExpr
substituteWithNameMacros GraphRefWithNameAssocs
macros GraphRefRelationalExpr
exprB)
substituteWithNameMacros GraphRefWithNameAssocs
macros (NotEquals GraphRefRelationalExpr
exprA GraphRefRelationalExpr
exprB) =
  forall a.
RelationalExprBase a
-> RelationalExprBase a -> RelationalExprBase a
NotEquals (GraphRefWithNameAssocs
-> GraphRefRelationalExpr -> GraphRefRelationalExpr
substituteWithNameMacros GraphRefWithNameAssocs
macros GraphRefRelationalExpr
exprA) (GraphRefWithNameAssocs
-> GraphRefRelationalExpr -> GraphRefRelationalExpr
substituteWithNameMacros GraphRefWithNameAssocs
macros GraphRefRelationalExpr
exprB)
substituteWithNameMacros GraphRefWithNameAssocs
macros (Extend ExtendTupleExprBase GraphRefTransactionMarker
extendTup GraphRefRelationalExpr
expr) =
  forall a.
ExtendTupleExprBase a
-> RelationalExprBase a -> RelationalExprBase a
Extend (GraphRefWithNameAssocs
-> ExtendTupleExprBase GraphRefTransactionMarker
-> ExtendTupleExprBase GraphRefTransactionMarker
substituteWitNameMacrosExtendTupleExpr GraphRefWithNameAssocs
macros ExtendTupleExprBase GraphRefTransactionMarker
extendTup) (GraphRefWithNameAssocs
-> GraphRefRelationalExpr -> GraphRefRelationalExpr
substituteWithNameMacros GraphRefWithNameAssocs
macros GraphRefRelationalExpr
expr)
substituteWithNameMacros GraphRefWithNameAssocs
macros (With GraphRefWithNameAssocs
moreMacros GraphRefRelationalExpr
expr) =
  --collect and update nested with exprs
  let newMacros :: GraphRefWithNameAssocs
newMacros = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {a}.
Eq a =>
(a, GraphRefRelationalExpr)
-> [(a, GraphRefRelationalExpr)] -> [(a, GraphRefRelationalExpr)]
macroFolder GraphRefWithNameAssocs
macros GraphRefWithNameAssocs
moreMacros
      macroFolder :: (a, GraphRefRelationalExpr)
-> [(a, GraphRefRelationalExpr)] -> [(a, GraphRefRelationalExpr)]
macroFolder (a
wnexpr, GraphRefRelationalExpr
mexpr) [(a, GraphRefRelationalExpr)]
acc =
        let subExpr :: GraphRefRelationalExpr
subExpr = GraphRefWithNameAssocs
-> GraphRefRelationalExpr -> GraphRefRelationalExpr
substituteWithNameMacros GraphRefWithNameAssocs
macros GraphRefRelationalExpr
mexpr in
        forall a. (a -> Bool) -> [a] -> [a]
filter (\(a
w,GraphRefRelationalExpr
_) -> a
w forall a. Eq a => a -> a -> Bool
/= a
wnexpr) [(a, GraphRefRelationalExpr)]
acc forall a. [a] -> [a] -> [a]
++ [(a
wnexpr, GraphRefRelationalExpr
subExpr)] in
        --scan for a match- if it exists, replace it (representing a with clause at a lower level
  GraphRefWithNameAssocs
-> GraphRefRelationalExpr -> GraphRefRelationalExpr
substituteWithNameMacros GraphRefWithNameAssocs
newMacros GraphRefRelationalExpr
expr


substituteWithNameMacrosRestrictionPredicate :: GraphRefWithNameAssocs -> GraphRefRestrictionPredicateExpr -> GraphRefRestrictionPredicateExpr
substituteWithNameMacrosRestrictionPredicate :: GraphRefWithNameAssocs
-> RestrictionPredicateExprBase GraphRefTransactionMarker
-> RestrictionPredicateExprBase GraphRefTransactionMarker
substituteWithNameMacrosRestrictionPredicate GraphRefWithNameAssocs
macros RestrictionPredicateExprBase GraphRefTransactionMarker
pred' =
  let sub :: RestrictionPredicateExprBase GraphRefTransactionMarker
-> RestrictionPredicateExprBase GraphRefTransactionMarker
sub = GraphRefWithNameAssocs
-> RestrictionPredicateExprBase GraphRefTransactionMarker
-> RestrictionPredicateExprBase GraphRefTransactionMarker
substituteWithNameMacrosRestrictionPredicate GraphRefWithNameAssocs
macros in
  case RestrictionPredicateExprBase GraphRefTransactionMarker
pred' of
    RestrictionPredicateExprBase GraphRefTransactionMarker
TruePredicate -> RestrictionPredicateExprBase GraphRefTransactionMarker
pred'
    AndPredicate RestrictionPredicateExprBase GraphRefTransactionMarker
exprA RestrictionPredicateExprBase GraphRefTransactionMarker
exprB ->
      forall a.
RestrictionPredicateExprBase a
-> RestrictionPredicateExprBase a -> RestrictionPredicateExprBase a
AndPredicate (RestrictionPredicateExprBase GraphRefTransactionMarker
-> RestrictionPredicateExprBase GraphRefTransactionMarker
sub RestrictionPredicateExprBase GraphRefTransactionMarker
exprA) (RestrictionPredicateExprBase GraphRefTransactionMarker
-> RestrictionPredicateExprBase GraphRefTransactionMarker
sub RestrictionPredicateExprBase GraphRefTransactionMarker
exprB)
    OrPredicate RestrictionPredicateExprBase GraphRefTransactionMarker
exprA RestrictionPredicateExprBase GraphRefTransactionMarker
exprB ->
      forall a.
RestrictionPredicateExprBase a
-> RestrictionPredicateExprBase a -> RestrictionPredicateExprBase a
OrPredicate (RestrictionPredicateExprBase GraphRefTransactionMarker
-> RestrictionPredicateExprBase GraphRefTransactionMarker
sub RestrictionPredicateExprBase GraphRefTransactionMarker
exprA) (RestrictionPredicateExprBase GraphRefTransactionMarker
-> RestrictionPredicateExprBase GraphRefTransactionMarker
sub RestrictionPredicateExprBase GraphRefTransactionMarker
exprB)
    NotPredicate RestrictionPredicateExprBase GraphRefTransactionMarker
expr ->
      forall a.
RestrictionPredicateExprBase a -> RestrictionPredicateExprBase a
NotPredicate (RestrictionPredicateExprBase GraphRefTransactionMarker
-> RestrictionPredicateExprBase GraphRefTransactionMarker
sub RestrictionPredicateExprBase GraphRefTransactionMarker
expr)
    RelationalExprPredicate GraphRefRelationalExpr
reexpr ->
      forall a. RelationalExprBase a -> RestrictionPredicateExprBase a
RelationalExprPredicate (GraphRefWithNameAssocs
-> GraphRefRelationalExpr -> GraphRefRelationalExpr
substituteWithNameMacros GraphRefWithNameAssocs
macros GraphRefRelationalExpr
reexpr)
    AtomExprPredicate AtomExprBase GraphRefTransactionMarker
atomExpr ->
      forall a. AtomExprBase a -> RestrictionPredicateExprBase a
AtomExprPredicate (GraphRefWithNameAssocs
-> AtomExprBase GraphRefTransactionMarker
-> AtomExprBase GraphRefTransactionMarker
substituteWithNameMacrosAtomExpr GraphRefWithNameAssocs
macros AtomExprBase GraphRefTransactionMarker
atomExpr)
    AttributeEqualityPredicate RelVarName
attrName AtomExprBase GraphRefTransactionMarker
atomExpr ->
      forall a.
RelVarName -> AtomExprBase a -> RestrictionPredicateExprBase a
AttributeEqualityPredicate RelVarName
attrName (GraphRefWithNameAssocs
-> AtomExprBase GraphRefTransactionMarker
-> AtomExprBase GraphRefTransactionMarker
substituteWithNameMacrosAtomExpr GraphRefWithNameAssocs
macros AtomExprBase GraphRefTransactionMarker
atomExpr)

substituteWitNameMacrosExtendTupleExpr :: GraphRefWithNameAssocs -> GraphRefExtendTupleExpr -> GraphRefExtendTupleExpr
substituteWitNameMacrosExtendTupleExpr :: GraphRefWithNameAssocs
-> ExtendTupleExprBase GraphRefTransactionMarker
-> ExtendTupleExprBase GraphRefTransactionMarker
substituteWitNameMacrosExtendTupleExpr GraphRefWithNameAssocs
macros (AttributeExtendTupleExpr RelVarName
attrName AtomExprBase GraphRefTransactionMarker
atomExpr) =
  forall a. RelVarName -> AtomExprBase a -> ExtendTupleExprBase a
AttributeExtendTupleExpr RelVarName
attrName (GraphRefWithNameAssocs
-> AtomExprBase GraphRefTransactionMarker
-> AtomExprBase GraphRefTransactionMarker
substituteWithNameMacrosAtomExpr GraphRefWithNameAssocs
macros AtomExprBase GraphRefTransactionMarker
atomExpr)

substituteWithNameMacrosAtomExpr :: GraphRefWithNameAssocs -> GraphRefAtomExpr -> GraphRefAtomExpr
substituteWithNameMacrosAtomExpr :: GraphRefWithNameAssocs
-> AtomExprBase GraphRefTransactionMarker
-> AtomExprBase GraphRefTransactionMarker
substituteWithNameMacrosAtomExpr GraphRefWithNameAssocs
macros AtomExprBase GraphRefTransactionMarker
atomExpr =
  case AtomExprBase GraphRefTransactionMarker
atomExpr of
    e :: AtomExprBase GraphRefTransactionMarker
e@AttributeAtomExpr{} -> AtomExprBase GraphRefTransactionMarker
e
    e :: AtomExprBase GraphRefTransactionMarker
e@SubrelationAttributeAtomExpr{} -> AtomExprBase GraphRefTransactionMarker
e
    e :: AtomExprBase GraphRefTransactionMarker
e@NakedAtomExpr{} -> AtomExprBase GraphRefTransactionMarker
e
    FunctionAtomExpr RelVarName
fname [AtomExprBase GraphRefTransactionMarker]
atomExprs GraphRefTransactionMarker
tid ->
      forall a. RelVarName -> [AtomExprBase a] -> a -> AtomExprBase a
FunctionAtomExpr RelVarName
fname (forall a b. (a -> b) -> [a] -> [b]
map (GraphRefWithNameAssocs
-> AtomExprBase GraphRefTransactionMarker
-> AtomExprBase GraphRefTransactionMarker
substituteWithNameMacrosAtomExpr GraphRefWithNameAssocs
macros) [AtomExprBase GraphRefTransactionMarker]
atomExprs) GraphRefTransactionMarker
tid
    RelationAtomExpr GraphRefRelationalExpr
reExpr ->
      forall a. RelationalExprBase a -> AtomExprBase a
RelationAtomExpr (GraphRefWithNameAssocs
-> GraphRefRelationalExpr -> GraphRefRelationalExpr
substituteWithNameMacros GraphRefWithNameAssocs
macros GraphRefRelationalExpr
reExpr)
    IfThenAtomExpr AtomExprBase GraphRefTransactionMarker
ifE AtomExprBase GraphRefTransactionMarker
thenE AtomExprBase GraphRefTransactionMarker
elseE ->
      forall a.
AtomExprBase a
-> AtomExprBase a -> AtomExprBase a -> AtomExprBase a
IfThenAtomExpr (GraphRefWithNameAssocs
-> AtomExprBase GraphRefTransactionMarker
-> AtomExprBase GraphRefTransactionMarker
substituteWithNameMacrosAtomExpr GraphRefWithNameAssocs
macros AtomExprBase GraphRefTransactionMarker
ifE) (GraphRefWithNameAssocs
-> AtomExprBase GraphRefTransactionMarker
-> AtomExprBase GraphRefTransactionMarker
substituteWithNameMacrosAtomExpr GraphRefWithNameAssocs
macros AtomExprBase GraphRefTransactionMarker
thenE) (GraphRefWithNameAssocs
-> AtomExprBase GraphRefTransactionMarker
-> AtomExprBase GraphRefTransactionMarker
substituteWithNameMacrosAtomExpr GraphRefWithNameAssocs
macros AtomExprBase GraphRefTransactionMarker
elseE)
    ConstructedAtomExpr RelVarName
dconsName [AtomExprBase GraphRefTransactionMarker]
atomExprs GraphRefTransactionMarker
tid ->
      forall a. RelVarName -> [AtomExprBase a] -> a -> AtomExprBase a
ConstructedAtomExpr RelVarName
dconsName (forall a b. (a -> b) -> [a] -> [b]
map (GraphRefWithNameAssocs
-> AtomExprBase GraphRefTransactionMarker
-> AtomExprBase GraphRefTransactionMarker
substituteWithNameMacrosAtomExpr GraphRefWithNameAssocs
macros) [AtomExprBase GraphRefTransactionMarker]
atomExprs) GraphRefTransactionMarker
tid

substituteWithNameMacrosAttributeNames :: GraphRefWithNameAssocs -> GraphRefAttributeNames -> GraphRefAttributeNames
substituteWithNameMacrosAttributeNames :: GraphRefWithNameAssocs
-> AttributeNamesBase GraphRefTransactionMarker
-> AttributeNamesBase GraphRefTransactionMarker
substituteWithNameMacrosAttributeNames GraphRefWithNameAssocs
macros AttributeNamesBase GraphRefTransactionMarker
attrNames =
  case AttributeNamesBase GraphRefTransactionMarker
attrNames of
    AttributeNames{} -> AttributeNamesBase GraphRefTransactionMarker
attrNames
    InvertedAttributeNames{} -> AttributeNamesBase GraphRefTransactionMarker
attrNames
    UnionAttributeNames AttributeNamesBase GraphRefTransactionMarker
a AttributeNamesBase GraphRefTransactionMarker
b ->
      forall a.
AttributeNamesBase a
-> AttributeNamesBase a -> AttributeNamesBase a
UnionAttributeNames (GraphRefWithNameAssocs
-> AttributeNamesBase GraphRefTransactionMarker
-> AttributeNamesBase GraphRefTransactionMarker
substituteWithNameMacrosAttributeNames GraphRefWithNameAssocs
macros AttributeNamesBase GraphRefTransactionMarker
a) (GraphRefWithNameAssocs
-> AttributeNamesBase GraphRefTransactionMarker
-> AttributeNamesBase GraphRefTransactionMarker
substituteWithNameMacrosAttributeNames GraphRefWithNameAssocs
macros AttributeNamesBase GraphRefTransactionMarker
b)
    IntersectAttributeNames AttributeNamesBase GraphRefTransactionMarker
a AttributeNamesBase GraphRefTransactionMarker
b ->
      forall a.
AttributeNamesBase a
-> AttributeNamesBase a -> AttributeNamesBase a
IntersectAttributeNames (GraphRefWithNameAssocs
-> AttributeNamesBase GraphRefTransactionMarker
-> AttributeNamesBase GraphRefTransactionMarker
substituteWithNameMacrosAttributeNames GraphRefWithNameAssocs
macros AttributeNamesBase GraphRefTransactionMarker
a) (GraphRefWithNameAssocs
-> AttributeNamesBase GraphRefTransactionMarker
-> AttributeNamesBase GraphRefTransactionMarker
substituteWithNameMacrosAttributeNames GraphRefWithNameAssocs
macros AttributeNamesBase GraphRefTransactionMarker
b)
    RelationalExprAttributeNames GraphRefRelationalExpr
relExpr ->
      forall a. RelationalExprBase a -> AttributeNamesBase a
RelationalExprAttributeNames (GraphRefWithNameAssocs
-> GraphRefRelationalExpr -> GraphRefRelationalExpr
substituteWithNameMacros GraphRefWithNameAssocs
macros GraphRefRelationalExpr
relExpr)