From 0b76d1e4d4bf673ec0678d220d8fdf07c5a9408f Mon Sep 17 00:00:00 2001 From: Simon Marlow Date: Wed, 25 Mar 2026 10:35:58 +0000 Subject: [PATCH] Angle compiler cleanups - rename `TcQueryGen` to `TcWhere` - change `TcAll` and `TcNegation` to contain `TcPat` instead of `TcQuery` / `[TcStatement]` respectively (this is more uniform and consistent, and simplifies some things) - refactoring in the type checker to unify how we handle locality. `oneBranch` is renamed `encloseLocal` and used consistently when typechecking `|`, `all`, `!`, and `if`, which all need locality. Probably fixes some bugs. - update a few out-of-date comments --- glean/db/Glean/Query/BindOrder.hs | 22 +-- glean/db/Glean/Query/Codegen/Types.hs | 31 ---- glean/db/Glean/Query/Expand.hs | 12 +- glean/db/Glean/Query/Flatten.hs | 19 +- glean/db/Glean/Query/Prune.hs | 14 +- glean/db/Glean/Query/Typecheck.hs | 220 +++++++++++------------- glean/db/Glean/Query/Typecheck/Types.hs | 13 +- glean/db/Glean/Query/Typecheck/Unify.hs | 6 +- glean/test/tests/Angle/ErrorTest.hs | 2 +- 9 files changed, 138 insertions(+), 201 deletions(-) diff --git a/glean/db/Glean/Query/BindOrder.hs b/glean/db/Glean/Query/BindOrder.hs index 8b2240a359..1784ec925e 100644 --- a/glean/db/Glean/Query/BindOrder.hs +++ b/glean/db/Glean/Query/BindOrder.hs @@ -33,22 +33,12 @@ import Glean.Query.Vars (VarSet) import Glean.RTS.Term as RTS -- ----------------------------------------------------------------------------- --- Fixing up MatchBind vs. MatchVar - --- Substitution can mess up MatchBind and MatchVar - we might end up --- with multiple MatchBinds for a variable, or a MatchVar before a --- MatchBind. To fix it up all we need to do is traverse the query in --- the correct order, keeping track of which variables are in scope, --- and change MatchBind<->MatchVar as appropriate. --- --- This is all somewhat suboptimal, because the typechecker has --- already figured out MatchBind vs. MatchVar and here we mess it up --- by substitution and then fix it again. Which begs the question: why --- do we have MatchBind and MatchVar at all, couldn't we leave it --- until the last minute just before code generation to figure out --- which variables are binding occurrences? Yes, but it's nice to be --- able to give the user out-of-scope error messages from the --- typechecker. Maybe we'll change this in the future. +-- Resolving MatchBind vs. MatchVar + +-- Before the Reorder pass, MatchBind and MatchVar are the same (strictly +-- speaking we should have just one variable form). The reorder pass resolves +-- statement ordering so that variables are bound before their use; +-- MatchBind indicates a variable binding and MatchVar indicates a variable use. data Scope = Scope { isScope :: VarSet diff --git a/glean/db/Glean/Query/Codegen/Types.hs b/glean/db/Glean/Query/Codegen/Types.hs index fa85bccd48..d2ab7a5847 100644 --- a/glean/db/Glean/Query/Codegen/Types.hs +++ b/glean/db/Glean/Query/Codegen/Types.hs @@ -81,7 +81,6 @@ data CgStatement_ var | CgAllStatement var (Expr_ var) [CgStatement_ var] | CgNegation [CgStatement_ var] | CgDisjunction [[CgStatement_ var]] - -- ^ For rationale, see Note [why do we have sequential composition?] | CgConditional { cond :: [CgStatement_ var] , then_ :: [CgStatement_ var] @@ -89,38 +88,8 @@ data CgStatement_ var } deriving (Show, Functor, Foldable, Traversable) - type CgStatement = CgStatement_ Var -{- Note [why do we have sequential composition?] - -The issue is that queries for sum types can't necessarily be handled -by nested generators. Consider - - v = cxx1.FunctionName (name(cxx1.Name "xyz" ) | operator(cxx1.Name "+")) - -If we flattened this into nested generators we would get - - x = cxx1.Name "xyz" - y = cxx1.Name "+" - z = cxx1.FunctionName (name x | operator y) - -Now suppose there is no name xyz. This query will match nothing, -because the generator for cxx1.Name "xyz" would be empty. (even if -the generator matched, flattening out the generators like this will -test too many combinations and do too much work). - -With sequential composition of queries we can do it like this: - - n = (name x where x = cxx1.Name "xyz") | - (operator x where x = cxx1.Name "+") - v = cxx1.FunctionName n - -(Note that this query won't work if you write it because we can't -typecheck the sub-query "name x where ...", but we can generate the -AST for it in the JSON query compiler.) --} - type Generator = Generator_ Var -- | A generator produces a finite series of terms diff --git a/glean/db/Glean/Query/Expand.hs b/glean/db/Glean/Query/Expand.hs index 3d192fbf64..36ff5af176 100644 --- a/glean/db/Glean/Query/Expand.hs +++ b/glean/db/Glean/Query/Expand.hs @@ -102,12 +102,12 @@ instantiateWithFreshVariables query numVars = do TcElementsOfSet (instantiatePat base pat) instantiateTcTerm base (TcElementsUnresolved ty pat) = TcElementsUnresolved ty (instantiatePat base pat) - instantiateTcTerm base (TcQueryGen query) = - TcQueryGen (instantiateQuery base query) - instantiateTcTerm base (TcAll query) = - TcAll (instantiateQuery base query) - instantiateTcTerm base (TcNegation stmts) = - TcNegation (map (instantiateStmt base) stmts) + instantiateTcTerm base (TcWhere query) = + TcWhere (instantiateQuery base query) + instantiateTcTerm base (TcAll pat) = + TcAll (instantiatePat base pat) + instantiateTcTerm base (TcNegation p) = + TcNegation (instantiatePat base p) instantiateTcTerm base (TcPrimCall op args) = TcPrimCall op (map (instantiatePat base) args) instantiateTcTerm base (TcIf (Typed ty cond) then_ else_) = diff --git a/glean/db/Glean/Query/Flatten.hs b/glean/db/Glean/Query/Flatten.hs index 4b7e0a557e..90764fc390 100644 --- a/glean/db/Glean/Query/Flatten.hs +++ b/glean/db/Glean/Query/Flatten.hs @@ -210,20 +210,25 @@ flattenSeqGenerators (Ref (MatchExt (Typed ty match))) = case match of TcElementsOfSet pat -> do r <- flattenPattern pat return [(mempty, stmts, SetElementGenerator ty pat') | (stmts,pat') <- r ] - TcQueryGen query -> do + TcWhere query -> do (group, term, _) <- flattenQuery' query return [(floatGroup group, mempty, TermGenerator term)] - TcAll query -> do - (group, term, _) <- flattenQuery' query + TcAll p -> do + let elemTy = case derefType ty of + Schema.SetTy t -> t + _other -> error "TcAll: not SetTy" + (group, term, _) <- flattenQuery' $ + TcQuery elemTy p Nothing [] Angle.Unordered var <- fresh ty return [ (Statements [FlatAllStatement var term group] , mempty , TermGenerator (Ref (MatchVar var)))] - TcNegation stmts -> do - (ords, floats) <- mapAndUnzipM flattenStatement stmts - let neg = FlatNegation (mkGroup ords floats) - return [(oneStmt neg, mempty, TermGenerator $ Tuple [])] + TcNegation p -> do + (group, _term, _) <- flattenQuery' (TcQuery ty p Nothing [] Angle.Ordered) + -- Note: term is discarded. e.g. in !(X where ...) we don't do anything + -- with the X. + return [(oneStmt (FlatNegation group), mempty, TermGenerator $ Tuple [])] TcPrimCall op args -> do r <- manyTerms (\args -> PrimCall op args ty) <$> mapM flattenPattern args return [ (mempty, float, gen) | (float, gen) <- r ] diff --git a/glean/db/Glean/Query/Prune.hs b/glean/db/Glean/Query/Prune.hs index b65b024427..1142b9c17e 100644 --- a/glean/db/Glean/Query/Prune.hs +++ b/glean/db/Glean/Query/Prune.hs @@ -155,12 +155,12 @@ prune hasFacts (QueryWithInfo q _ gen t) = do Ref . MatchExt . Typed ty . TcElementsOfSet <$> prunePat x TcElementsUnresolved ty' x -> Ref . MatchExt . Typed ty . TcElementsUnresolved ty' <$> prunePat x - TcQueryGen q -> - Ref . MatchExt . Typed ty . TcQueryGen <$> pruneTcQuery q + TcWhere q -> + Ref . MatchExt . Typed ty . TcWhere <$> pruneTcQuery q -- we dont' want to handle negation here because if it tries to match -- against things that are not in the database it should succeed. - TcAll query -> - Ref . MatchExt . Typed ty . TcAll <$> pruneTcQuery query + TcAll p -> + Ref . MatchExt . Typed ty . TcAll <$> prunePat p TcNegation{} -> Just pat TcPrimCall op xs -> Ref . MatchExt . Typed ty . TcPrimCall op <$> traverse prunePat xs @@ -240,9 +240,9 @@ renumberVars gen ty q = TcElementsOfArray x -> TcElementsOfArray <$> renamePat x TcElementsOfSet x -> TcElementsOfSet <$> renamePat x TcElementsUnresolved ty x -> TcElementsUnresolved ty <$> renamePat x - TcQueryGen q -> TcQueryGen <$> renameQuery q - TcAll query -> TcAll <$> renameQuery query - TcNegation xs -> TcNegation <$> traverse renameStmt xs + TcWhere q -> TcWhere <$> renameQuery q + TcAll p -> TcAll <$> renamePat p + TcNegation p -> TcNegation <$> renamePat p TcPrimCall op xs -> TcPrimCall op <$> traverse renamePat xs TcIf cond then_ else_ -> TcIf <$> traverse renamePat cond <*> renamePat then_ <*> renamePat else_ diff --git a/glean/db/Glean/Query/Typecheck.hs b/glean/db/Glean/Query/Typecheck.hs index 67c5507046..b931644b71 100644 --- a/glean/db/Glean/Query/Typecheck.hs +++ b/glean/db/Glean/Query/Typecheck.hs @@ -87,32 +87,32 @@ typecheck dbSchema opts rtsType query = do { tcEnvPredicates = predicatesById dbSchema , tcEnvTypes = typesById dbSchema } - (q@(TcQuery ty _ _ _ _), TypecheckState{..}) <- + ((q@(TcQuery ty _ _ _ _), _, _), TypecheckState{..}) <- let state = initialTypecheckState tcEnv opts rtsType TcModeQuery in - withExceptT (Text.pack . show) $ flip runStateT state $ do - modify $ \s -> s { tcVisible = varsQuery query mempty } - q@(TcQuery retTy _ _ _ _) <- inferQuery ContextPat query - <* freeVariablesAreErrors <* unboundVariablesAreErrors - resolvePromote - subst <- gets tcSubst - whenDebug $ liftIO $ hPutStrLn stderr $ show $ - vcat [ - "subst:", indent 2 (vcat - [ pretty n <> " := " <> displayDefault ty - | (n,ty) <- IntMap.toList subst - ]), - "query: " <> displayDefault q - ] - zonkVars - zonkTcQuery q - `catchError` \_ -> do - (head,_,_) <- needsResult query - opts <- gets tcDisplayOpts - retTy' <- apply retTy - prettyErrorAt (sourcePatSpan head) $ vcat - [ "query has ambiguous type", - indent 4 $ "type: " <> display opts retTy' - ] + withExceptT (Text.pack . show) $ flip runStateT state $ + encloseLocal (varsQuery query mempty) $ do + q@(TcQuery retTy _ _ _ _) <- inferQuery ContextPat query + freeVariablesAreErrors + resolvePromote + subst <- gets tcSubst + whenDebug $ liftIO $ hPutStrLn stderr $ show $ + vcat [ + "subst:", indent 2 (vcat + [ pretty n <> " := " <> displayDefault ty + | (n,ty) <- IntMap.toList subst + ]), + "query: " <> displayDefault q + ] + zonkVars + zonkTcQuery q + `catchError` \_ -> do + (head,_,_) <- needsResult query + opts <- gets tcDisplayOpts + retTy' <- apply retTy + prettyErrorAt (sourcePatSpan head) $ vcat + [ "query has ambiguous type", + indent 4 $ "type: " <> display opts retTy' + ] return (QueryWithInfo q tcNextVar Nothing ty, tcPreds) -- | Typecheck the query for a derived predicate @@ -136,39 +136,38 @@ typecheckDeriving tcEnv opts rtsType PredicateDetails{..} derivingInfo = do case derivingInfo of NoDeriving -> return NoDeriving Derive deriveWhen q -> do - modify $ \s -> s { tcVisible = varsQuery q mempty } - -- we typecheck the pattern first, because we know its type. - (head, stmts, ord) <- needsResult q - let - (key, maybeVal) = case head of - KeyValue _ key val -> (key, Just val) - -- Backwards compat, we had a predicate in schema v4 of the form - -- X -> prim.toLower X - -- but this doesn't parse if -> binds tighter than application. - App _ (KeyValue _ key val) xs -> - let end - | null xs = val - | otherwise = last xs - span = spanBetween (sourcePatSpan val) (sourcePatSpan end) - in - (key, Just (App span val xs)) - _other -> (head, Nothing) - key' <- typecheckPattern ContextPat predicateKeyType key - maybeVal' <- case maybeVal of - Nothing - | eqType (tcOptAngleVersion opts) unit predicateValueType -> - return Nothing - | otherwise -> prettyErrorIn head $ nest 4 $ vcat - [ "a functional predicate must return a value," - , "i.e. the query should have the form 'X -> Y where .." ] - Just val -> Just <$> - typecheckPattern ContextPat predicateValueType val - stmts' <- mapM typecheckStatement stmts - freeVariablesAreErrors - unboundVariablesAreErrors - resolvePromote - zonkVars - q <- zonkTcQuery (TcQuery predicateKeyType key' maybeVal' stmts' ord) + (q, _, _) <- encloseLocal (varsQuery q mempty) $ do + -- we typecheck the pattern first, because we know its type. + (head, stmts, ord) <- needsResult q + let + (key, maybeVal) = case head of + KeyValue _ key val -> (key, Just val) + -- Backwards compat, we had a predicate in schema v4 of the form + -- X -> prim.toLower X + -- but this doesn't parse if -> binds tighter than application. + App _ (KeyValue _ key val) xs -> + let end + | null xs = val + | otherwise = last xs + span = spanBetween (sourcePatSpan val) (sourcePatSpan end) + in + (key, Just (App span val xs)) + _other -> (head, Nothing) + key' <- typecheckPattern ContextPat predicateKeyType key + maybeVal' <- case maybeVal of + Nothing + | eqType (tcOptAngleVersion opts) unit predicateValueType -> + return Nothing + | otherwise -> prettyErrorIn head $ nest 4 $ vcat + [ "a functional predicate must return a value," + , "i.e. the query should have the form 'X -> Y where .." ] + Just val -> Just <$> + typecheckPattern ContextPat predicateValueType val + stmts' <- mapM typecheckStatement stmts + freeVariablesAreErrors + resolvePromote + zonkVars + zonkTcQuery (TcQuery predicateKeyType key' maybeVal' stmts' ord) nextVar <- gets tcNextVar return $ Derive deriveWhen $ QueryWithInfo q nextVar Nothing predicateKeyType @@ -322,7 +321,7 @@ inferExpr ctx pat = case pat of return (Ref (MatchExt (Typed ty (TcOr a' b'))), ty) NestedQuery _ q -> do q@(TcQuery ty _ _ _ _) <- inferQuery ctx q - return (Ref (MatchExt (Typed ty (TcQueryGen q))), ty) + return (Ref (MatchExt (Typed ty (TcWhere q))), ty) Negation _ _ -> (,unit) <$> typecheckPattern ctx unit pat IfPattern _ srcCond srcThen srcElse -> do @@ -361,11 +360,10 @@ inferExpr ctx pat = case pat of , "does not have a set type" ] All _ e -> do - (e',elementTy) <- inferExpr ctx e - let - q = TcQuery elementTy e' Nothing [] Unordered - ty = SetTy elementTy - return (Ref (MatchExt (Typed ty (TcAll q))), ty) + ((e',elementTy), _, _) <- + encloseLocal (varsPat e mempty) $ inferExpr ctx e + let ty = SetTy elementTy + return (Ref (MatchExt (Typed ty (TcAll e'))), ty) TypeSignature s e ty -> do rtsType <- gets tcRtsType @@ -621,37 +619,13 @@ typecheckPattern ctx typ pat = case (typ, pat) of return (Ref (MatchExt (Typed ty (TcIf cond then_ else_)))) (ty, NestedQuery _ query) -> - Ref . MatchExt . Typed ty . TcQueryGen <$> typecheckQuery ctx ty query - - (ty, Negation s pat) | ty == unit -> do - let startPos = mkSpan (startLoc s) (startLoc s) - empty = Tuple startPos [] - (stmts, ord) = case pat of - NestedQuery _ (SourceQuery Nothing stmts _) -> (stmts, ord) - other -> ([SourceStatement (Wildcard s) other], Unordered) - - -- A negated pattern must always have type {}. - query = SourceQuery (Just empty) stmts ord - - -- Variables bound within a negated query are - -- not considered bound outside of it. - enclose tc = do - before <- get - modify $ \s -> s { - tcVisible = varsPat pat (tcVisible before) - } - res <- tc - modify $ \after -> after - { tcBindings = tcBindings before - , tcUses = tcUses after `HashSet.intersection` tcVisible before - , tcScope = tcScope after - `HashMap.intersection` HashSet.toMap (tcVisible before) - , tcVisible = tcVisible before - } - return res - - TcQuery _ _ _ stmts _ <- enclose $ typecheckQuery ctx unit query - return $ Ref (MatchExt (Typed unit (TcNegation stmts))) + Ref . MatchExt . Typed ty . TcWhere <$> typecheckQuery ctx ty query + + (ty, Negation _ pat) | ty == unit -> do + (pat, _, _) <- + encloseLocal (varsPat pat mempty) $ + typecheckPattern ctx unit (ignoreResult pat) + return $ Ref (MatchExt (Typed unit (TcNegation pat))) (PredicateTy _ _, FactId _ Nothing fid) -> do isFactIdAllowed pat @@ -665,9 +639,9 @@ typecheckPattern ctx typ pat = case (typ, pat) of return (f e') (ty@(SetTy elemTy), All _ query) -> do - arg <- typecheckPattern ctx elemTy query - let q = TcQuery elemTy arg Nothing [] Unordered - return (Ref (MatchExt (Typed ty (TcAll q)))) + (arg, _, _) <- encloseLocal (varsPat query mempty) $ + typecheckPattern ctx elemTy query + return (Ref (MatchExt (Typed ty (TcAll arg)))) -- A match on a predicate type with a pattern that is not a wildcard, -- variable, field selector or dereference matches the key. @@ -818,13 +792,8 @@ freeVariablesAreErrors = do , "This is usually a mistake, so it is disallowed in Angle." ] -unboundVariablesAreErrors :: T () -unboundVariablesAreErrors = do - TypecheckState{..} <- get - unboundVariablesAreErrors_ tcUses tcBindings - -unboundVariablesAreErrors_ :: VarSet -> VarSet -> T () -unboundVariablesAreErrors_ uses binds = do +unboundVariablesAreErrors :: VarSet -> VarSet -> T () +unboundVariablesAreErrors uses binds = do case HashSet.toList (uses `HashSet.difference` binds) of [] -> return () badGuys -> prettyError $ nest 4 $ vcat @@ -856,17 +825,19 @@ checkVarCase span name -- 2. The set of variables that are considered to be *used* by this -- pattern are those that are used in either branch. -- -disjunction :: VarSet -> T a -> VarSet -> (a -> T b) -> T (a,b) + +disjunction :: VarSet -> T a -> VarSet -> (a -> T b) -> T (a, b) disjunction varsA ta varsB tb = do state0 <- get - (a, usesA, bindsA) <- oneBranch varsA ta - (b, usesB, bindsB) <- oneBranch varsB (tb a) + (a, usesA, bindsA) <- encloseLocal varsA ta + (b, usesB, bindsB) <- encloseLocal varsB (tb a) + let binds = bindsA `HashSet.intersection` bindsB + let uses = usesA `HashSet.union` usesB modify $ \s -> s { - tcBindings = tcBindings state0 `HashSet.union` -- Note (1) above - (bindsA `HashSet.intersection` bindsB), - tcUses = tcUses state0 `HashSet.union` -- Note (2) above - (usesA `HashSet.union` usesB) } - return (a,b) + tcBindings = tcBindings state0 `HashSet.union` binds, -- Note (1) above + tcUses = tcUses state0 `HashSet.union` uses -- Note (2) above + } + return (a, b) -- | Typechecking either A or B in A|B -- @@ -879,9 +850,9 @@ disjunction varsA ta varsB tb = do -- 3. To determine what is local to any nested A|B subterms, we update -- tcVisible by finding the visible variables of the current pattern. -- -oneBranch :: VarSet -> T a -> T (a, VarSet, VarSet) -oneBranch branchVars ta = do - visibleBefore <- gets tcVisible +encloseLocal :: VarSet -> T a -> T (a, VarSet, VarSet) +encloseLocal branchVars ta = do + before@TypecheckState { tcVisible = visibleBefore } <- get modify $ \s -> s { tcUses = HashSet.empty, tcBindings = HashSet.empty, @@ -892,13 +863,16 @@ oneBranch branchVars ta = do let localUses = HashSet.difference (tcUses after) visibleBefore localBinds = HashSet.difference (tcBindings after) visibleBefore - unboundVariablesAreErrors_ localUses localBinds + unboundVariablesAreErrors localUses localBinds modify $ \s -> s { tcScope = HashMap.intersection (tcScope after) (HashSet.toMap visibleBefore) -- See Note (1) above - , tcVisible = visibleBefore } + , tcUses = tcUses before + , tcBindings = tcUses before + , tcVisible = tcVisible before + } let extUses = HashSet.intersection (tcUses after) visibleBefore extBinds = HashSet.intersection (tcBindings after) visibleBefore @@ -1038,9 +1012,9 @@ tcQueryDeps q = Set.fromList $ map getRef (overQuery q) TcElementsOfArray x -> overPat x TcElementsOfSet x -> overPat x TcElementsUnresolved _ x -> overPat x - TcQueryGen q -> overQuery q - TcAll q -> overQuery q - TcNegation stmts -> foldMap overStatement stmts + TcWhere q -> overQuery q + TcAll q -> overPat q + TcNegation p -> overPat p TcPrimCall _ xs -> foldMap overPat xs TcIf (Typed _ x) y z -> foldMap overPat [x, y, z] TcDeref _ p -> overPat p @@ -1095,8 +1069,8 @@ tcTermUsesNegation = \case TcElementsOfArray x -> tcPatUsesNegation x TcElementsOfSet x -> tcPatUsesNegation x TcElementsUnresolved _ p -> tcPatUsesNegation p - TcQueryGen q -> tcQueryUsesNegation q - TcAll query -> tcQueryUsesNegation query + TcWhere q -> tcQueryUsesNegation q + TcAll p -> tcPatUsesNegation p TcNegation _ -> Just PatternNegation TcPrimCall _ xs -> firstJust tcPatUsesNegation xs -- one can replicate negation using if statements diff --git a/glean/db/Glean/Query/Typecheck/Types.hs b/glean/db/Glean/Query/Typecheck/Types.hs index ae56e4cc87..a73727f253 100644 --- a/glean/db/Glean/Query/Typecheck/Types.hs +++ b/glean/db/Glean/Query/Typecheck/Types.hs @@ -59,9 +59,9 @@ data TcTerm | TcElementsOfArray TcPat | TcElementsOfSet TcPat | TcElementsUnresolved Type TcPat - | TcQueryGen TcQuery - | TcAll TcQuery - | TcNegation [TcStatement] + | TcWhere TcQuery + | TcAll TcPat + | TcNegation TcPat | TcPrimCall PrimOp [TcPat] | TcIf { cond :: Typed TcPat, then_ :: TcPat, else_ :: TcPat } | TcDeref Type TcPat @@ -105,11 +105,10 @@ instance Display TcTerm where display opts (TcElementsOfArray arr) = displayAtom opts arr <> "[..]" display opts (TcElementsOfSet set) = "elements" <+> parens (display opts set) display opts (TcElementsUnresolved _ pat) = displayAtom opts pat <> "[..]" - display opts (TcQueryGen q) = parens (display opts q) + display opts (TcWhere q) = parens (display opts q) display opts (TcAll query) = "all" <+> "(" <> display opts query <> ")" - display opts (TcNegation q) = - "!" <> parens (sep (punctuate ";" (map (display opts) q))) + display opts (TcNegation q) = "!" <> parens (display opts q) display opts (TcPrimCall op args) = hsep (display opts op : map (displayAtom opts) args) display opts (TcPromote _ pat) = @@ -126,7 +125,7 @@ instance Display TcTerm where TcOr{} -> parens (display opts pat) TcFactGen{} -> parens (display opts pat) TcPrimCall{} -> parens (display opts pat) - TcQueryGen{} -> parens (display opts pat) + TcWhere{} -> parens (display opts pat) TcNegation{} -> display opts pat TcIf{} -> parens (display opts pat) _ -> display opts pat diff --git a/glean/db/Glean/Query/Typecheck/Unify.hs b/glean/db/Glean/Query/Typecheck/Unify.hs index adef88e63a..b274422ced 100644 --- a/glean/db/Glean/Query/Typecheck/Unify.hs +++ b/glean/db/Glean/Query/Typecheck/Unify.hs @@ -409,9 +409,9 @@ zonkTcTerm t = case t of TcFactGen pid k v sec -> TcFactGen pid <$> zonkTcPat k <*> zonkTcPat v <*> pure sec TcElementsOfArray a -> TcElementsOfArray <$> zonkTcPat a - TcQueryGen q -> TcQueryGen <$> zonkTcQuery q - TcAll q -> TcAll <$> zonkTcQuery q - TcNegation stmts -> TcNegation <$> mapM zonkTcStatement stmts + TcWhere q -> TcWhere <$> zonkTcQuery q + TcAll p -> TcAll <$> zonkTcPat p + TcNegation p -> TcNegation <$> zonkTcPat p TcPrimCall op args -> TcPrimCall op <$> mapM zonkTcPat args TcIf (Typed ty cond) th el -> TcIf diff --git a/glean/test/tests/Angle/ErrorTest.hs b/glean/test/tests/Angle/ErrorTest.hs index 22d1d05da7..c46d1a2a92 100644 --- a/glean/test/tests/Angle/ErrorTest.hs +++ b/glean/test/tests/Angle/ErrorTest.hs @@ -205,5 +205,5 @@ angleErrorTests = dbTestCase $ \env repo -> do assertBool "angle - negation unbound" $ case r of Left (BadQuery x) -> - "unbound variable: A" `Text.isInfixOf` x + "not bound anywhere: A" `Text.isInfixOf` x _ -> False