never executed always true always false

    1 {-# LANGUAGE TypeFamilies #-}
    2 {-# LANGUAGE LambdaCase #-}
    3 {-# LANGUAGE FlexibleInstances #-}
    4 {-# LANGUAGE DataKinds #-}
    5 
    6 module GHC.Parser.Types
    7    ( SumOrTuple(..)
    8    , pprSumOrTuple
    9    , PatBuilder(..)
   10    , DataConBuilder(..)
   11    )
   12 where
   13 
   14 import GHC.Prelude
   15 import GHC.Types.Basic
   16 import GHC.Types.SrcLoc
   17 import GHC.Types.Name.Reader
   18 import GHC.Hs.Extension
   19 import GHC.Hs.Lit
   20 import GHC.Hs.Pat
   21 import GHC.Hs.Type
   22 import GHC.Utils.Outputable as Outputable
   23 import GHC.Data.OrdList
   24 
   25 import Data.Foldable
   26 import GHC.Parser.Annotation
   27 import Language.Haskell.Syntax
   28 
   29 data SumOrTuple b
   30   = Sum ConTag Arity (LocatedA b) [EpaLocation] [EpaLocation]
   31   -- ^ Last two are the locations of the '|' before and after the payload
   32   | Tuple [Either (EpAnn EpaLocation) (LocatedA b)]
   33 
   34 pprSumOrTuple :: Outputable b => Boxity -> SumOrTuple b -> SDoc
   35 pprSumOrTuple boxity = \case
   36     Sum alt arity e _ _ ->
   37       parOpen <+> ppr_bars (alt - 1) <+> ppr e <+> ppr_bars (arity - alt)
   38               <+> parClose
   39     Tuple xs ->
   40       parOpen <> (fcat . punctuate comma $ map ppr_tup xs)
   41               <> parClose
   42   where
   43     ppr_tup (Left _)  = empty
   44     ppr_tup (Right e) = ppr e
   45 
   46     ppr_bars n = hsep (replicate n (Outputable.char '|'))
   47     (parOpen, parClose) =
   48       case boxity of
   49         Boxed -> (text "(", text ")")
   50         Unboxed -> (text "(#", text "#)")
   51 
   52 
   53 -- | See Note [Ambiguous syntactic categories] and Note [PatBuilder]
   54 data PatBuilder p
   55   = PatBuilderPat (Pat p)
   56   | PatBuilderPar (LHsToken "(" p) (LocatedA (PatBuilder p)) (LHsToken ")" p)
   57   | PatBuilderApp (LocatedA (PatBuilder p)) (LocatedA (PatBuilder p))
   58   | PatBuilderAppType (LocatedA (PatBuilder p)) (HsPatSigType GhcPs)
   59   | PatBuilderOpApp (LocatedA (PatBuilder p)) (LocatedN RdrName)
   60                     (LocatedA (PatBuilder p)) (EpAnn [AddEpAnn])
   61   | PatBuilderVar (LocatedN RdrName)
   62   | PatBuilderOverLit (HsOverLit GhcPs)
   63 
   64 instance Outputable (PatBuilder GhcPs) where
   65   ppr (PatBuilderPat p) = ppr p
   66   ppr (PatBuilderPar _ (L _ p) _) = parens (ppr p)
   67   ppr (PatBuilderApp (L _ p1) (L _ p2)) = ppr p1 <+> ppr p2
   68   ppr (PatBuilderAppType (L _ p) t) = ppr p <+> text "@" <> ppr t
   69   ppr (PatBuilderOpApp (L _ p1) op (L _ p2) _) = ppr p1 <+> ppr op <+> ppr p2
   70   ppr (PatBuilderVar v) = ppr v
   71   ppr (PatBuilderOverLit l) = ppr l
   72 
   73 -- | An accumulator to build a prefix data constructor,
   74 --   e.g. when parsing @MkT A B C@, the accumulator will evolve as follows:
   75 --
   76 --  @
   77 --  1. PrefixDataConBuilder []        MkT
   78 --  2. PrefixDataConBuilder [A]       MkT
   79 --  3. PrefixDataConBuilder [A, B]    MkT
   80 --  4. PrefixDataConBuilder [A, B, C] MkT
   81 --  @
   82 --
   83 --  There are two reasons we have a separate builder type instead of using
   84 --  @HsConDeclDetails GhcPs@ directly:
   85 --
   86 --  1. It's faster, because 'OrdList' gives us constant-time snoc.
   87 --  2. Having a separate type helps ensure that we don't forget to finalize a
   88 --     'RecTy' into a 'RecCon' (we do that in 'dataConBuilderDetails').
   89 --
   90 --  See Note [PatBuilder] for another builder type used in the parser.
   91 --  Here the technique is similar, but the motivation is different.
   92 data DataConBuilder
   93   = PrefixDataConBuilder
   94       (OrdList (LHsType GhcPs))  -- Data constructor fields
   95       (LocatedN RdrName)         -- Data constructor name
   96   | InfixDataConBuilder
   97       (LHsType GhcPs)    -- LHS field
   98       (LocatedN RdrName) -- Data constructor name
   99       (LHsType GhcPs)    -- RHS field
  100 
  101 instance Outputable DataConBuilder where
  102   ppr (PrefixDataConBuilder flds data_con) =
  103     hang (ppr data_con) 2 (sep (map ppr (toList flds)))
  104   ppr (InfixDataConBuilder lhs data_con rhs) =
  105     ppr lhs <+> ppr data_con <+> ppr rhs
  106 
  107 type instance Anno [LocatedA (StmtLR GhcPs GhcPs (LocatedA (PatBuilder GhcPs)))] = SrcSpanAnnL