Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC

Commits:

14 changed files:

Changes:

  • compiler/GHC/Core/Class.hs
    ... ... @@ -41,6 +41,7 @@ import GHC.Utils.Panic
    41 41 
     import GHC.Types.SrcLoc
    42 42 
     import GHC.Types.Var.Set
    43 43 
     import GHC.Utils.Outputable
    44 
    +import GHC.Data.BooleanFormula () -- for BooleanFormulaDefault instance
    44 45 
     import Language.Haskell.Syntax.BooleanFormula ( BooleanFormula, mkTrue )
    45 46
    46 47 
     import qualified Data.Data as Data

  • compiler/GHC/CoreToIface.hs
    ... ... @@ -542,10 +542,11 @@ toIfGuidance src guidance
    542 542 
     toIfaceBooleanFormula :: BF.BooleanFormula GhcRn -> IfaceBooleanFormula
    543 543 
     toIfaceBooleanFormula = go
    544 544 
       where
    545 
    -    go (BF.Var nm   ) = IfVar    $ mkIfLclName . getOccFS . unLoc $  nm
    546 
    -    go (BF.And bfs  ) = IfAnd    $ map (go . unLoc) bfs
    547 
    -    go (BF.Or bfs   ) = IfOr     $ map (go . unLoc) bfs
    548 
    -    go (BF.Parens bf) = IfParens $     (go . unLoc) bf
    545 
    +    go (BF.Var _ nm   ) = IfVar    $ mkIfLclName . getOccFS . unLoc $  nm
    546 
    +    go (BF.And _ bfs  ) = IfAnd    $ map (go . unLoc) bfs
    547 
    +    go (BF.Or _ bfs   ) = IfOr     $ map (go . unLoc) bfs
    548 
    +    go (BF.Parens _ bf) = IfParens $     (go . unLoc) bf
    549 
    +    go (BF.XBooleanFormula _) = panic "toIfaceBooleanFormula"
    549 550
    550 551 
     {-
    551 552 
     ************************************************************************

  • compiler/GHC/Data/BooleanFormula.hs
    ... ... @@ -27,7 +27,10 @@ import GHC.Types.SrcLoc (unLoc)
    27 27 
     import GHC.Utils.Outputable
    28 28 
     import GHC.Parser.Annotation ( SrcSpanAnnBF )
    29 29 
     import GHC.Hs.Extension (GhcPass (..), OutputableBndrId)
    30 
    -import Language.Haskell.Syntax.Extension (Anno, LIdP, IdP)
    30 
    +import Language.Haskell.Syntax.Extension (Anno, LIdP, IdP,
    31 
    +                                          noExtField, NoExtField, DataConCantHappen,
    32 
    +                                          XBFVar, XBFAnd, XBFOr, XBFParens,
    33 
    +                                          XXBooleanFormula)
    31 34 
     import Language.Haskell.Syntax.BooleanFormula
    32 35
    33 36
    ... ... @@ -37,6 +40,17 @@ import Language.Haskell.Syntax.BooleanFormula
    37 40
    38 41 
     type instance Anno (BooleanFormula (GhcPass p)) = SrcSpanAnnBF
    39 42
    43 
    +type instance XBFVar           (GhcPass _) = NoExtField
    44 
    +type instance XBFAnd           (GhcPass _) = NoExtField
    45 
    +type instance XBFOr            (GhcPass _) = NoExtField
    46 
    +type instance XBFParens        (GhcPass _) = NoExtField
    47 
    +type instance XXBooleanFormula (GhcPass _) = DataConCantHappen
    48 
    +
    49 
    +instance BooleanFormulaDefault (GhcPass p) where
    50 
    +  bfAnnAnd = noExtField
    51 
    +  bfAnnOr = noExtField
    52 
    +
    53 
    +
    40 54 
     -- if we had Functor/Traversable (LbooleanFormula p) we could use that
    41 55 
     -- as a constraint and we wouldn't need to specialize to just GhcPass p,
    42 56 
     -- but becuase LBooleanFormula is a type synonym such a constraint is
    ... ... @@ -49,10 +63,10 @@ bfMap :: (LIdP (GhcPass p) -> LIdP (GhcPass p'))
    49 63 
           -> BooleanFormula (GhcPass p) -> BooleanFormula (GhcPass p')
    50 64 
     bfMap f = go
    51 65 
       where
    52 
    -    go (Var    a  ) = Var     $ f a
    53 
    -    go (And    bfs) = And     $ map (fmap go) bfs
    54 
    -    go (Or     bfs) = Or      $ map (fmap go) bfs
    55 
    -    go (Parens bf ) = Parens  $ fmap go bf
    66 
    +    go (Var    x a  ) = Var    x $ f a
    67 
    +    go (And    x bfs) = And    x $ map (fmap go) bfs
    68 
    +    go (Or     x bfs) = Or     x $ map (fmap go) bfs
    69 
    +    go (Parens x bf ) = Parens x $ fmap go bf
    56 70
    57 71 
     bfTraverse  :: Applicative f
    58 72 
                 => (LIdP (GhcPass p) -> f (LIdP (GhcPass p')))
    ... ... @@ -60,10 +74,10 @@ bfTraverse :: Applicative f
    60 74 
                 -> f (BooleanFormula (GhcPass p'))
    61 75 
     bfTraverse f = go
    62 76 
       where
    63 
    -    go (Var    a  ) = Var    <$> f a
    64 
    -    go (And    bfs) = And    <$> traverse @[] (traverse go) bfs
    65 
    -    go (Or     bfs) = Or     <$> traverse @[] (traverse go) bfs
    66 
    -    go (Parens bf ) = Parens <$> traverse go bf
    77 
    +    go (Var    x a  ) = Var    x <$> f a
    78 
    +    go (And    x bfs) = And    x <$> traverse @[] (traverse go) bfs
    79 
    +    go (Or     x bfs) = Or     x <$> traverse @[] (traverse go) bfs
    80 
    +    go (Parens x bf ) = Parens x <$> traverse go bf
    67 81
    68 82
    69 83
    ... ... @@ -106,18 +120,18 @@ We don't show a ridiculous error message like
    106 120 
     ----------------------------------------------------------------------
    107 121
    108 122 
     isFalse :: BooleanFormula (GhcPass p) -> Bool
    109 
    -isFalse (Or []) = True
    123 
    +isFalse (Or _ []) = True
    110 124 
     isFalse _ = False
    111 125
    112 126 
     isTrue :: BooleanFormula (GhcPass p) -> Bool
    113 
    -isTrue (And []) = True
    127 
    +isTrue (And _ []) = True
    114 128 
     isTrue _ = False
    115 129
    116 130 
     eval :: (LIdP (GhcPass p) -> Bool) -> BooleanFormula (GhcPass p) -> Bool
    117 
    -eval f (Var x)  = f x
    118 
    -eval f (And xs) = all (eval f . unLoc) xs
    119 
    -eval f (Or xs)  = any (eval f . unLoc) xs
    120 
    -eval f (Parens x) = eval f (unLoc x)
    131 
    +eval f (Var _ x)    = f x
    132 
    +eval f (And _ xs)   = all (eval f . unLoc) xs
    133 
    +eval f (Or  _ xs)   = any (eval f . unLoc) xs
    134 
    +eval f (Parens _ x) = eval f (unLoc x)
    121 135
    122 136 
     -- Simplify a boolean formula.
    123 137 
     -- The argument function should give the truth of the atoms, or Nothing if undecided.
    ... ... @@ -125,12 +139,12 @@ simplify :: forall p. Eq (LIdP (GhcPass p))
    125 139 
               => (LIdP (GhcPass p) ->  Maybe Bool)
    126 140 
               -> BooleanFormula (GhcPass p)
    127 141 
               -> BooleanFormula (GhcPass p)
    128 
    -simplify f (Var a) = case f a of
    129 
    -  Nothing -> Var a
    142 
    +simplify f (Var x a) = case f a of
    143 
    +  Nothing -> Var x a
    130 144 
       Just b  -> mkBool b
    131 
    -simplify f (And xs) = mkAnd (map (fmap (simplify f)) xs)
    132 
    -simplify f (Or xs)  = mkOr  (map (fmap (simplify f)) xs)
    133 
    -simplify f (Parens x) = simplify f (unLoc x)
    145 
    +simplify f (And _ xs) = mkAnd (map (fmap (simplify f)) xs)
    146 
    +simplify f (Or _ xs)  = mkOr  (map (fmap (simplify f)) xs)
    147 
    +simplify f (Parens _ x) = simplify f (unLoc x)
    134 148
    135 149 
     -- Test if a boolean formula is satisfied when the given values are assigned to the atoms
    136 150 
     -- if it is, returns Nothing
    ... ... @@ -152,11 +166,11 @@ isUnsatisfied f bf
    152 166
    153 167 
     -- If the boolean formula holds, does that mean that the given atom is always true?
    154 168 
     impliesAtom :: Eq (IdP (GhcPass p)) => BooleanFormula (GhcPass p) -> LIdP (GhcPass p) -> Bool
    155 
    -Var x  `impliesAtom` y = (unLoc x) == (unLoc y)
    156 
    -And xs `impliesAtom` y = any (\x -> unLoc x `impliesAtom` y) xs
    157 
    -           -- we have all of xs, so one of them implying y is enough
    158 
    -Or  xs `impliesAtom` y = all (\x -> unLoc x `impliesAtom` y) xs
    159 
    -Parens x `impliesAtom` y = unLoc x `impliesAtom` y
    169 
    +Var _ x  `impliesAtom` y = (unLoc x) == (unLoc y)
    170 
    +And _ xs `impliesAtom` y = any (\x -> unLoc x `impliesAtom` y) xs
    171 
    +             -- we have all of xs, so one of them implying y is enough
    172 
    +Or _ xs `impliesAtom` y = all (\x -> unLoc x `impliesAtom` y) xs
    173 
    +Parens _ x `impliesAtom` y = unLoc x `impliesAtom` y
    160 174
    161 175 
     implies :: (Uniquable (IdP (GhcPass p))) => BooleanFormula (GhcPass p) -> BooleanFormula (GhcPass p) -> Bool
    162 176 
     implies e1 e2 = go (Clause emptyUniqSet [e1]) (Clause emptyUniqSet [e2])
    ... ... @@ -164,18 +178,18 @@ implies e1 e2 = go (Clause emptyUniqSet [e1]) (Clause emptyUniqSet [e2])
    164 178 
         go :: Uniquable (IdP (GhcPass p)) => Clause (GhcPass p) -> Clause (GhcPass p) -> Bool
    165 179 
         go l@Clause{ clauseExprs = hyp:hyps } r =
    166 180 
             case hyp of
    167 
    -            Var x | memberClauseAtoms (unLoc x) r -> True
    168 
    -                  | otherwise -> go (extendClauseAtoms l (unLoc x)) { clauseExprs = hyps } r
    169 
    -            Parens hyp' -> go l { clauseExprs = unLoc hyp':hyps }     r
    170 
    -            And hyps'  -> go l { clauseExprs = map unLoc hyps' ++ hyps } r
    171 
    -            Or hyps'   -> all (\hyp' -> go l { clauseExprs = unLoc hyp':hyps } r) hyps'
    181 
    +            Var _ x | memberClauseAtoms (unLoc x) r -> True
    182 
    +                    | otherwise -> go (extendClauseAtoms l (unLoc x)) { clauseExprs = hyps } r
    183 
    +            Parens _ hyp' -> go l { clauseExprs = unLoc hyp':hyps }     r
    184 
    +            And _ hyps'  -> go l { clauseExprs = map unLoc hyps' ++ hyps } r
    185 
    +            Or _ hyps'   -> all (\hyp' -> go l { clauseExprs = unLoc hyp':hyps } r) hyps'
    172 186 
         go l r@Clause{ clauseExprs = con:cons } =
    173 187 
             case con of
    174 
    -            Var x | memberClauseAtoms (unLoc x) l -> True
    175 
    -                  | otherwise -> go l (extendClauseAtoms r (unLoc x)) { clauseExprs = cons }
    176 
    -            Parens con' -> go l r { clauseExprs = unLoc con':cons }
    177 
    -            And cons'   -> all (\con' -> go l r { clauseExprs = unLoc con':cons }) cons'
    178 
    -            Or cons'    -> go l r { clauseExprs = map unLoc cons' ++ cons }
    188 
    +            Var _ x | memberClauseAtoms (unLoc x) l -> True
    189 
    +                    | otherwise -> go l (extendClauseAtoms r (unLoc x)) { clauseExprs = cons }
    190 
    +            Parens _ con' -> go l r { clauseExprs = unLoc con':cons }
    191 
    +            And _ cons'   -> all (\con' -> go l r { clauseExprs = unLoc con':cons }) cons'
    192 
    +            Or _ cons'    -> go l r { clauseExprs = map unLoc cons' ++ cons }
    179 193 
         go _ _ = False
    180 194
    181 195 
     -- A small sequent calculus proof engine.
    ... ... @@ -201,12 +215,12 @@ pprBooleanFormula' :: (Rational -> LIdP (GhcPass p) -> SDoc)
    201 215 
                         -> Rational -> BooleanFormula (GhcPass p) -> SDoc
    202 216 
     pprBooleanFormula' pprVar pprAnd pprOr = go
    203 217 
       where
    204 
    -  go p (Var x)  = pprVar p x
    205 
    -  go p (And []) = cparen (p > 0) empty
    206 
    -  go p (And xs) = pprAnd p (map (go 3 . unLoc) xs)
    207 
    -  go _ (Or  []) = keyword $ text "FALSE"
    208 
    -  go p (Or  xs) = pprOr p (map (go 2 . unLoc) xs)
    209 
    -  go p (Parens x) = go p (unLoc x)
    218 
    +  go p (Var _ x)  = pprVar p x
    219 
    +  go p (And _ []) = cparen (p > 0) empty
    220 
    +  go p (And _ xs) = pprAnd p (map (go 3 . unLoc) xs)
    221 
    +  go _ (Or  _ []) = keyword $ text "FALSE"
    222 
    +  go p (Or  _ xs) = pprOr p (map (go 2 . unLoc) xs)
    223 
    +  go p (Parens _ x) = go p (unLoc x)
    210 224
    211 225 
     -- Pretty print in source syntax, "a | b | c,d,e"
    212 226 
     pprBooleanFormula :: (Rational -> LIdP (GhcPass p) -> SDoc)
    ... ... @@ -233,8 +247,9 @@ instance OutputableBndrId p => Outputable (BooleanFormula (GhcPass p)) where
    233 247 
     pprBooleanFormulaNormal :: OutputableBndrId p => BooleanFormula (GhcPass p) -> SDoc
    234 248 
     pprBooleanFormulaNormal = go
    235 249 
       where
    236 
    -    go (Var x)    = pprPrefixOcc (unLoc x)
    237 
    -    go (And xs)   = fsep $ punctuate comma (map (go . unLoc) xs)
    238 
    -    go (Or [])    = keyword $ text "FALSE"
    239 
    -    go (Or xs)    = fsep $ intersperse vbar (map (go . unLoc) xs)
    240 
    -    go (Parens x) = parens (go $ unLoc x)
    250 
    +    go (Var _ x)    = pprPrefixOcc (unLoc x)
    251 
    +    go (And _ xs)   = fsep $ punctuate comma (map (go . unLoc) xs)
    252 
    +    go (Or _ [])    = keyword $ text "FALSE"
    253 
    +    go (Or _ xs)    = fsep $ intersperse vbar (map (go . unLoc) xs)
    254 
    +    go (Parens _ x) = parens (go $ unLoc x)
    255 
    +    go (XBooleanFormula _) = text "XBooleanFormula"

  • compiler/GHC/Iface/Ext/Ast.hs
    ... ... @@ -2083,16 +2083,16 @@ instance ToHie PendingRnSplice where
    2083 2083 
     instance (HiePass p, Data (IdGhcP p))
    2084 2084 
       => ToHie (GenLocated SrcSpanAnnBF (BooleanFormula (GhcPass p))) where
    2085 2085 
         toHie (L span form) =  concatM $ makeNode form (locA span) : case form of
    2086 
    -      Var a ->
    2086 
    +      Var _ a ->
    2087 2087 
             [ toHie $ C Use a
    2088 2088 
             ]
    2089 
    -      And forms ->
    2089 
    +      And _ forms ->
    2090 2090 
             [ toHie forms
    2091 2091 
             ]
    2092 
    -      Or forms ->
    2092 
    +      Or _ forms ->
    2093 2093 
             [ toHie forms
    2094 2094 
             ]
    2095 
    -      Parens f ->
    2095 
    +      Parens _ f ->
    2096 2096 
             [ toHie f
    2097 2097 
             ]
    2098 2098

  • compiler/GHC/Iface/Syntax.hs
    ... ... @@ -103,6 +103,7 @@ import GHC.Data.FastString
    103 103 
     import GHC.Data.BooleanFormula (pprBooleanFormula, isTrue)
    104 104
    105 105 
     import Language.Haskell.Syntax.BooleanFormula(BooleanFormula(..))
    106 
    +import Language.Haskell.Syntax.Extension (noExtField)
    106 107 
     import Language.Haskell.Syntax.Text
    107 108
    108 109 
     import Control.Monad
    ... ... @@ -1326,10 +1327,10 @@ pprIfaceDecl ss decl@(IfaceClass { ifName = clas
    1326 1327
    1327 1328 
           fromIfaceBooleanFormula :: IfaceBooleanFormula -> BooleanFormula GhcRn
    1328 1329 
           -- `mkUnboundName` here is fine because the Name generated is only used for pretty printing and nothing else.
    1329 
    -      fromIfaceBooleanFormula (IfVar nm   ) = Var    $ noLocA . mkUnboundName . mkVarOccFS . ifLclNameFS $ nm
    1330 
    -      fromIfaceBooleanFormula (IfAnd bfs  ) = And    $ map (noLocA . fromIfaceBooleanFormula) bfs
    1331 
    -      fromIfaceBooleanFormula (IfOr bfs   ) = Or     $ map (noLocA . fromIfaceBooleanFormula) bfs
    1332 
    -      fromIfaceBooleanFormula (IfParens bf) = Parens $     (noLocA . fromIfaceBooleanFormula) bf
    1330 
    +      fromIfaceBooleanFormula (IfVar nm   ) = Var    noExtField $ noLocA . mkUnboundName . mkVarOccFS . ifLclNameFS $ nm
    1331 
    +      fromIfaceBooleanFormula (IfAnd bfs  ) = And    noExtField $ map (noLocA . fromIfaceBooleanFormula) bfs
    1332 
    +      fromIfaceBooleanFormula (IfOr bfs   ) = Or     noExtField $ map (noLocA . fromIfaceBooleanFormula) bfs
    1333 
    +      fromIfaceBooleanFormula (IfParens bf) = Parens noExtField $     (noLocA . fromIfaceBooleanFormula) bf
    1333 1334
    1334 1335
    1335 1336 
           -- See Note [Suppressing binder signatures] in GHC.Iface.Type

  • compiler/GHC/IfaceToCore.hs
    ... ... @@ -883,10 +883,10 @@ tc_iface_decl _parent ignore_prags
    883 883 
               return (ATI tc mb_def)
    884 884
    885 885 
        tc_boolean_formula :: IfaceBooleanFormula -> IfL (BooleanFormula GhcRn)
    886 
    -   tc_boolean_formula (IfAnd ibfs  ) = BF.And    . map noLocA <$> traverse tc_boolean_formula ibfs
    887 
    -   tc_boolean_formula (IfOr ibfs   ) = BF.Or     . map noLocA <$> traverse tc_boolean_formula ibfs
    888 
    -   tc_boolean_formula (IfParens ibf) = BF.Parens .     noLocA <$>          tc_boolean_formula ibf
    889 
    -   tc_boolean_formula (IfVar nm    ) = BF.Var    .     noLocA <$> (lookupIfaceTop . mkVarOccFS . ifLclNameFS $ nm)
    886 
    +   tc_boolean_formula (IfAnd ibfs  ) = BF.And    NoExtField . map noLocA <$> traverse tc_boolean_formula ibfs
    887 
    +   tc_boolean_formula (IfOr ibfs   ) = BF.Or     NoExtField . map noLocA <$> traverse tc_boolean_formula ibfs
    888 
    +   tc_boolean_formula (IfParens ibf) = BF.Parens NoExtField .     noLocA <$>          tc_boolean_formula ibf
    889 
    +   tc_boolean_formula (IfVar nm    ) = BF.Var    NoExtField .     noLocA <$> (lookupIfaceTop . mkVarOccFS . ifLclNameFS $ nm)
    890 890
    891 891 
        mk_sc_doc pred = text "Superclass" <+> ppr pred
    892 892 
        mk_at_doc tc = text "Associated type" <+> ppr tc

  • compiler/GHC/Parser.y
    ... ... @@ -3821,11 +3821,11 @@ name_boolformula :: { LBooleanFormula GhcPs }
    3821 3821 
             : name_boolformula_and      { $1 }
    3822 3822 
             | name_boolformula_and '|' name_boolformula
    3823 3823 
                                {% do { h <- addTrailingVbarBF $1 (epTok $2)
    3824 
    -                                 ; return (sLLa $1 $> (Or [h,$3])) } }
    3824 
    +                                 ; return (sLLa $1 $> (Or noExtField [h,$3])) } }
    3825 3825
    3826 3826 
     name_boolformula_and :: { LBooleanFormula GhcPs }
    3827 3827 
             : name_boolformula_and_list
    3828 
    -                  { sLLa (head $1) (last $1) (And (toList $1)) }
    3828 
    +                  { sLLa (head $1) (last $1) (And noExtField (toList $1)) }
    3829 3829
    3830 3830 
     name_boolformula_and_list :: { NonEmpty (LBooleanFormula GhcPs) }
    3831 3831 
             : name_boolformula_atom                               { NE.singleton $1 }
    ... ... @@ -3834,9 +3834,9 @@ name_boolformula_and_list :: { NonEmpty (LBooleanFormula GhcPs) }
    3834 3834 
                       ; return (h NE.<| $3) } }
    3835 3835
    3836 3836 
     name_boolformula_atom :: { LBooleanFormula GhcPs }
    3837 
    -        : '(' name_boolformula ')'  {% amsr (sLL $1 $> (Parens $2))
    3837 
    +        : '(' name_boolformula ')'  {% amsr (sLL $1 $> (Parens noExtField $2))
    3838 3838 
                                                 (AnnBooleanFormula (epTok $1) (epTok $3) [])  }
    3839 
    -        | name_var                  { sL1a $1 (Var $1) }
    3839 
    +        | name_var                  { sL1a $1 (Var noExtField $1) }
    3840 3840
    3841 3841 
     namelist :: { Located [LocatedN RdrName] }
    3842 3842 
     namelist : name_var              { sL1 $1 [$1] }

  • compiler/GHC/Tc/TyCl/Class.hs
    ... ... @@ -345,7 +345,7 @@ tcClassMinimalDef _clas sigs op_info
    345 345 
       where
    346 346 
         -- By default require all methods without a default implementation
    347 347 
         defMindef :: ClassMinimalDef
    348 
    -    defMindef = mkAnd [ noLocA (mkVar (noLocA name))
    348 
    +    defMindef = mkAnd [ noLocA (mkVar NoExtField (noLocA name))
    349 349 
                           | (name, _, Nothing) <- op_info ]
    350 350
    351 351 
     instantiateMethod :: Class -> TcId -> [TcType] -> TcType

  • compiler/Language/Haskell/Syntax/BooleanFormula.hs
    ... ... @@ -4,59 +4,78 @@
    4 4
    5 5 
     module Language.Haskell.Syntax.BooleanFormula(
    6 6 
       BooleanFormula(..), LBooleanFormula,
    7 
    -  mkVar, mkFalse, mkTrue, mkBool, mkAnd, mkOr
    7 
    +  mkVar, mkFalse, mkTrue, mkBool, mkAnd, mkOr,
    8 
    +  BooleanFormulaDefault(..)
    8 9 
       ) where
    9 10
    10 11 
     import Prelude hiding ( init, last )
    11 12 
     import Data.List ( nub )
    12 
    -import Language.Haskell.Syntax.Extension (XRec, UnXRec (..), LIdP)
    13 
    +import Language.Haskell.Syntax.Extension (XRec, UnXRec (..), LIdP,
    14 
    +                                          XBFVar, XBFAnd, XBFOr, XBFParens,
    15 
    +                                          XXBooleanFormula)
    13 16
    14 17
    15 18 
     -- types
    16 19 
     type LBooleanFormula p = XRec p (BooleanFormula p)
    17 
    -data BooleanFormula p = Var (LIdP p) | And [LBooleanFormula p] | Or [LBooleanFormula p]
    18 
    -                      | Parens (LBooleanFormula p)
    20 
    +data BooleanFormula p
    21 
    +       = Var    (XBFVar p)    (LIdP p)
    22 
    +       | And    (XBFAnd p)    [LBooleanFormula p]
    23 
    +       | Or     (XBFOr p)     [LBooleanFormula p]
    24 
    +       | Parens (XBFParens p) (LBooleanFormula p)
    25 
    +       | XBooleanFormula !(XXBooleanFormula p)
    26 
    +
    27 
    +class BooleanFormulaDefault p where
    28 
    +   bfAnnAnd :: XBFAnd p
    29 
    +   bfAnnOr  :: XBFOr p
    19 30
    20 31 
     -- instances
    21 
    -deriving instance (Eq (LIdP p), Eq (LBooleanFormula p)) => Eq (BooleanFormula p)
    32 
    +deriving instance (Eq (LIdP p), Eq (LBooleanFormula p),
    33 
    +                   Eq (XBFVar p),
    34 
    +                   Eq (XBFAnd p),
    35 
    +                   Eq (XBFOr p),
    36 
    +                   Eq (XBFParens p),
    37 
    +                   Eq (XXBooleanFormula p)
    38 
    +                   ) => Eq (BooleanFormula p)
    22 39
    23 40 
     -- smart constructors
    24 41 
     -- see note [Simplification of BooleanFormulas]
    25 
    -mkVar :: LIdP p -> BooleanFormula p
    42 
    +mkVar :: XBFVar p ->  LIdP p -> BooleanFormula p
    26 43 
     mkVar = Var
    27 44
    28 
    -mkFalse, mkTrue :: BooleanFormula p
    29 
    -mkFalse = Or []
    30 
    -mkTrue = And []
    45 
    +mkFalse, mkTrue :: forall p. BooleanFormulaDefault p => BooleanFormula p
    46 
    +mkFalse = Or (bfAnnOr @p) []
    47 
    +mkTrue = And (bfAnnAnd @p) []
    31 48
    32 49 
     -- Convert a Bool to a BooleanFormula
    33 
    -mkBool :: Bool -> BooleanFormula p
    50 
    +mkBool :: BooleanFormulaDefault p => Bool -> BooleanFormula p
    34 51 
     mkBool False = mkFalse
    35 52 
     mkBool True  = mkTrue
    36 53
    37 54 
     -- Make a conjunction, and try to simplify
    38 
    -mkAnd :: forall p. (UnXRec p, Eq (LIdP p), Eq (LBooleanFormula p)) => [LBooleanFormula p] -> BooleanFormula p
    55 
    +mkAnd :: forall p. (UnXRec p, Eq (LIdP p), Eq (LBooleanFormula p), BooleanFormulaDefault p)
    56 
    +      => [LBooleanFormula p] -> BooleanFormula p
    39 57 
     mkAnd = maybe mkFalse (mkAnd' . nub . concat) . mapM fromAnd
    40 58 
       where
    41 59 
       -- See Note [Simplification of BooleanFormulas]
    42 60 
       fromAnd :: LBooleanFormula p -> Maybe [LBooleanFormula p]
    43 61 
       fromAnd bf = case unXRec @p bf of
    44 
    -    (And xs) -> Just xs
    62 
    +    (And _ xs) -> Just xs
    45 63 
          -- assume that xs are already simplified
    46 64 
          -- otherwise we would need: fromAnd (And xs) = concat <$> traverse fromAnd xs
    47 
    -    (Or [])  -> Nothing
    65 
    +    (Or _ [])  -> Nothing
    48 66 
          -- in case of False we bail out, And [..,mkFalse,..] == mkFalse
    49 67 
         _        -> Just [bf]
    50 68 
       mkAnd' [x] = unXRec @p x
    51 
    -  mkAnd' xs = And xs
    69 
    +  mkAnd' xs = And (bfAnnAnd @p) xs
    52 70
    53 
    -mkOr :: forall p. (UnXRec p, Eq (LIdP p), Eq (LBooleanFormula p)) => [LBooleanFormula p] -> BooleanFormula p
    71 
    +mkOr :: forall p. (UnXRec p, Eq (LIdP p), Eq (LBooleanFormula p), BooleanFormulaDefault p)
    72 
    +     => [LBooleanFormula p] -> BooleanFormula p
    54 73 
     mkOr = maybe mkTrue (mkOr' . nub . concat) . mapM fromOr
    55 74 
       where
    56 75 
       -- See Note [Simplification of BooleanFormulas]
    57 76 
       fromOr bf = case unXRec @p bf of
    58 
    -    (Or xs)  -> Just xs
    59 
    -    (And []) -> Nothing
    60 
    -    _        -> Just [bf]
    77 
    +    (Or _ xs)  -> Just xs
    78 
    +    (And _ []) -> Nothing
    79 
    +    _          -> Just [bf]
    61 80 
       mkOr' [x] = unXRec @p x
    62 
    -  mkOr' xs = Or xs
    81 
    +  mkOr' xs = Or (bfAnnOr @p) xs

  • compiler/Language/Haskell/Syntax/Extension.hs
    ... ... @@ -841,6 +841,14 @@ type family XXIntegralLit x
    841 841 
     type family XStringLit  x
    842 842 
     type family XXStringLit x
    843 843
    844 
    +-- =====================================================================
    845 
    +-- BooleanFormula type families
    846 
    +
    847 
    +type family XBFVar           p
    848 
    +type family XBFAnd           p
    849 
    +type family XBFOr            p
    850 
    +type family XBFParens        p
    851 
    +type family XXBooleanFormula p
    844 852
    845 853 
     -- =====================================================================
    846 854 
     -- Misc

  • utils/check-exact/ExactPrint.hs
    ... ... @@ -2722,18 +2722,18 @@ instance ExactPrint (BF.BooleanFormula GhcPs) where
    2722 2722 
       getAnnotationEntry = const NoEntryVal
    2723 2723 
       setAnnotationAnchor a _ _ _ = a
    2724 2724
    2725 
    -  exact (BF.Var x)  = do
    2725 
    +  exact (BF.Var e x)  = do
    2726 2726 
         x' <- markAnnotated x
    2727 
    -    return (BF.Var x')
    2728 
    -  exact (BF.Or ls)  = do
    2727 
    +    return (BF.Var e x')
    2728 
    +  exact (BF.Or e ls)  = do
    2729 2729 
         ls' <- mapM markAnnotated ls
    2730 
    -    return (BF.Or ls')
    2731 
    -  exact (BF.And ls) = do
    2730 
    +    return (BF.Or e ls')
    2731 
    +  exact (BF.And e ls) = do
    2732 2732 
         ls' <- mapM markAnnotated ls
    2733 
    -    return (BF.And ls')
    2734 
    -  exact (BF.Parens x)  = do
    2733 
    +    return (BF.And e ls')
    2734 
    +  exact (BF.Parens e x)  = do
    2735 2735 
         x' <- markAnnotated x
    2736 
    -    return (BF.Parens x')
    2736 
    +    return (BF.Parens e x')
    2737 2737
    2738 2738 
     -- ---------------------------------------------------------------------
    2739 2739

  • utils/haddock/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
    ... ... @@ -998,26 +998,26 @@ ppClassDecl
    998 998 
           -- Minimal complete definition
    999 999 
           minimalBit = case [s | MinimalSig _ (L _ s) <- sigs] of
    1000 1000 
             -- Miminal complete definition = every shown method
    1001 
    -        And xs : _
    1002 
    -          | sort [getName n | L _ (Var (L _ n)) <- xs]
    1001 
    +        And _ xs : _
    1002 
    +          | sort [getName n | L _ (Var _ (L _ n)) <- xs]
    1003 1003 
                   == sort [getName n | ClassOpSig _ _ ns _ <- sigs, L _ n <- ns] ->
    1004 1004 
                   noHtml
    1005 1005 
             -- Minimal complete definition = the only shown method
    1006 
    -        Var (L _ n) : _
    1006 
    +        Var _ (L _ n) : _
    1007 1007 
               | [getName n]
    1008 1008 
                   == [getName n' | ClassOpSig _ _ ns _ <- sigs, L _ n' <- ns] ->
    1009 1009 
                   noHtml
    1010 1010 
             -- Minimal complete definition = nothing
    1011 
    -        And [] : _ -> subMinimal $ toHtml ("Nothing" :: LText)
    1011 
    +        And _ [] : _ -> subMinimal $ toHtml ("Nothing" :: LText)
    1012 1012 
             m : _ -> subMinimal $ ppMinimal False m
    1013 1013 
             _ -> noHtml
    1014 1014
    1015 
    -      ppMinimal _ (Var (L _ n)) = ppDocName qual Prefix True n
    1016 
    -      ppMinimal _ (And fs) = foldr1 (\a b -> a +++ (", " :: LText) +++ b) $ map (ppMinimal True . unLoc) fs
    1017 
    -      ppMinimal p (Or fs) = wrap $ foldr1 (\a b -> a +++ (" | " :: LText) +++ b) $ map (ppMinimal False . unLoc) fs
    1015 
    +      ppMinimal _ (Var _ (L _ n)) = ppDocName qual Prefix True n
    1016 
    +      ppMinimal _ (And _ fs) = foldr1 (\a b -> a +++ (", " :: LText) +++ b) $ map (ppMinimal True . unLoc) fs
    1017 
    +      ppMinimal p (Or _ fs) = wrap $ foldr1 (\a b -> a +++ (" | " :: LText) +++ b) $ map (ppMinimal False . unLoc) fs
    1018 1018 
             where
    1019 1019 
               wrap | p = parens | otherwise = id
    1020 
    -      ppMinimal p (Parens x) = ppMinimal p (unLoc x)
    1020 
    +      ppMinimal p (Parens _ x) = ppMinimal p (unLoc x)
    1021 1021
    1022 1022 
           -- Instances
    1023 1023 
           instancesBit =

  • utils/haddock/haddock-api/src/Haddock/Interface/Rename.hs
    ... ... @@ -858,10 +858,10 @@ bfTraverse :: Applicative f
    858 858 
                 -> f (BooleanFormula DocNameI)
    859 859 
     bfTraverse f = go
    860 860 
       where
    861 
    -    go (Var    a  ) = Var    <$> f a
    862 
    -    go (And    bfs) = And    <$> traverse @[] (traverse go) bfs
    863 
    -    go (Or     bfs) = Or     <$> traverse @[] (traverse go) bfs
    864 
    -    go (Parens bf ) = Parens <$> traverse go bf
    861 
    +    go (Var    x a  ) = Var    x <$> f a
    862 
    +    go (And    x bfs) = And    x <$> traverse @[] (traverse go) bfs
    863 
    +    go (Or     x bfs) = Or     x <$> traverse @[] (traverse go) bfs
    864 
    +    go (Parens x bf ) = Parens x <$> traverse go bf
    865 865
    866 866 
     renameForD :: ForeignDecl GhcRn -> RnM (ForeignDecl DocNameI)
    867 867 
     renameForD (ForeignImport _ modifiers lname ltype x) = do

  • utils/haddock/haddock-api/src/Haddock/Types.hs
    ... ... @@ -1038,6 +1038,12 @@ type instance XCTyFamInstDecl DocNameI = NoExtField
    1038 1038 
     type instance XHsContext DocNameI = NoExtField
    1039 1039 
     type instance XXHsContextDetails DocNameI = DataConCantHappen
    1040 1040
    1041 
    +type instance XBFVar           DocNameI = NoExtField
    1042 
    +type instance XBFAnd           DocNameI = NoExtField
    1043 
    +type instance XBFOr            DocNameI = NoExtField
    1044 
    +type instance XBFParens        DocNameI = NoExtField
    1045 
    +type instance XXBooleanFormula DocNameI = DataConCantHappen
    1046 
    +
    1041 1047 
     -----------------------------------------------------------------------------
    1042 1048
    1043 1049 
     -- * NFData instances for GHC types

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications · Help Notification message regarding https://gitlab.haskell.org/ghc/ghc/-/commit/d8f1a2a3a6507d9b8a8e556e6afdeec283d75cef at 1786983221