From ca8e1956bf5061714df8edbe5f10b26ae3db1399 Mon Sep 17 00:00:00 2001 From: Ashley Yakeley Date: Mon, 1 Jun 2020 20:04:10 -0700 Subject: [PATCH] support StandAloneKindSignatures; support visible forall quantification --- src/Language/Haskell/Exts/ExactPrint.hs | 15 +++++++-- src/Language/Haskell/Exts/Extension.hs | 2 ++ src/Language/Haskell/Exts/InternalParser.ly | 21 ++++++++++-- src/Language/Haskell/Exts/ParseSyntax.hs | 5 +-- src/Language/Haskell/Exts/ParseUtils.hs | 22 ++++++------- src/Language/Haskell/Exts/Pretty.hs | 33 +++++++++++-------- src/Language/Haskell/Exts/Syntax.hs | 16 +++++++-- tests/examples/ClassContext.hs.parser.golden | 1 + .../examples/ConstraintKinds.hs.parser.golden | 1 + .../ConstraintKinds2.hs.parser.golden | 1 + .../ConstraintKinds3.hs.parser.golden | 1 + ...structorAndClassOperators.hs.parser.golden | 1 + .../examples/ContextOrdering.hs.parser.golden | 1 + .../DefaultSignatures.hs.parser.golden | 1 + tests/examples/DerivingVia.hs.parser.golden | 18 ++++++++++ tests/examples/DerivingVia2.hs.parser.golden | 2 ++ tests/examples/Directory.hs.parser.golden | 1 + tests/examples/EmptyContext.hs.parser.golden | 1 + .../EqualityConstraints1.hs.parser.golden | 1 + tests/examples/Fixity3.hs.parser.golden | 1 + ...exibleContextsWithoutVars.hs.parser.golden | 1 + tests/examples/GenericTree.hs.parser.golden | 2 ++ .../examples/InfixTypeMinus.hs.parser.golden | 4 +++ .../InjectiveTypeFamilies.hs.parser.golden | 1 + tests/examples/MultiCtxt.hs.parser.golden | 2 ++ tests/examples/MultiParam.hs.parser.golden | 1 + .../OverloadedLabels.hs.parser.golden | 1 + .../PartialSignatures.hs.parser.golden | 21 ++++++++++++ .../PatternSynonyms3.hs.parser.golden | 2 ++ .../QuantifiedConstraints.hs.parser.golden | 1 + .../QuasiQuoteSplice.hs.parser.golden | 1 + tests/examples/RCategory.hs.parser.golden | 4 +++ tests/examples/Rules.hs.parser.golden | 1 + .../ScopedTypeVariables.hs.parser.golden | 1 + .../examples/SingleClassAsst.hs.parser.golden | 1 + .../SpecializePhaseControl.hs.parser.golden | 8 +++++ .../TypeEqualityParen.hs.parser.golden | 1 + .../TypeOperatorsTest.hs.parser.golden | 1 + tests/examples/Unicode.hs.parser.golden | 1 + tests/examples/UnicodeSyntax.hs.parser.golden | 1 + tests/examples/Vta1.hs.parser.golden | 10 ++++++ tests/examples/Vta2.hs.parser.golden | 2 ++ 42 files changed, 179 insertions(+), 34 deletions(-) diff --git a/src/Language/Haskell/Exts/ExactPrint.hs b/src/Language/Haskell/Exts/ExactPrint.hs index bf3b1e70..25dc51e7 100644 --- a/src/Language/Haskell/Exts/ExactPrint.hs +++ b/src/Language/Haskell/Exts/ExactPrint.hs @@ -738,6 +738,13 @@ instance ExactP Decl where let pts = srcInfoPoints l printInterleaved' (zip pts (replicate (length pts - 1) "," ++ ["::"])) ns exactPC t + TypeKindSig l ns t -> + case srcInfoPoints l of + (a:pts) -> do + printStringAt (pos a) "type" + printInterleaved' (zip pts (replicate (length pts - 1) "," ++ ["::"])) ns + exactPC t + _ -> errorEP "ExactP: Decl: TypeKindSig is given wrong number of srcInfoPoints" PatSynSig l ns dh c1 _ c2 t -> do let (pat:pts) = srcInfoPoints l printStringAt (pos pat) "pattern" @@ -1042,9 +1049,13 @@ instance ExactP TyVarBind where [] -> exactPC n _ -> errorEP "ExactP: TyVarBind: UnkindedVar is given wrong number of srcInfoPoints" +exactQuantVisibility :: QuantVisibility -> String +exactQuantVisibility InvisibleQuantification = "." +exactQuantVisibility VisibleQuantification = "->" + instance ExactP Type where exactP t' = case t' of - TyForall l mtvs mctxt t -> do + TyForall l mtvs q mctxt t -> do let pts = srcInfoPoints l _ <- case mtvs of Nothing -> return pts @@ -1053,7 +1064,7 @@ instance ExactP Type where _:b:pts' -> do printString "forall" mapM_ exactPC tvs - printStringAt (pos b) "." + printStringAt (pos b) (exactQuantVisibility q) return pts' _ -> errorEP "ExactP: Type: TyForall is given too few srcInfoPoints" maybeEP exactPC mctxt diff --git a/src/Language/Haskell/Exts/Extension.hs b/src/Language/Haskell/Exts/Extension.hs index 70c56922..6f41bf0e 100644 --- a/src/Language/Haskell/Exts/Extension.hs +++ b/src/Language/Haskell/Exts/Extension.hs @@ -560,6 +560,8 @@ data KnownExtension = | BlockArguments + | StandaloneKindSignatures + deriving (Show, Read, Eq, Ord, Enum, Bounded, Data, Typeable) -- | Certain extensions imply other extensions, and this function diff --git a/src/Language/Haskell/Exts/InternalParser.ly b/src/Language/Haskell/Exts/InternalParser.ly index 523b8ef9..ef4b556b 100644 --- a/src/Language/Haskell/Exts/InternalParser.ly +++ b/src/Language/Haskell/Exts/InternalParser.ly @@ -580,6 +580,10 @@ shift/reduce-conflict, so we don't handle this case here, but in bodyaux. > : topdecls1 semis topdecl { ($3 : fst $1, snd $1 ++ reverse $2) } > | topdecl { ([$1],[]) } +> gtycons :: { [QName L] } +> : gtycon { [$1] } +> | gtycon ',' gtycons { ($1 : $3) } + > topdecl :: { Decl L } > : role_annot {% checkEnabled RoleAnnotations >> return $1 } > | 'type' dtype '=' truectype @@ -587,6 +591,13 @@ shift/reduce-conflict, so we don't handle this case here, but in bodyaux. > let {l = nIS $1 <++> ann $4 <** [$1,$3]}; > return (TypeDecl l dh $4) } } +Requires the StandaloneKindSignatures extension. +> | 'type' gtycons '::' truectype +> {% do { checkEnabled StandaloneKindSignatures; +> names <- mapM checkUnQual $2; +> let {l = nIS $1 <++> ann $4 <** [$1,$3]}; +> return (TypeKindSig l names $4) } } + Requires the TypeFamilies extension enabled, but the lexer will handle that through the 'family' keyword. > | 'type' 'family' type opt_tyfam_kind_sig opt_injectivity_info where_type_family @@ -819,7 +830,7 @@ Parsing the body of a closed type family, partially stolen from the source of GH > | sigtype ',' sigtypes { ($1 : fst $3, $2 : snd $3) } > sigtype :: { Type L } -> : ctype {% checkType $ mkTyForall (ann $1) Nothing Nothing $1 } +> : ctype {% checkType $ mkTyForall (ann $1) Nothing InvisibleQuantification Nothing $1 } > name_boolformula :: { Maybe (BooleanFormula L) } > : name_boolformula1 { Just $1 } @@ -1086,9 +1097,13 @@ is any of the keyword-enabling ones, except ExistentialQuantification. > ctype :: { PType L } > : ctype_('*',NEVER) { $1 } +> quantvis :: { (QuantVisibility,S) } +> : '.' { (InvisibleQuantification, $1) } +> | '->' { (VisibleQuantification, $1) } + > ctype_(ostar,kstar) :: { PType L } -> : 'forall' ktyvars '.' ctype_(ostar,kstar) { mkTyForall (nIS $1 <++> ann $4 <** [$1,$3]) (Just (reverse (fst $2))) Nothing $4 } -> | context_(ostar,kstar) ctype_(ostar,kstar) { mkTyForall ($1 <> $2) Nothing (Just $1) $2 } +> : 'forall' ktyvars quantvis ctype_(ostar,kstar) { mkTyForall (nIS $1 <++> ann $4 <** [$1,snd $3]) (Just (reverse (fst $2))) (fst $3) Nothing $4 } +> | context_(ostar,kstar) ctype_(ostar,kstar) { mkTyForall ($1 <> $2) Nothing InvisibleQuantification (Just $1) $2 } > | type_(ostar,kstar) { $1 } Equality constraints require the TypeFamilies extension. diff --git a/src/Language/Haskell/Exts/ParseSyntax.hs b/src/Language/Haskell/Exts/ParseSyntax.hs index 4382258b..511b2e84 100644 --- a/src/Language/Haskell/Exts/ParseSyntax.hs +++ b/src/Language/Haskell/Exts/ParseSyntax.hs @@ -301,6 +301,7 @@ instance Annotated PContext where data PType l = TyForall l (Maybe [TyVarBind l]) + QuantVisibility (Maybe (PContext l)) (PType l) | TyStar l -- ^ @*@, the type of types @@ -326,7 +327,7 @@ data PType l instance Annotated PType where ann t = case t of - TyForall l _ _ _ -> l + TyForall l _ _ _ _ -> l TyStar l -> l TyFun l _ _ -> l TyTuple l _ _ -> l @@ -347,7 +348,7 @@ instance Annotated PType where TyWildCard l _ -> l TyQuasiQuote l _ _ -> l amap f t' = case t' of - TyForall l mtvs mcx t -> TyForall (f l) mtvs mcx t + TyForall l mtvs q mcx t -> TyForall (f l) mtvs q mcx t TyStar l -> TyStar (f l) TyFun l t1 t2 -> TyFun (f l) t1 t2 TyTuple l b ts -> TyTuple (f l) b ts diff --git a/src/Language/Haskell/Exts/ParseUtils.hs b/src/Language/Haskell/Exts/ParseUtils.hs index 5bbd090d..5ec5a297 100644 --- a/src/Language/Haskell/Exts/ParseUtils.hs +++ b/src/Language/Haskell/Exts/ParseUtils.hs @@ -298,7 +298,7 @@ checkAsst asst = checkDataHeader :: PType L -> P (Maybe (S.Context L), DeclHead L) -checkDataHeader (TyForall _ Nothing cs t) = do +checkDataHeader (TyForall _ Nothing _ cs t) = do dh <- checkSimple "data/newtype" t cs' <- checkContext cs return (cs',dh) @@ -307,7 +307,7 @@ checkDataHeader t = do return (Nothing,dh) checkClassHeader :: PType L -> P (Maybe (S.Context L), DeclHead L) -checkClassHeader (TyForall _ Nothing cs t) = do +checkClassHeader (TyForall _ Nothing _ cs t) = do checkMultiParam t dh <- checkSimple "class" t cs' <- checkSContext cs @@ -360,7 +360,7 @@ toTyVarBind (TyKind l (TyVar _ n) k) = KindedVar l n k checkInstHeader :: PType L -> P (InstRule L) checkInstHeader (TyParen l t) = checkInstHeader t >>= return . IParen l -checkInstHeader (TyForall l mtvs cs t) = do +checkInstHeader (TyForall l mtvs _ cs t) = do cs' <- checkSContext cs checkMultiParam t checkInsts (Just l) mtvs cs' t @@ -1084,14 +1084,14 @@ checkType t = checkT t False checkT :: PType L -> Bool -> P (S.Type L) checkT t simple = case t of - TyForall l Nothing cs pt -> do + TyForall l Nothing q cs pt -> do when simple $ checkEnabled ExplicitForAll ctxt <- checkContext cs - check1Type pt (S.TyForall l Nothing ctxt) - TyForall l tvs cs pt -> do + check1Type pt (S.TyForall l Nothing q ctxt) + TyForall l tvs q cs pt -> do checkEnabled ExplicitForAll ctxt <- checkContext cs - check1Type pt (S.TyForall l tvs ctxt) + check1Type pt (S.TyForall l tvs q ctxt) TyStar l -> return $ S.TyStar l TyFun l at rt -> check2Types at rt (S.TyFun l) TyTuple l b pts -> checkTypes pts >>= return . S.TyTuple l b @@ -1198,11 +1198,11 @@ mkDVar = intercalate "-" -- -- A valid type must have one for-all at the top of the type, or of the fn arg types -mkTyForall :: L -> Maybe [TyVarBind L] -> Maybe (PContext L) -> PType L -> PType L -mkTyForall l mtvs ctxt ty = +mkTyForall :: L -> Maybe [TyVarBind L] -> QuantVisibility -> Maybe (PContext L) -> PType L -> PType L +mkTyForall l mtvs qv ctxt ty = case (ctxt, ty) of - (Nothing, TyForall _ Nothing ctxt2 ty2) -> TyForall l mtvs ctxt2 ty2 - _ -> TyForall l mtvs ctxt ty + (Nothing, TyForall _ Nothing qv2 ctxt2 ty2) -> TyForall l mtvs qv2 ctxt2 ty2 + _ -> TyForall l mtvs qv ctxt ty -- Make a role annotation diff --git a/src/Language/Haskell/Exts/Pretty.hs b/src/Language/Haskell/Exts/Pretty.hs index 8d39a2df..38c2b94d 100644 --- a/src/Language/Haskell/Exts/Pretty.hs +++ b/src/Language/Haskell/Exts/Pretty.hs @@ -487,14 +487,17 @@ instance Pretty (Decl l) where mySep ((punctuate comma . map pretty $ nameList) ++ [text "::", pretty qualType]) + pretty (TypeKindSig _ ns qualType) = + mySep ([text "type"] ++ punctuate comma (map pretty ns) ++ [text "::", pretty qualType]) + -- Req can be ommitted if it is empty -- We must print prov if req is nonempty pretty (PatSynSig _ ns mtvs prov mtvs2 req t) = - let contexts = [maybePP pretty prov, ppForall mtvs2, maybePP pretty req] + let contexts = [maybePP pretty prov, ppForall mtvs2 InvisibleQuantification, maybePP pretty req] in mySep ( [text "pattern" ] ++ punctuate comma (map pretty ns) - ++ [ text "::", ppForall mtvs] ++ + ++ [ text "::", ppForall mtvs InvisibleQuantification] ++ contexts ++ [pretty t] ) @@ -578,7 +581,7 @@ instance Pretty (Decl l) where instance Pretty (InstRule l) where pretty (IRule _ tvs mctxt qn) = - mySep [ppForall tvs + mySep [ppForall tvs InvisibleQuantification , maybePP pretty mctxt, pretty qn] pretty (IParen _ ih) = parens (pretty ih) @@ -769,7 +772,7 @@ instance Pretty Tool where ------------------------- Data & Newtype Bodies ------------------------- instance Pretty (QualConDecl l) where pretty (QualConDecl _pos tvs ctxt con) = - myFsep [ppForall tvs, maybePP pretty ctxt, pretty con] + myFsep [ppForall tvs InvisibleQuantification, maybePP pretty ctxt, pretty con] instance Pretty (GadtDecl l) where pretty (GadtDecl _pos name tvs ctxt names ty) = @@ -777,7 +780,7 @@ instance Pretty (GadtDecl l) where Nothing -> myFsep [pretty name, text "::", pretty ty] Just ts' -> - myFsep [pretty name, text "::" , ppForall tvs, maybePP pretty ctxt, + myFsep [pretty name, text "::" , ppForall tvs InvisibleQuantification, maybePP pretty ctxt, braceList . map pretty $ ts', text "->", pretty ty] instance Pretty (ConDecl l) where @@ -850,8 +853,8 @@ prec_btype = 1 -- left argument of ->, prec_atype = 2 -- argument of type or data constructor, or of a class instance Pretty (Type l) where - prettyPrec p (TyForall _ mtvs ctxt htype) = parensIf (p > 0) $ - myFsep [ppForall mtvs, maybePP pretty ctxt, pretty htype] + prettyPrec p (TyForall _ mtvs q ctxt htype) = parensIf (p > 0) $ + myFsep [ppForall mtvs q, maybePP pretty ctxt, pretty htype] prettyPrec _ (TyStar _) = text "*" prettyPrec p (TyFun _ a b) = parensIf (p > 0) $ myFsep [ppBType a, text "->", pretty b] @@ -906,10 +909,14 @@ instance Pretty (TyVarBind l) where pretty (KindedVar _ var kind) = parens $ myFsep [pretty var, text "::", pretty kind] pretty (UnkindedVar _ var) = pretty var -ppForall :: Maybe [TyVarBind l] -> Doc -ppForall Nothing = empty -ppForall (Just []) = empty -ppForall (Just vs) = myFsep (text "forall" : map pretty vs ++ [char '.']) +ppForall :: Maybe [TyVarBind l] -> QuantVisibility -> Doc +ppForall Nothing _ = empty +ppForall (Just []) _ = empty +ppForall (Just vs) q = myFsep (text "forall" : map pretty vs ++ [ppQuantVisibility q]) + +ppQuantVisibility :: QuantVisibility -> Doc +ppQuantVisibility InvisibleQuantification = text "." +ppQuantVisibility VisibleQuantification = text " ->" ---------------------------- Kinds ---------------------------- @@ -1674,8 +1681,8 @@ instance SrcInfo loc => Pretty (P.PAsst loc) where pretty (P.ParenA _ a) = parens (pretty a) instance SrcInfo loc => Pretty (P.PType loc) where - prettyPrec p (P.TyForall _ mtvs ctxt htype) = parensIf (p > 0) $ - myFsep [ppForall mtvs, maybePP pretty ctxt, pretty htype] + prettyPrec p (P.TyForall _ mtvs q ctxt htype) = parensIf (p > 0) $ + myFsep [ppForall mtvs q, maybePP pretty ctxt, pretty htype] prettyPrec _ (P.TyStar _) = text "*" prettyPrec p (P.TyFun _ a b) = parensIf (p > 0) $ myFsep [prettyPrec prec_btype a, text "->", pretty b] diff --git a/src/Language/Haskell/Exts/Syntax.hs b/src/Language/Haskell/Exts/Syntax.hs index 2d46f832..4f8da1c7 100644 --- a/src/Language/Haskell/Exts/Syntax.hs +++ b/src/Language/Haskell/Exts/Syntax.hs @@ -65,7 +65,7 @@ module Language.Haskell.Exts.Syntax ( -- * Class Assertions and Contexts Context(..), FunDep(..), Asst(..), -- * Types - Type(..), Boxed(..), Kind, TyVarBind(..), Promoted(..), + Type(..), Boxed(..), QuantVisibility(..), Kind, TyVarBind(..), Promoted(..), TypeEqn (..), -- * Expressions Exp(..), Stmt(..), QualStmt(..), FieldUpdate(..), @@ -303,6 +303,8 @@ data Decl l -- ^ A typed Template Haskell splicing declaration | TypeSig l [Name l] (Type l) -- ^ A type signature declaration + | TypeKindSig l [Name l] (Type l) + -- ^ A stand-alone kind signature declaration of one or more type | PatSynSig l [Name l] (Maybe [TyVarBind l]) (Maybe (Context l)) (Maybe [TyVarBind l]) (Maybe (Context l)) (Type l) @@ -629,6 +631,7 @@ data GuardedRhs l data Type l = TyForall l (Maybe [TyVarBind l]) + QuantVisibility (Maybe (Context l)) (Type l) -- ^ qualified type | TyStar l -- ^ @*@, the type of types @@ -670,6 +673,11 @@ data Promoted l data Boxed = Boxed | Unboxed deriving (Eq,Ord,Show,Typeable,Data,Generic) +data QuantVisibility + = InvisibleQuantification + | VisibleQuantification + deriving (Eq,Ord,Show,Typeable,Data,Generic) + -- | A type variable declaration, optionally with an explicit kind annotation. data TyVarBind l = KindedVar l (Name l) (Kind l) -- ^ variable binding with kind annotation @@ -1291,6 +1299,7 @@ instance Annotated Decl where SpliceDecl l _ -> l TSpliceDecl l _ -> l TypeSig l _ _ -> l + TypeKindSig l _ _ -> l PatSynSig l _ _ _ _ _ _ -> l FunBind l _ -> l PatBind l _ _ _ -> l @@ -1329,6 +1338,7 @@ instance Annotated Decl where SpliceDecl l sp -> SpliceDecl (f l) sp TSpliceDecl l sp -> TSpliceDecl (f l) sp TypeSig l ns t -> TypeSig (f l) ns t + TypeKindSig l ns t -> TypeKindSig (f l) ns t PatSynSig l n dh c1 dh2 c2 t -> PatSynSig (f l) n dh c1 dh2 c2 t FunBind l ms -> FunBind (f l) ms PatBind l p rhs bs -> PatBind (f l) p rhs bs @@ -1501,7 +1511,7 @@ instance Annotated GuardedRhs where instance Annotated Type where ann t = case t of - TyForall l _ _ _ -> l + TyForall l _ _ _ _ -> l TyStar l -> l TyFun l _ _ -> l TyTuple l _ _ -> l @@ -1521,7 +1531,7 @@ instance Annotated Type where TyWildCard l _ -> l TyQuasiQuote l _ _ -> l amap f t1 = case t1 of - TyForall l mtvs mcx t -> TyForall (f l) mtvs mcx t + TyForall l mtvs q mcx t -> TyForall (f l) mtvs q mcx t TyStar l -> TyStar (f l) TyFun l t1' t2 -> TyFun (f l) t1' t2 TyTuple l b ts -> TyTuple (f l) b ts diff --git a/tests/examples/ClassContext.hs.parser.golden b/tests/examples/ClassContext.hs.parser.golden index cfb9e255..bc13a961 100644 --- a/tests/examples/ClassContext.hs.parser.golden +++ b/tests/examples/ClassContext.hs.parser.golden @@ -33,6 +33,7 @@ ParseOk , srcInfoPoints = [] } Nothing + InvisibleQuantification (Just (CxSingle SrcSpanInfo diff --git a/tests/examples/ConstraintKinds.hs.parser.golden b/tests/examples/ConstraintKinds.hs.parser.golden index ac4b94ea..93f81ce6 100644 --- a/tests/examples/ConstraintKinds.hs.parser.golden +++ b/tests/examples/ConstraintKinds.hs.parser.golden @@ -334,6 +334,7 @@ ParseOk , srcInfoPoints = [] } Nothing + InvisibleQuantification (Just (CxSingle SrcSpanInfo diff --git a/tests/examples/ConstraintKinds2.hs.parser.golden b/tests/examples/ConstraintKinds2.hs.parser.golden index 5d27fa59..c2287cba 100644 --- a/tests/examples/ConstraintKinds2.hs.parser.golden +++ b/tests/examples/ConstraintKinds2.hs.parser.golden @@ -142,6 +142,7 @@ ParseOk , srcInfoPoints = [] } Nothing + InvisibleQuantification (Just (CxSingle SrcSpanInfo diff --git a/tests/examples/ConstraintKinds3.hs.parser.golden b/tests/examples/ConstraintKinds3.hs.parser.golden index a48904a8..51cbf5a3 100644 --- a/tests/examples/ConstraintKinds3.hs.parser.golden +++ b/tests/examples/ConstraintKinds3.hs.parser.golden @@ -144,6 +144,7 @@ ParseOk , srcInfoPoints = [] } Nothing + InvisibleQuantification (Just (CxSingle SrcSpanInfo diff --git a/tests/examples/ConstructorAndClassOperators.hs.parser.golden b/tests/examples/ConstructorAndClassOperators.hs.parser.golden index e94eeac4..d09e24fa 100644 --- a/tests/examples/ConstructorAndClassOperators.hs.parser.golden +++ b/tests/examples/ConstructorAndClassOperators.hs.parser.golden @@ -66,6 +66,7 @@ ParseOk , srcInfoPoints = [] } Nothing + InvisibleQuantification (Just (CxSingle SrcSpanInfo diff --git a/tests/examples/ContextOrdering.hs.parser.golden b/tests/examples/ContextOrdering.hs.parser.golden index 827d8b43..e0bdea11 100644 --- a/tests/examples/ContextOrdering.hs.parser.golden +++ b/tests/examples/ContextOrdering.hs.parser.golden @@ -71,6 +71,7 @@ ParseOk , srcInfoPoints = [] } Nothing + InvisibleQuantification (Just (CxSingle SrcSpanInfo diff --git a/tests/examples/DefaultSignatures.hs.parser.golden b/tests/examples/DefaultSignatures.hs.parser.golden index 57a25827..36d6f615 100644 --- a/tests/examples/DefaultSignatures.hs.parser.golden +++ b/tests/examples/DefaultSignatures.hs.parser.golden @@ -184,6 +184,7 @@ ParseOk , srcInfoPoints = [] } Nothing + InvisibleQuantification (Just (CxSingle SrcSpanInfo diff --git a/tests/examples/DerivingVia.hs.parser.golden b/tests/examples/DerivingVia.hs.parser.golden index 9e41f72a..96a4ee7b 100644 --- a/tests/examples/DerivingVia.hs.parser.golden +++ b/tests/examples/DerivingVia.hs.parser.golden @@ -795,6 +795,7 @@ ParseOk } "xx") ]) + InvisibleQuantification Nothing (TyFun SrcSpanInfo @@ -2283,6 +2284,7 @@ ParseOk , srcInfoPoints = [] } Nothing + InvisibleQuantification (Just (CxSingle SrcSpanInfo @@ -2425,6 +2427,7 @@ ParseOk , srcInfoPoints = [] } Nothing + InvisibleQuantification (Just (CxSingle SrcSpanInfo @@ -2538,6 +2541,7 @@ ParseOk , srcInfoPoints = [] } Nothing + InvisibleQuantification (Just (CxSingle SrcSpanInfo @@ -2583,6 +2587,7 @@ ParseOk , srcInfoPoints = [] } Nothing + InvisibleQuantification (Just (CxSingle SrcSpanInfo @@ -3942,6 +3947,7 @@ ParseOk } "m") ]) + InvisibleQuantification Nothing (TyInfix SrcSpanInfo @@ -5437,6 +5443,7 @@ ParseOk , srcInfoPoints = [] } Nothing + InvisibleQuantification (Just (CxSingle SrcSpanInfo @@ -5801,6 +5808,7 @@ ParseOk , srcInfoPoints = [] } Nothing + InvisibleQuantification (Just (CxSingle SrcSpanInfo @@ -6406,6 +6414,7 @@ ParseOk , srcInfoPoints = [] } Nothing + InvisibleQuantification (Just (CxSingle SrcSpanInfo @@ -7011,6 +7020,7 @@ ParseOk , srcInfoPoints = [] } Nothing + InvisibleQuantification (Just (CxSingle SrcSpanInfo @@ -8201,6 +8211,7 @@ ParseOk } "m") ]) + InvisibleQuantification (Just (CxSingle SrcSpanInfo @@ -8922,6 +8933,7 @@ ParseOk } "m'") ]) + InvisibleQuantification (Just (CxSingle SrcSpanInfo @@ -25754,6 +25766,7 @@ ParseOk , srcInfoPoints = [] } Nothing + InvisibleQuantification (Just (CxSingle SrcSpanInfo @@ -25875,6 +25888,7 @@ ParseOk , srcInfoPoints = [] } Nothing + InvisibleQuantification (Just (CxSingle SrcSpanInfo @@ -26161,6 +26175,7 @@ ParseOk , srcInfoPoints = [] } Nothing + InvisibleQuantification (Just (CxSingle SrcSpanInfo @@ -29455,6 +29470,7 @@ ParseOk , srcInfoPoints = [] } Nothing + InvisibleQuantification (Just (CxSingle SrcSpanInfo @@ -29680,6 +29696,7 @@ ParseOk , srcInfoPoints = [] } Nothing + InvisibleQuantification (Just (CxSingle SrcSpanInfo @@ -29905,6 +29922,7 @@ ParseOk , srcInfoPoints = [] } Nothing + InvisibleQuantification (Just (CxSingle SrcSpanInfo diff --git a/tests/examples/DerivingVia2.hs.parser.golden b/tests/examples/DerivingVia2.hs.parser.golden index 20c06b05..3bece653 100644 --- a/tests/examples/DerivingVia2.hs.parser.golden +++ b/tests/examples/DerivingVia2.hs.parser.golden @@ -1819,6 +1819,7 @@ ParseOk } "a") ]) + InvisibleQuantification Nothing (TyApp SrcSpanInfo @@ -2185,6 +2186,7 @@ ParseOk } "a") ]) + InvisibleQuantification Nothing (TyApp SrcSpanInfo diff --git a/tests/examples/Directory.hs.parser.golden b/tests/examples/Directory.hs.parser.golden index fdfd53ed..1257a078 100644 --- a/tests/examples/Directory.hs.parser.golden +++ b/tests/examples/Directory.hs.parser.golden @@ -25148,6 +25148,7 @@ ParseOk , srcInfoPoints = [] } Nothing + InvisibleQuantification (Just (CxSingle SrcSpanInfo diff --git a/tests/examples/EmptyContext.hs.parser.golden b/tests/examples/EmptyContext.hs.parser.golden index 2ae325e4..008ff7b3 100644 --- a/tests/examples/EmptyContext.hs.parser.golden +++ b/tests/examples/EmptyContext.hs.parser.golden @@ -32,6 +32,7 @@ ParseOk , srcInfoPoints = [] } Nothing + InvisibleQuantification (Just (CxEmpty SrcSpanInfo diff --git a/tests/examples/EqualityConstraints1.hs.parser.golden b/tests/examples/EqualityConstraints1.hs.parser.golden index e6cadb17..e605bb76 100644 --- a/tests/examples/EqualityConstraints1.hs.parser.golden +++ b/tests/examples/EqualityConstraints1.hs.parser.golden @@ -55,6 +55,7 @@ ParseOk , srcInfoPoints = [] } Nothing + InvisibleQuantification (Just (CxSingle SrcSpanInfo diff --git a/tests/examples/Fixity3.hs.parser.golden b/tests/examples/Fixity3.hs.parser.golden index 536fdcd8..a60210f5 100644 --- a/tests/examples/Fixity3.hs.parser.golden +++ b/tests/examples/Fixity3.hs.parser.golden @@ -82,6 +82,7 @@ ParseOk , srcInfoPoints = [] } Nothing + InvisibleQuantification (Just (CxSingle SrcSpanInfo diff --git a/tests/examples/FlexibleContextsWithoutVars.hs.parser.golden b/tests/examples/FlexibleContextsWithoutVars.hs.parser.golden index 0ba4d9ef..b607e01f 100644 --- a/tests/examples/FlexibleContextsWithoutVars.hs.parser.golden +++ b/tests/examples/FlexibleContextsWithoutVars.hs.parser.golden @@ -55,6 +55,7 @@ ParseOk , srcInfoPoints = [] } Nothing + InvisibleQuantification (Just (CxSingle SrcSpanInfo diff --git a/tests/examples/GenericTree.hs.parser.golden b/tests/examples/GenericTree.hs.parser.golden index 25912007..59a64745 100644 --- a/tests/examples/GenericTree.hs.parser.golden +++ b/tests/examples/GenericTree.hs.parser.golden @@ -87,6 +87,7 @@ ParseOk , srcInfoPoints = [] } Nothing + InvisibleQuantification (Just (CxSingle SrcSpanInfo @@ -210,6 +211,7 @@ ParseOk } "b") ]) + InvisibleQuantification (Just (CxSingle SrcSpanInfo diff --git a/tests/examples/InfixTypeMinus.hs.parser.golden b/tests/examples/InfixTypeMinus.hs.parser.golden index 91897f67..835bd6bc 100644 --- a/tests/examples/InfixTypeMinus.hs.parser.golden +++ b/tests/examples/InfixTypeMinus.hs.parser.golden @@ -165,6 +165,7 @@ ParseOk , srcInfoPoints = [] } Nothing + InvisibleQuantification (Just (CxSingle SrcSpanInfo @@ -481,6 +482,7 @@ ParseOk , srcInfoPoints = [] } Nothing + InvisibleQuantification (Just (CxSingle SrcSpanInfo @@ -797,6 +799,7 @@ ParseOk , srcInfoPoints = [] } Nothing + InvisibleQuantification (Just (CxSingle SrcSpanInfo @@ -1113,6 +1116,7 @@ ParseOk , srcInfoPoints = [] } Nothing + InvisibleQuantification (Just (CxSingle SrcSpanInfo diff --git a/tests/examples/InjectiveTypeFamilies.hs.parser.golden b/tests/examples/InjectiveTypeFamilies.hs.parser.golden index 3e051555..80f71215 100644 --- a/tests/examples/InjectiveTypeFamilies.hs.parser.golden +++ b/tests/examples/InjectiveTypeFamilies.hs.parser.golden @@ -15446,6 +15446,7 @@ ParseOk } "a") ]) + InvisibleQuantification (Just (CxSingle SrcSpanInfo diff --git a/tests/examples/MultiCtxt.hs.parser.golden b/tests/examples/MultiCtxt.hs.parser.golden index d0a03a9c..2d9a7a8b 100644 --- a/tests/examples/MultiCtxt.hs.parser.golden +++ b/tests/examples/MultiCtxt.hs.parser.golden @@ -65,6 +65,7 @@ ParseOk , srcInfoPoints = [] } Nothing + InvisibleQuantification (Just (CxSingle SrcSpanInfo @@ -126,6 +127,7 @@ ParseOk , srcInfoPoints = [] } Nothing + InvisibleQuantification (Just (CxSingle SrcSpanInfo diff --git a/tests/examples/MultiParam.hs.parser.golden b/tests/examples/MultiParam.hs.parser.golden index 39a0a1c2..31df49b6 100644 --- a/tests/examples/MultiParam.hs.parser.golden +++ b/tests/examples/MultiParam.hs.parser.golden @@ -49,6 +49,7 @@ ParseOk , srcInfoPoints = [] } Nothing + InvisibleQuantification (Just (CxSingle SrcSpanInfo diff --git a/tests/examples/OverloadedLabels.hs.parser.golden b/tests/examples/OverloadedLabels.hs.parser.golden index 220fade2..72e6e9fe 100644 --- a/tests/examples/OverloadedLabels.hs.parser.golden +++ b/tests/examples/OverloadedLabels.hs.parser.golden @@ -417,6 +417,7 @@ ParseOk , srcInfoPoints = [] } Nothing + InvisibleQuantification (Just (CxSingle SrcSpanInfo diff --git a/tests/examples/PartialSignatures.hs.parser.golden b/tests/examples/PartialSignatures.hs.parser.golden index 4ad912c1..d1a7510c 100644 --- a/tests/examples/PartialSignatures.hs.parser.golden +++ b/tests/examples/PartialSignatures.hs.parser.golden @@ -4016,6 +4016,7 @@ ParseOk , srcInfoPoints = [] } Nothing + InvisibleQuantification (Just (CxSingle SrcSpanInfo @@ -4109,6 +4110,7 @@ ParseOk , srcInfoPoints = [] } Nothing + InvisibleQuantification (Just (CxSingle SrcSpanInfo @@ -4448,6 +4450,7 @@ ParseOk , srcInfoPoints = [] } Nothing + InvisibleQuantification (Just (CxSingle SrcSpanInfo @@ -5784,6 +5787,7 @@ ParseOk , srcInfoPoints = [] } Nothing + InvisibleQuantification (Just (CxSingle SrcSpanInfo @@ -6115,6 +6119,7 @@ ParseOk , srcInfoPoints = [] } Nothing + InvisibleQuantification (Just (CxTuple SrcSpanInfo @@ -6332,6 +6337,7 @@ ParseOk , srcInfoPoints = [] } Nothing + InvisibleQuantification (Just (CxTuple SrcSpanInfo @@ -6594,6 +6600,7 @@ ParseOk , srcInfoPoints = [] } Nothing + InvisibleQuantification (Just (CxTuple SrcSpanInfo @@ -6811,6 +6818,7 @@ ParseOk , srcInfoPoints = [] } Nothing + InvisibleQuantification (Just (CxTuple SrcSpanInfo @@ -7118,6 +7126,7 @@ ParseOk , srcInfoPoints = [] } Nothing + InvisibleQuantification (Just (CxSingle SrcSpanInfo @@ -7223,6 +7232,7 @@ ParseOk , srcInfoPoints = [] } Nothing + InvisibleQuantification (Just (CxSingle SrcSpanInfo @@ -7322,6 +7332,7 @@ ParseOk , srcInfoPoints = [] } Nothing + InvisibleQuantification (Just (CxSingle SrcSpanInfo @@ -7438,6 +7449,7 @@ ParseOk } "a") ]) + InvisibleQuantification Nothing (TyFun SrcSpanInfo @@ -7718,6 +7730,7 @@ ParseOk } "a") ]) + InvisibleQuantification Nothing (TyFun SrcSpanInfo @@ -8026,6 +8039,7 @@ ParseOk } "a") ]) + InvisibleQuantification Nothing (TyFun SrcSpanInfo @@ -8350,6 +8364,7 @@ ParseOk } "a") ]) + InvisibleQuantification Nothing (TyFun SrcSpanInfo @@ -9993,6 +10008,7 @@ ParseOk } "a") ]) + InvisibleQuantification Nothing (TyFun SrcSpanInfo @@ -10670,6 +10686,7 @@ ParseOk , srcInfoPoints = [] } Nothing + InvisibleQuantification (Just (CxSingle SrcSpanInfo @@ -12503,6 +12520,7 @@ ParseOk , srcInfoPoints = [] } Nothing + InvisibleQuantification (Just (CxSingle SrcSpanInfo @@ -13305,6 +13323,7 @@ ParseOk , srcInfoPoints = [] } Nothing + InvisibleQuantification (Just (CxSingle SrcSpanInfo @@ -14391,6 +14410,7 @@ ParseOk , srcInfoPoints = [] } Nothing + InvisibleQuantification (Just (CxSingle SrcSpanInfo @@ -16258,6 +16278,7 @@ ParseOk , srcInfoPoints = [] } Nothing + InvisibleQuantification (Just (CxTuple SrcSpanInfo diff --git a/tests/examples/PatternSynonyms3.hs.parser.golden b/tests/examples/PatternSynonyms3.hs.parser.golden index 1aa5596f..470ff001 100644 --- a/tests/examples/PatternSynonyms3.hs.parser.golden +++ b/tests/examples/PatternSynonyms3.hs.parser.golden @@ -798,6 +798,7 @@ ParseOk , srcInfoPoints = [] } Nothing + InvisibleQuantification (Just (CxSingle SrcSpanInfo @@ -1196,6 +1197,7 @@ ParseOk , srcInfoPoints = [] } Nothing + InvisibleQuantification (Just (CxSingle SrcSpanInfo diff --git a/tests/examples/QuantifiedConstraints.hs.parser.golden b/tests/examples/QuantifiedConstraints.hs.parser.golden index 8f5e9540..1103c2a5 100644 --- a/tests/examples/QuantifiedConstraints.hs.parser.golden +++ b/tests/examples/QuantifiedConstraints.hs.parser.golden @@ -111,6 +111,7 @@ ParseOk } "a") ]) + InvisibleQuantification Nothing (TyApp SrcSpanInfo diff --git a/tests/examples/QuasiQuoteSplice.hs.parser.golden b/tests/examples/QuasiQuoteSplice.hs.parser.golden index 72864aa9..fc063f7a 100644 --- a/tests/examples/QuasiQuoteSplice.hs.parser.golden +++ b/tests/examples/QuasiQuoteSplice.hs.parser.golden @@ -351,6 +351,7 @@ ParseOk } "m") ]) + InvisibleQuantification Nothing (TyApp SrcSpanInfo diff --git a/tests/examples/RCategory.hs.parser.golden b/tests/examples/RCategory.hs.parser.golden index 06d3c3e1..ac99f12d 100644 --- a/tests/examples/RCategory.hs.parser.golden +++ b/tests/examples/RCategory.hs.parser.golden @@ -328,6 +328,7 @@ ParseOk , srcInfoPoints = [] } Nothing + InvisibleQuantification (Just (CxSingle SrcSpanInfo @@ -498,6 +499,7 @@ ParseOk , srcInfoPoints = [] } Nothing + InvisibleQuantification (Just (CxTuple SrcSpanInfo @@ -1440,6 +1442,7 @@ ParseOk , srcInfoPoints = [] } Nothing + InvisibleQuantification (Just (CxTuple SrcSpanInfo @@ -1932,6 +1935,7 @@ ParseOk , srcInfoPoints = [] } Nothing + InvisibleQuantification (Just (CxTuple SrcSpanInfo diff --git a/tests/examples/Rules.hs.parser.golden b/tests/examples/Rules.hs.parser.golden index da40d5d6..61221611 100644 --- a/tests/examples/Rules.hs.parser.golden +++ b/tests/examples/Rules.hs.parser.golden @@ -70,6 +70,7 @@ ParseOk } "b") ]) + InvisibleQuantification Nothing (TyFun SrcSpanInfo diff --git a/tests/examples/ScopedTypeVariables.hs.parser.golden b/tests/examples/ScopedTypeVariables.hs.parser.golden index c2c5a489..f6e72622 100644 --- a/tests/examples/ScopedTypeVariables.hs.parser.golden +++ b/tests/examples/ScopedTypeVariables.hs.parser.golden @@ -355,6 +355,7 @@ ParseOk } "x") ]) + InvisibleQuantification (Just (CxSingle SrcSpanInfo diff --git a/tests/examples/SingleClassAsst.hs.parser.golden b/tests/examples/SingleClassAsst.hs.parser.golden index adeaec50..47dd49de 100644 --- a/tests/examples/SingleClassAsst.hs.parser.golden +++ b/tests/examples/SingleClassAsst.hs.parser.golden @@ -53,6 +53,7 @@ ParseOk , srcInfoPoints = [] } Nothing + InvisibleQuantification (Just (CxSingle SrcSpanInfo diff --git a/tests/examples/SpecializePhaseControl.hs.parser.golden b/tests/examples/SpecializePhaseControl.hs.parser.golden index 569cc80b..25b21227 100644 --- a/tests/examples/SpecializePhaseControl.hs.parser.golden +++ b/tests/examples/SpecializePhaseControl.hs.parser.golden @@ -64,6 +64,7 @@ ParseOk [ SrcSpan "tests/examples/SpecializePhaseControl.hs" 2 17 2 19 ] } Nothing + InvisibleQuantification Nothing (TyFun SrcSpanInfo @@ -144,6 +145,7 @@ ParseOk [ SrcSpan "tests/examples/SpecializePhaseControl.hs" 3 17 3 19 ] } Nothing + InvisibleQuantification Nothing (TyFun SrcSpanInfo @@ -224,6 +226,7 @@ ParseOk [ SrcSpan "tests/examples/SpecializePhaseControl.hs" 4 13 4 15 ] } Nothing + InvisibleQuantification Nothing (TyFun SrcSpanInfo @@ -319,6 +322,7 @@ ParseOk , srcInfoPoints = [] } Nothing + InvisibleQuantification (Just (CxTuple SrcSpanInfo @@ -566,6 +570,7 @@ ParseOk [ SrcSpan "tests/examples/SpecializePhaseControl.hs" 10 17 10 19 ] } Nothing + InvisibleQuantification Nothing (TyFun SrcSpanInfo @@ -646,6 +651,7 @@ ParseOk [ SrcSpan "tests/examples/SpecializePhaseControl.hs" 11 17 11 19 ] } Nothing + InvisibleQuantification Nothing (TyFun SrcSpanInfo @@ -726,6 +732,7 @@ ParseOk [ SrcSpan "tests/examples/SpecializePhaseControl.hs" 12 13 12 15 ] } Nothing + InvisibleQuantification Nothing (TyFun SrcSpanInfo @@ -821,6 +828,7 @@ ParseOk , srcInfoPoints = [] } Nothing + InvisibleQuantification (Just (CxTuple SrcSpanInfo diff --git a/tests/examples/TypeEqualityParen.hs.parser.golden b/tests/examples/TypeEqualityParen.hs.parser.golden index 7af50542..1ac9551f 100644 --- a/tests/examples/TypeEqualityParen.hs.parser.golden +++ b/tests/examples/TypeEqualityParen.hs.parser.golden @@ -55,6 +55,7 @@ ParseOk , srcInfoPoints = [] } Nothing + InvisibleQuantification (Just (CxTuple SrcSpanInfo diff --git a/tests/examples/TypeOperatorsTest.hs.parser.golden b/tests/examples/TypeOperatorsTest.hs.parser.golden index 215ed48a..9d8dbbe9 100644 --- a/tests/examples/TypeOperatorsTest.hs.parser.golden +++ b/tests/examples/TypeOperatorsTest.hs.parser.golden @@ -71,6 +71,7 @@ ParseOk , srcInfoPoints = [] } Nothing + InvisibleQuantification (Just (CxSingle SrcSpanInfo diff --git a/tests/examples/Unicode.hs.parser.golden b/tests/examples/Unicode.hs.parser.golden index 719aa81d..0a9c12e9 100644 --- a/tests/examples/Unicode.hs.parser.golden +++ b/tests/examples/Unicode.hs.parser.golden @@ -3737,6 +3737,7 @@ ParseOk , srcInfoPoints = [] } Nothing + InvisibleQuantification (Just (CxTuple SrcSpanInfo diff --git a/tests/examples/UnicodeSyntax.hs.parser.golden b/tests/examples/UnicodeSyntax.hs.parser.golden index 0d0d947c..23a6de46 100644 --- a/tests/examples/UnicodeSyntax.hs.parser.golden +++ b/tests/examples/UnicodeSyntax.hs.parser.golden @@ -581,6 +581,7 @@ ParseOk } "a") ]) + InvisibleQuantification Nothing (TyFun SrcSpanInfo diff --git a/tests/examples/Vta1.hs.parser.golden b/tests/examples/Vta1.hs.parser.golden index ead7eb2f..79254474 100644 --- a/tests/examples/Vta1.hs.parser.golden +++ b/tests/examples/Vta1.hs.parser.golden @@ -2159,6 +2159,7 @@ ParseOk } "b") ]) + InvisibleQuantification Nothing (TyFun SrcSpanInfo @@ -2194,6 +2195,7 @@ ParseOk } "a") ]) + InvisibleQuantification Nothing (TyFun SrcSpanInfo @@ -2587,6 +2589,7 @@ ParseOk } "a") ]) + InvisibleQuantification Nothing (TyFun SrcSpanInfo @@ -2633,6 +2636,7 @@ ParseOk } "b") ]) + InvisibleQuantification Nothing (TyFun SrcSpanInfo @@ -3146,6 +3150,7 @@ ParseOk } "a") ]) + InvisibleQuantification (Just (CxSingle SrcSpanInfo @@ -3210,6 +3215,7 @@ ParseOk } "b") ]) + InvisibleQuantification Nothing (TyFun SrcSpanInfo @@ -3420,6 +3426,7 @@ ParseOk } "a") ]) + InvisibleQuantification (Just (CxSingle SrcSpanInfo @@ -3498,6 +3505,7 @@ ParseOk } "b") ]) + InvisibleQuantification Nothing (TyFun SrcSpanInfo @@ -4865,6 +4873,7 @@ ParseOk } "a") ]) + InvisibleQuantification (Just (CxSingle SrcSpanInfo @@ -5147,6 +5156,7 @@ ParseOk , srcInfoPoints = [] })) ]) + InvisibleQuantification Nothing (TyFun SrcSpanInfo diff --git a/tests/examples/Vta2.hs.parser.golden b/tests/examples/Vta2.hs.parser.golden index b3905aea..9fe64ba4 100644 --- a/tests/examples/Vta2.hs.parser.golden +++ b/tests/examples/Vta2.hs.parser.golden @@ -122,6 +122,7 @@ ParseOk } "a") ]) + InvisibleQuantification Nothing (TyFun SrcSpanInfo @@ -546,6 +547,7 @@ ParseOk } "a") ]) + InvisibleQuantification Nothing (TyFun SrcSpanInfo