{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ConstrainedClassMethods #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}

{-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns   #-}

{-
(c) The University of Glasgow 2006
(c) The GRASP/AQUA Project, Glasgow University, 1992-1998


This module converts Template Haskell syntax into Hs syntax
-}

module GHC.ThToHs
   ( convertToHsExpr
   , convertToPat
   , convertToHsDecls
   , convertToHsType
   , thRdrNameGuesses
   )
where

import GHC.Prelude

import GHC.Hs as Hs
import GHC.Builtin.Names
import GHC.Types.Name.Reader
import qualified GHC.Types.Name as Name
import GHC.Unit.Module
import GHC.Parser.PostProcess
import GHC.Types.Name.Occurrence as OccName
import GHC.Types.SrcLoc
import GHC.Core.Type as Hs
import qualified GHC.Core.Coercion as Coercion ( Role(..) )
import GHC.Builtin.Types
import GHC.Types.Basic as Hs
import GHC.Types.Fixity as Hs
import GHC.Types.ForeignCall
import GHC.Types.Unique
import GHC.Types.SourceText
import GHC.Utils.Error
import GHC.Data.Bag
import GHC.Utils.Lexeme
import GHC.Utils.Misc
import GHC.Data.FastString
import GHC.Utils.Outputable as Outputable
import GHC.Utils.Panic

import qualified Data.ByteString as BS
import Control.Monad( unless, ap )
import Data.Maybe( catMaybes, isNothing )
import Language.Haskell.TH as TH hiding (sigP)
import Language.Haskell.TH.Syntax as TH
import Foreign.ForeignPtr
import Foreign.Ptr
import System.IO.Unsafe

-------------------------------------------------------------------
--              The external interface

convertToHsDecls :: Origin -> SrcSpan -> [TH.Dec] -> Either SDoc [LHsDecl GhcPs]
convertToHsDecls :: Origin
-> SrcSpan -> [Dec] -> Either SDoc [LHsDecl (GhcPass 'Parsed)]
convertToHsDecls Origin
origin SrcSpan
loc [Dec]
ds = Origin
-> SrcSpan
-> CvtM [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))]
-> Either SDoc [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))]
forall a. Origin -> SrcSpan -> CvtM a -> Either SDoc a
initCvt Origin
origin SrcSpan
loc (([Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed)))]
 -> [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))])
-> CvtM [Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed)))]
-> CvtM [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))]
forall a b. (a -> b) -> CvtM a -> CvtM b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed)))]
-> [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))]
forall a. [Maybe a] -> [a]
catMaybes ((Dec
 -> CvtM
      (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed)))))
-> [Dec]
-> CvtM [Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed)))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Dec
-> CvtM (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))))
cvt_dec [Dec]
ds))
  where
    cvt_dec :: Dec
-> CvtM (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))))
cvt_dec Dec
d = String
-> Dec
-> CvtM (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))))
-> CvtM (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))))
forall a b. (Show a, Ppr a) => String -> a -> CvtM b -> CvtM b
wrapMsg String
"declaration" Dec
d (Dec -> CvtM (Maybe (LHsDecl (GhcPass 'Parsed)))
cvtDec Dec
d)

convertToHsExpr :: Origin -> SrcSpan -> TH.Exp -> Either SDoc (LHsExpr GhcPs)
convertToHsExpr :: Origin -> SrcSpan -> Exp -> Either SDoc (LHsExpr (GhcPass 'Parsed))
convertToHsExpr Origin
origin SrcSpan
loc Exp
e
  = Origin
-> SrcSpan
-> CvtM (LHsExpr (GhcPass 'Parsed))
-> Either SDoc (LHsExpr (GhcPass 'Parsed))
forall a. Origin -> SrcSpan -> CvtM a -> Either SDoc a
initCvt Origin
origin SrcSpan
loc (CvtM (LHsExpr (GhcPass 'Parsed))
 -> Either SDoc (LHsExpr (GhcPass 'Parsed)))
-> CvtM (LHsExpr (GhcPass 'Parsed))
-> Either SDoc (LHsExpr (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ String
-> Exp
-> CvtM (LHsExpr (GhcPass 'Parsed))
-> CvtM (LHsExpr (GhcPass 'Parsed))
forall a b. (Show a, Ppr a) => String -> a -> CvtM b -> CvtM b
wrapMsg String
"expression" Exp
e (CvtM (LHsExpr (GhcPass 'Parsed))
 -> CvtM (LHsExpr (GhcPass 'Parsed)))
-> CvtM (LHsExpr (GhcPass 'Parsed))
-> CvtM (LHsExpr (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ Exp -> CvtM (LHsExpr (GhcPass 'Parsed))
cvtl Exp
e

convertToPat :: Origin -> SrcSpan -> TH.Pat -> Either SDoc (LPat GhcPs)
convertToPat :: Origin -> SrcSpan -> Pat -> Either SDoc (LPat (GhcPass 'Parsed))
convertToPat Origin
origin SrcSpan
loc Pat
p
  = Origin
-> SrcSpan
-> CvtM (LPat (GhcPass 'Parsed))
-> Either SDoc (LPat (GhcPass 'Parsed))
forall a. Origin -> SrcSpan -> CvtM a -> Either SDoc a
initCvt Origin
origin SrcSpan
loc (CvtM (LPat (GhcPass 'Parsed))
 -> Either SDoc (LPat (GhcPass 'Parsed)))
-> CvtM (LPat (GhcPass 'Parsed))
-> Either SDoc (LPat (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ String
-> Pat
-> CvtM (LPat (GhcPass 'Parsed))
-> CvtM (LPat (GhcPass 'Parsed))
forall a b. (Show a, Ppr a) => String -> a -> CvtM b -> CvtM b
wrapMsg String
"pattern" Pat
p (CvtM (LPat (GhcPass 'Parsed)) -> CvtM (LPat (GhcPass 'Parsed)))
-> CvtM (LPat (GhcPass 'Parsed)) -> CvtM (LPat (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ Pat -> CvtM (LPat (GhcPass 'Parsed))
cvtPat Pat
p

convertToHsType :: Origin -> SrcSpan -> TH.Type -> Either SDoc (LHsType GhcPs)
convertToHsType :: Origin
-> SrcSpan -> Type -> Either SDoc (LHsType (GhcPass 'Parsed))
convertToHsType Origin
origin SrcSpan
loc Type
t
  = Origin
-> SrcSpan
-> CvtM (LHsType (GhcPass 'Parsed))
-> Either SDoc (LHsType (GhcPass 'Parsed))
forall a. Origin -> SrcSpan -> CvtM a -> Either SDoc a
initCvt Origin
origin SrcSpan
loc (CvtM (LHsType (GhcPass 'Parsed))
 -> Either SDoc (LHsType (GhcPass 'Parsed)))
-> CvtM (LHsType (GhcPass 'Parsed))
-> Either SDoc (LHsType (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ String
-> Type
-> CvtM (LHsType (GhcPass 'Parsed))
-> CvtM (LHsType (GhcPass 'Parsed))
forall a b. (Show a, Ppr a) => String -> a -> CvtM b -> CvtM b
wrapMsg String
"type" Type
t (CvtM (LHsType (GhcPass 'Parsed))
 -> CvtM (LHsType (GhcPass 'Parsed)))
-> CvtM (LHsType (GhcPass 'Parsed))
-> CvtM (LHsType (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ Type -> CvtM (LHsType (GhcPass 'Parsed))
cvtType Type
t

-------------------------------------------------------------------
newtype CvtM a = CvtM { forall a. CvtM a -> Origin -> SrcSpan -> Either SDoc (SrcSpan, a)
unCvtM :: Origin -> SrcSpan -> Either SDoc (SrcSpan, a) }
    deriving ((forall a b. (a -> b) -> CvtM a -> CvtM b)
-> (forall a b. a -> CvtM b -> CvtM a) -> Functor CvtM
forall a b. a -> CvtM b -> CvtM a
forall a b. (a -> b) -> CvtM a -> CvtM b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> CvtM a -> CvtM b
fmap :: forall a b. (a -> b) -> CvtM a -> CvtM b
$c<$ :: forall a b. a -> CvtM b -> CvtM a
<$ :: forall a b. a -> CvtM b -> CvtM a
Functor)
        -- Push down the Origin (that is configurable by
        -- -fenable-th-splice-warnings) and source location;
        -- Can fail, with a single error message

-- NB: If the conversion succeeds with (Right x), there should
--     be no exception values hiding in x
-- Reason: so a (head []) in TH code doesn't subsequently
--         make GHC crash when it tries to walk the generated tree

-- Use the SrcSpan everywhere, for lack of anything better.
-- See Note [Source locations within TH splices].

instance Applicative CvtM where
    pure :: forall a. a -> CvtM a
pure a
x = (Origin -> SrcSpan -> Either SDoc (SrcSpan, a)) -> CvtM a
forall a. (Origin -> SrcSpan -> Either SDoc (SrcSpan, a)) -> CvtM a
CvtM ((Origin -> SrcSpan -> Either SDoc (SrcSpan, a)) -> CvtM a)
-> (Origin -> SrcSpan -> Either SDoc (SrcSpan, a)) -> CvtM a
forall a b. (a -> b) -> a -> b
$ \Origin
_ SrcSpan
loc -> (SrcSpan, a) -> Either SDoc (SrcSpan, a)
forall a b. b -> Either a b
Right (SrcSpan
loc,a
x)
    <*> :: forall a b. CvtM (a -> b) -> CvtM a -> CvtM b
(<*>) = CvtM (a -> b) -> CvtM a -> CvtM b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance Monad CvtM where
  (CvtM Origin -> SrcSpan -> Either SDoc (SrcSpan, a)
m) >>= :: forall a b. CvtM a -> (a -> CvtM b) -> CvtM b
>>= a -> CvtM b
k = (Origin -> SrcSpan -> Either SDoc (SrcSpan, b)) -> CvtM b
forall a. (Origin -> SrcSpan -> Either SDoc (SrcSpan, a)) -> CvtM a
CvtM ((Origin -> SrcSpan -> Either SDoc (SrcSpan, b)) -> CvtM b)
-> (Origin -> SrcSpan -> Either SDoc (SrcSpan, b)) -> CvtM b
forall a b. (a -> b) -> a -> b
$ \Origin
origin SrcSpan
loc -> case Origin -> SrcSpan -> Either SDoc (SrcSpan, a)
m Origin
origin SrcSpan
loc of
    Left SDoc
err -> SDoc -> Either SDoc (SrcSpan, b)
forall a b. a -> Either a b
Left SDoc
err
    Right (SrcSpan
loc',a
v) -> CvtM b -> Origin -> SrcSpan -> Either SDoc (SrcSpan, b)
forall a. CvtM a -> Origin -> SrcSpan -> Either SDoc (SrcSpan, a)
unCvtM (a -> CvtM b
k a
v) Origin
origin SrcSpan
loc'

initCvt :: Origin -> SrcSpan -> CvtM a -> Either SDoc a
initCvt :: forall a. Origin -> SrcSpan -> CvtM a -> Either SDoc a
initCvt Origin
origin SrcSpan
loc (CvtM Origin -> SrcSpan -> Either SDoc (SrcSpan, a)
m) = ((SrcSpan, a) -> a) -> Either SDoc (SrcSpan, a) -> Either SDoc a
forall a b. (a -> b) -> Either SDoc a -> Either SDoc b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SrcSpan, a) -> a
forall a b. (a, b) -> b
snd (Origin -> SrcSpan -> Either SDoc (SrcSpan, a)
m Origin
origin SrcSpan
loc)

force :: a -> CvtM ()
force :: forall a. a -> CvtM ()
force a
a = a
a a -> CvtM () -> CvtM ()
forall a b. a -> b -> b
`seq` () -> CvtM ()
forall a. a -> CvtM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

failWith :: SDoc -> CvtM a
failWith :: forall a. SDoc -> CvtM a
failWith SDoc
m = (Origin -> SrcSpan -> Either SDoc (SrcSpan, a)) -> CvtM a
forall a. (Origin -> SrcSpan -> Either SDoc (SrcSpan, a)) -> CvtM a
CvtM (\Origin
_ SrcSpan
_ -> SDoc -> Either SDoc (SrcSpan, a)
forall a b. a -> Either a b
Left SDoc
m)

getOrigin :: CvtM Origin
getOrigin :: CvtM Origin
getOrigin = (Origin -> SrcSpan -> Either SDoc (SrcSpan, Origin)) -> CvtM Origin
forall a. (Origin -> SrcSpan -> Either SDoc (SrcSpan, a)) -> CvtM a
CvtM (\Origin
origin SrcSpan
loc -> (SrcSpan, Origin) -> Either SDoc (SrcSpan, Origin)
forall a b. b -> Either a b
Right (SrcSpan
loc,Origin
origin))

getL :: CvtM SrcSpan
getL :: CvtM SrcSpan
getL = (Origin -> SrcSpan -> Either SDoc (SrcSpan, SrcSpan))
-> CvtM SrcSpan
forall a. (Origin -> SrcSpan -> Either SDoc (SrcSpan, a)) -> CvtM a
CvtM (\Origin
_ SrcSpan
loc -> (SrcSpan, SrcSpan) -> Either SDoc (SrcSpan, SrcSpan)
forall a b. b -> Either a b
Right (SrcSpan
loc,SrcSpan
loc))

-- NB: This is only used in conjunction with LineP pragmas.
-- See Note [Source locations within TH splices].
setL :: SrcSpan -> CvtM ()
setL :: SrcSpan -> CvtM ()
setL SrcSpan
loc = (Origin -> SrcSpan -> Either SDoc (SrcSpan, ())) -> CvtM ()
forall a. (Origin -> SrcSpan -> Either SDoc (SrcSpan, a)) -> CvtM a
CvtM (\Origin
_ SrcSpan
_ -> (SrcSpan, ()) -> Either SDoc (SrcSpan, ())
forall a b. b -> Either a b
Right (SrcSpan
loc, ()))

returnLA :: e -> CvtM (LocatedAn ann e)
returnLA :: forall e ann. e -> CvtM (LocatedAn ann e)
returnLA e
x = (Origin -> SrcSpan -> Either SDoc (SrcSpan, LocatedAn ann e))
-> CvtM (LocatedAn ann e)
forall a. (Origin -> SrcSpan -> Either SDoc (SrcSpan, a)) -> CvtM a
CvtM (\Origin
_ SrcSpan
loc -> (SrcSpan, LocatedAn ann e)
-> Either SDoc (SrcSpan, LocatedAn ann e)
forall a b. b -> Either a b
Right (SrcSpan
loc, SrcAnn ann -> e -> LocatedAn ann e
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcAnn ann
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
loc) e
x))

returnJustLA :: a -> CvtM (Maybe (LocatedA a))
returnJustLA :: forall a. a -> CvtM (Maybe (LocatedA a))
returnJustLA = (LocatedA a -> Maybe (LocatedA a))
-> CvtM (LocatedA a) -> CvtM (Maybe (LocatedA a))
forall a b. (a -> b) -> CvtM a -> CvtM b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LocatedA a -> Maybe (LocatedA a)
forall a. a -> Maybe a
Just (CvtM (LocatedA a) -> CvtM (Maybe (LocatedA a)))
-> (a -> CvtM (LocatedA a)) -> a -> CvtM (Maybe (LocatedA a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> CvtM (LocatedA a)
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA

wrapParLA :: (LocatedAn ann a -> b) -> a -> CvtM b
wrapParLA :: forall ann a b. (LocatedAn ann a -> b) -> a -> CvtM b
wrapParLA LocatedAn ann a -> b
add_par a
x = (Origin -> SrcSpan -> Either SDoc (SrcSpan, b)) -> CvtM b
forall a. (Origin -> SrcSpan -> Either SDoc (SrcSpan, a)) -> CvtM a
CvtM (\Origin
_ SrcSpan
loc -> (SrcSpan, b) -> Either SDoc (SrcSpan, b)
forall a b. b -> Either a b
Right (SrcSpan
loc, LocatedAn ann a -> b
add_par (SrcAnn ann -> a -> LocatedAn ann a
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcAnn ann
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
loc) a
x)))

wrapMsg :: (Show a, TH.Ppr a) => String -> a -> CvtM b -> CvtM b
-- E.g  wrapMsg "declaration" dec thing
wrapMsg :: forall a b. (Show a, Ppr a) => String -> a -> CvtM b -> CvtM b
wrapMsg String
what a
item (CvtM Origin -> SrcSpan -> Either SDoc (SrcSpan, b)
m)
  = (Origin -> SrcSpan -> Either SDoc (SrcSpan, b)) -> CvtM b
forall a. (Origin -> SrcSpan -> Either SDoc (SrcSpan, a)) -> CvtM a
CvtM ((Origin -> SrcSpan -> Either SDoc (SrcSpan, b)) -> CvtM b)
-> (Origin -> SrcSpan -> Either SDoc (SrcSpan, b)) -> CvtM b
forall a b. (a -> b) -> a -> b
$ \Origin
origin SrcSpan
loc -> case Origin -> SrcSpan -> Either SDoc (SrcSpan, b)
m Origin
origin SrcSpan
loc of
      Left SDoc
err -> SDoc -> Either SDoc (SrcSpan, b)
forall a b. a -> Either a b
Left (SDoc
err SDoc -> SDoc -> SDoc
$$ SDoc
msg)
      Right (SrcSpan, b)
v  -> (SrcSpan, b) -> Either SDoc (SrcSpan, b)
forall a b. b -> Either a b
Right (SrcSpan, b)
v
  where
        -- Show the item in pretty syntax normally,
        -- but with all its constructors if you say -dppr-debug
    msg :: SDoc
msg = SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
text String
"When splicing a TH" SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
what SDoc -> SDoc -> SDoc
<> SDoc
colon)
                 Int
2 ((Bool -> SDoc) -> SDoc
getPprDebug ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \case
                     Bool
True  -> String -> SDoc
text (a -> String
forall a. Show a => a -> String
show a
item)
                     Bool
False -> String -> SDoc
text (a -> String
forall a. Ppr a => a -> String
pprint a
item))

wrapL :: CvtM a -> CvtM (Located a)
wrapL :: forall a. CvtM a -> CvtM (Located a)
wrapL (CvtM Origin -> SrcSpan -> Either SDoc (SrcSpan, a)
m) = (Origin -> SrcSpan -> Either SDoc (SrcSpan, Located a))
-> CvtM (Located a)
forall a. (Origin -> SrcSpan -> Either SDoc (SrcSpan, a)) -> CvtM a
CvtM ((Origin -> SrcSpan -> Either SDoc (SrcSpan, Located a))
 -> CvtM (Located a))
-> (Origin -> SrcSpan -> Either SDoc (SrcSpan, Located a))
-> CvtM (Located a)
forall a b. (a -> b) -> a -> b
$ \Origin
origin SrcSpan
loc -> case Origin -> SrcSpan -> Either SDoc (SrcSpan, a)
m Origin
origin SrcSpan
loc of
  Left SDoc
err -> SDoc -> Either SDoc (SrcSpan, Located a)
forall a b. a -> Either a b
Left SDoc
err
  Right (SrcSpan
loc', a
v) -> (SrcSpan, Located a) -> Either SDoc (SrcSpan, Located a)
forall a b. b -> Either a b
Right (SrcSpan
loc', SrcSpan -> a -> Located a
forall l e. l -> e -> GenLocated l e
L SrcSpan
loc a
v)

wrapLN :: CvtM a -> CvtM (LocatedN a)
wrapLN :: forall a. CvtM a -> CvtM (LocatedN a)
wrapLN (CvtM Origin -> SrcSpan -> Either SDoc (SrcSpan, a)
m) = (Origin -> SrcSpan -> Either SDoc (SrcSpan, LocatedN a))
-> CvtM (LocatedN a)
forall a. (Origin -> SrcSpan -> Either SDoc (SrcSpan, a)) -> CvtM a
CvtM ((Origin -> SrcSpan -> Either SDoc (SrcSpan, LocatedN a))
 -> CvtM (LocatedN a))
-> (Origin -> SrcSpan -> Either SDoc (SrcSpan, LocatedN a))
-> CvtM (LocatedN a)
forall a b. (a -> b) -> a -> b
$ \Origin
origin SrcSpan
loc -> case Origin -> SrcSpan -> Either SDoc (SrcSpan, a)
m Origin
origin SrcSpan
loc of
  Left SDoc
err -> SDoc -> Either SDoc (SrcSpan, LocatedN a)
forall a b. a -> Either a b
Left SDoc
err
  Right (SrcSpan
loc', a
v) -> (SrcSpan, LocatedN a) -> Either SDoc (SrcSpan, LocatedN a)
forall a b. b -> Either a b
Right (SrcSpan
loc', SrcSpanAnnN -> a -> LocatedN a
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnN
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
loc) a
v)

wrapLA :: CvtM a -> CvtM (LocatedA a)
wrapLA :: forall a. CvtM a -> CvtM (LocatedA a)
wrapLA (CvtM Origin -> SrcSpan -> Either SDoc (SrcSpan, a)
m) = (Origin -> SrcSpan -> Either SDoc (SrcSpan, LocatedA a))
-> CvtM (LocatedA a)
forall a. (Origin -> SrcSpan -> Either SDoc (SrcSpan, a)) -> CvtM a
CvtM ((Origin -> SrcSpan -> Either SDoc (SrcSpan, LocatedA a))
 -> CvtM (LocatedA a))
-> (Origin -> SrcSpan -> Either SDoc (SrcSpan, LocatedA a))
-> CvtM (LocatedA a)
forall a b. (a -> b) -> a -> b
$ \Origin
origin SrcSpan
loc -> case Origin -> SrcSpan -> Either SDoc (SrcSpan, a)
m Origin
origin SrcSpan
loc of
  Left SDoc
err -> SDoc -> Either SDoc (SrcSpan, LocatedA a)
forall a b. a -> Either a b
Left SDoc
err
  Right (SrcSpan
loc', a
v) -> (SrcSpan, LocatedA a) -> Either SDoc (SrcSpan, LocatedA a)
forall a b. b -> Either a b
Right (SrcSpan
loc', SrcSpanAnnA -> a -> LocatedA a
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnA
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
loc) a
v)

{-
Note [Source locations within TH splices]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider a TH splice such as $(x), where `x` evaluates to `id True`. What
source locations should we use for subexpressions within the splice, such as
`id` and `True`? We basically have two options:

1. Don't give anything within the splice a SrcSpan. That is, use the `noLoc`
   everywhere.
2. Give everything within the splice the same `SrcSpan` as where the splice
   occurs (i.e., where $(x) occurs).

We implement option (2) for the following reasons:

* We want SrcSpans on binding locations so that variables bound in the
  spliced-in declarations get a location that at least relates to the splice
  point.

* Generally speaking, having *some* SrcSpan for each sub-expression in the AST
  in better than having no SrcSpan at all. This extra information can be useful
  for programs that walk over the AST directly.

Because of our choice of option (2), we are very careful not to use the noLoc
function anywhere in GHC.ThToHs. Instead, we thread around a SrcSpan in CvtM
and allow retrieving the SrcSpan through combinators such as getL, returnLA,
wrapParLA, etc.

Note that CvtM is actually a *state* monad vis-à-vis SrcSpan, not just a
reader monad. This is because LineP pragmas can change the source location
within a splice—see testsuite/tests/th/TH_linePragma.hs for an example. This
is a bit unusual, since it changes the source location from that of the splice
point to that of the code being spliced in. Nevertheless, LineP is *the* reason
why CvtM is a state monad.
-}

-------------------------------------------------------------------
cvtDecs :: [TH.Dec] -> CvtM [LHsDecl GhcPs]
cvtDecs :: [Dec] -> CvtM [LHsDecl (GhcPass 'Parsed)]
cvtDecs = ([Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed)))]
 -> [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))])
-> CvtM [Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed)))]
-> CvtM [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))]
forall a b. (a -> b) -> CvtM a -> CvtM b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed)))]
-> [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))]
forall a. [Maybe a] -> [a]
catMaybes (CvtM [Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed)))]
 -> CvtM [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))])
-> ([Dec]
    -> CvtM
         [Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed)))])
-> [Dec]
-> CvtM [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Dec
 -> CvtM
      (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed)))))
-> [Dec]
-> CvtM [Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed)))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Dec -> CvtM (Maybe (LHsDecl (GhcPass 'Parsed)))
Dec
-> CvtM (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))))
cvtDec

cvtDec :: TH.Dec -> CvtM (Maybe (LHsDecl GhcPs))
cvtDec :: Dec -> CvtM (Maybe (LHsDecl (GhcPass 'Parsed)))
cvtDec (TH.ValD Pat
pat Body
body [Dec]
ds)
  | TH.VarP Name
s <- Pat
pat
  = do  { GenLocated SrcSpanAnnN RdrName
s' <- Name -> CvtM (GenLocated SrcSpanAnnN RdrName)
vNameN Name
s
        ; GenLocated
  SrcSpanAnnA
  (Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))
cl' <- HsMatchContext (GhcPass 'Parsed)
-> Clause
-> CvtM (LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)))
cvtClause (LIdP (NoGhcTc (GhcPass 'Parsed))
-> HsMatchContext (GhcPass 'Parsed)
forall p. LIdP (NoGhcTc p) -> HsMatchContext p
mkPrefixFunRhs LIdP (NoGhcTc (GhcPass 'Parsed))
GenLocated SrcSpanAnnN RdrName
s') ([Pat] -> Body -> [Dec] -> Clause
Clause [] Body
body [Dec]
ds)
        ; Origin
th_origin <- CvtM Origin
getOrigin
        ; HsDecl (GhcPass 'Parsed)
-> CvtM (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))))
forall a. a -> CvtM (Maybe (LocatedA a))
returnJustLA (HsDecl (GhcPass 'Parsed)
 -> CvtM
      (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed)))))
-> HsDecl (GhcPass 'Parsed)
-> CvtM (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))))
forall a b. (a -> b) -> a -> b
$ XValD (GhcPass 'Parsed)
-> HsBind (GhcPass 'Parsed) -> HsDecl (GhcPass 'Parsed)
forall p. XValD p -> HsBind p -> HsDecl p
Hs.ValD XValD (GhcPass 'Parsed)
NoExtField
noExtField (HsBind (GhcPass 'Parsed) -> HsDecl (GhcPass 'Parsed))
-> HsBind (GhcPass 'Parsed) -> HsDecl (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$ Origin
-> GenLocated SrcSpanAnnN RdrName
-> [LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
-> HsBind (GhcPass 'Parsed)
mkFunBind Origin
th_origin GenLocated SrcSpanAnnN RdrName
s' [LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
GenLocated
  SrcSpanAnnA
  (Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))
cl'] }

  | Bool
otherwise
  = do  { GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
pat' <- Pat -> CvtM (LPat (GhcPass 'Parsed))
cvtPat Pat
pat
        ; [GenLocated
   (SrcAnn NoEpAnns)
   (GRHS (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
body' <- Body -> CvtM [LGRHS (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
cvtGuard Body
body
        ; HsLocalBinds (GhcPass 'Parsed)
ds' <- SDoc -> [Dec] -> CvtM (HsLocalBinds (GhcPass 'Parsed))
cvtLocalDecs (String -> SDoc
text String
"a where clause") [Dec]
ds
        ; HsDecl (GhcPass 'Parsed)
-> CvtM (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))))
forall a. a -> CvtM (Maybe (LocatedA a))
returnJustLA (HsDecl (GhcPass 'Parsed)
 -> CvtM
      (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed)))))
-> HsDecl (GhcPass 'Parsed)
-> CvtM (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))))
forall a b. (a -> b) -> a -> b
$ XValD (GhcPass 'Parsed)
-> HsBind (GhcPass 'Parsed) -> HsDecl (GhcPass 'Parsed)
forall p. XValD p -> HsBind p -> HsDecl p
Hs.ValD XValD (GhcPass 'Parsed)
NoExtField
noExtField (HsBind (GhcPass 'Parsed) -> HsDecl (GhcPass 'Parsed))
-> HsBind (GhcPass 'Parsed) -> HsDecl (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$
          PatBind { pat_lhs :: LPat (GhcPass 'Parsed)
pat_lhs = LPat (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
pat'
                  , pat_rhs :: GRHSs (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
pat_rhs = XCGRHSs (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
-> [LGRHS (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))]
-> HsLocalBinds (GhcPass 'Parsed)
-> GRHSs (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
forall p body.
XCGRHSs p body -> [LGRHS p body] -> HsLocalBinds p -> GRHSs p body
GRHSs XCGRHSs (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
EpAnnComments
emptyComments [LGRHS (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))]
[GenLocated
   (SrcAnn NoEpAnns)
   (GRHS (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
body' HsLocalBinds (GhcPass 'Parsed)
ds'
                  , pat_ext :: XPatBind (GhcPass 'Parsed) (GhcPass 'Parsed)
pat_ext = XPatBind (GhcPass 'Parsed) (GhcPass 'Parsed)
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn
                  , pat_ticks :: ([CoreTickish], [[CoreTickish]])
pat_ticks = ([],[]) } }

cvtDec (TH.FunD Name
nm [Clause]
cls)
  | [Clause] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Clause]
cls
  = SDoc
-> CvtM (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))))
forall a. SDoc -> CvtM a
failWith (String -> SDoc
text String
"Function binding for"
                 SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (String -> SDoc
text (Name -> String
forall a. Ppr a => a -> String
TH.pprint Name
nm))
                 SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"has no equations")
  | Bool
otherwise
  = do  { GenLocated SrcSpanAnnN RdrName
nm' <- Name -> CvtM (GenLocated SrcSpanAnnN RdrName)
vNameN Name
nm
        ; [GenLocated
   SrcSpanAnnA
   (Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
cls' <- (Clause
 -> CvtM
      (GenLocated
         SrcSpanAnnA
         (Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))))
-> [Clause]
-> CvtM
     [GenLocated
        SrcSpanAnnA
        (Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (HsMatchContext (GhcPass 'Parsed)
-> Clause
-> CvtM (LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)))
cvtClause (LIdP (NoGhcTc (GhcPass 'Parsed))
-> HsMatchContext (GhcPass 'Parsed)
forall p. LIdP (NoGhcTc p) -> HsMatchContext p
mkPrefixFunRhs LIdP (NoGhcTc (GhcPass 'Parsed))
GenLocated SrcSpanAnnN RdrName
nm')) [Clause]
cls
        ; Origin
th_origin <- CvtM Origin
getOrigin
        ; HsDecl (GhcPass 'Parsed)
-> CvtM (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))))
forall a. a -> CvtM (Maybe (LocatedA a))
returnJustLA (HsDecl (GhcPass 'Parsed)
 -> CvtM
      (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed)))))
-> HsDecl (GhcPass 'Parsed)
-> CvtM (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))))
forall a b. (a -> b) -> a -> b
$ XValD (GhcPass 'Parsed)
-> HsBind (GhcPass 'Parsed) -> HsDecl (GhcPass 'Parsed)
forall p. XValD p -> HsBind p -> HsDecl p
Hs.ValD XValD (GhcPass 'Parsed)
NoExtField
noExtField (HsBind (GhcPass 'Parsed) -> HsDecl (GhcPass 'Parsed))
-> HsBind (GhcPass 'Parsed) -> HsDecl (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$ Origin
-> GenLocated SrcSpanAnnN RdrName
-> [LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
-> HsBind (GhcPass 'Parsed)
mkFunBind Origin
th_origin GenLocated SrcSpanAnnN RdrName
nm' [LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
[GenLocated
   SrcSpanAnnA
   (Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
cls' }

cvtDec (TH.SigD Name
nm Type
typ)
  = do  { GenLocated SrcSpanAnnN RdrName
nm' <- Name -> CvtM (GenLocated SrcSpanAnnN RdrName)
vNameN Name
nm
        ; GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Parsed))
ty' <- Type -> CvtM (LHsSigType (GhcPass 'Parsed))
cvtSigType Type
typ
        ; HsDecl (GhcPass 'Parsed)
-> CvtM (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))))
forall a. a -> CvtM (Maybe (LocatedA a))
returnJustLA (HsDecl (GhcPass 'Parsed)
 -> CvtM
      (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed)))))
-> HsDecl (GhcPass 'Parsed)
-> CvtM (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))))
forall a b. (a -> b) -> a -> b
$ XSigD (GhcPass 'Parsed)
-> Sig (GhcPass 'Parsed) -> HsDecl (GhcPass 'Parsed)
forall p. XSigD p -> Sig p -> HsDecl p
Hs.SigD XSigD (GhcPass 'Parsed)
NoExtField
noExtField
                                    (XTypeSig (GhcPass 'Parsed)
-> [LIdP (GhcPass 'Parsed)]
-> LHsSigWcType (GhcPass 'Parsed)
-> Sig (GhcPass 'Parsed)
forall pass.
XTypeSig pass -> [LIdP pass] -> LHsSigWcType pass -> Sig pass
TypeSig XTypeSig (GhcPass 'Parsed)
EpAnn AnnSig
forall a. EpAnn a
noAnn [LIdP (GhcPass 'Parsed)
GenLocated SrcSpanAnnN RdrName
nm'] (GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Parsed))
-> HsWildCardBndrs
     (GhcPass 'Parsed)
     (GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Parsed)))
forall thing. thing -> HsWildCardBndrs (GhcPass 'Parsed) thing
mkHsWildCardBndrs GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Parsed))
ty')) }

cvtDec (TH.KiSigD Name
nm Type
ki)
  = do  { GenLocated SrcSpanAnnN RdrName
nm' <- Name -> CvtM (GenLocated SrcSpanAnnN RdrName)
tconNameN Name
nm
        ; GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Parsed))
ki' <- Type -> CvtM (LHsSigType (GhcPass 'Parsed))
cvtSigKind Type
ki
        ; let sig' :: StandaloneKindSig (GhcPass 'Parsed)
sig' = XStandaloneKindSig (GhcPass 'Parsed)
-> LIdP (GhcPass 'Parsed)
-> LHsSigType (GhcPass 'Parsed)
-> StandaloneKindSig (GhcPass 'Parsed)
forall pass.
XStandaloneKindSig pass
-> LIdP pass -> LHsSigType pass -> StandaloneKindSig pass
StandaloneKindSig XStandaloneKindSig (GhcPass 'Parsed)
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn LIdP (GhcPass 'Parsed)
GenLocated SrcSpanAnnN RdrName
nm' LHsSigType (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Parsed))
ki'
        ; HsDecl (GhcPass 'Parsed)
-> CvtM (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))))
forall a. a -> CvtM (Maybe (LocatedA a))
returnJustLA (HsDecl (GhcPass 'Parsed)
 -> CvtM
      (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed)))))
-> HsDecl (GhcPass 'Parsed)
-> CvtM (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))))
forall a b. (a -> b) -> a -> b
$ XKindSigD (GhcPass 'Parsed)
-> StandaloneKindSig (GhcPass 'Parsed) -> HsDecl (GhcPass 'Parsed)
forall p. XKindSigD p -> StandaloneKindSig p -> HsDecl p
Hs.KindSigD XKindSigD (GhcPass 'Parsed)
NoExtField
noExtField StandaloneKindSig (GhcPass 'Parsed)
sig' }

cvtDec (TH.InfixD Fixity
fx Name
nm)
  -- Fixity signatures are allowed for variables, constructors, and types
  -- the renamer automatically looks for types during renaming, even when
  -- the RdrName says it's a variable or a constructor. So, just assume
  -- it's a variable or constructor and proceed.
  = do { GenLocated SrcSpanAnnN RdrName
nm' <- Name -> CvtM (GenLocated SrcSpanAnnN RdrName)
vcNameN Name
nm
       ; HsDecl (GhcPass 'Parsed)
-> CvtM (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))))
forall a. a -> CvtM (Maybe (LocatedA a))
returnJustLA (XSigD (GhcPass 'Parsed)
-> Sig (GhcPass 'Parsed) -> HsDecl (GhcPass 'Parsed)
forall p. XSigD p -> Sig p -> HsDecl p
Hs.SigD XSigD (GhcPass 'Parsed)
NoExtField
noExtField (XFixSig (GhcPass 'Parsed)
-> FixitySig (GhcPass 'Parsed) -> Sig (GhcPass 'Parsed)
forall pass. XFixSig pass -> FixitySig pass -> Sig pass
FixSig XFixSig (GhcPass 'Parsed)
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn
                                      (XFixitySig (GhcPass 'Parsed)
-> [LIdP (GhcPass 'Parsed)]
-> Fixity
-> FixitySig (GhcPass 'Parsed)
forall pass.
XFixitySig pass -> [LIdP pass] -> Fixity -> FixitySig pass
FixitySig XFixitySig (GhcPass 'Parsed)
NoExtField
noExtField [LIdP (GhcPass 'Parsed)
GenLocated SrcSpanAnnN RdrName
nm'] (Fixity -> Fixity
cvtFixity Fixity
fx)))) }

cvtDec (TH.DefaultD [Type]
tys)
  = do  { [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
tys' <- (Type -> CvtM (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))))
-> [Type]
-> CvtM [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Type -> CvtM (LHsType (GhcPass 'Parsed))
Type -> CvtM (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
cvtType [Type]
tys
        ; HsDecl (GhcPass 'Parsed)
-> CvtM (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))))
forall a. a -> CvtM (Maybe (LocatedA a))
returnJustLA (XDefD (GhcPass 'Parsed)
-> DefaultDecl (GhcPass 'Parsed) -> HsDecl (GhcPass 'Parsed)
forall p. XDefD p -> DefaultDecl p -> HsDecl p
Hs.DefD XDefD (GhcPass 'Parsed)
NoExtField
noExtField (DefaultDecl (GhcPass 'Parsed) -> HsDecl (GhcPass 'Parsed))
-> DefaultDecl (GhcPass 'Parsed) -> HsDecl (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$ XCDefaultDecl (GhcPass 'Parsed)
-> [LHsType (GhcPass 'Parsed)] -> DefaultDecl (GhcPass 'Parsed)
forall pass.
XCDefaultDecl pass -> [LHsType pass] -> DefaultDecl pass
DefaultDecl XCDefaultDecl (GhcPass 'Parsed)
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn [LHsType (GhcPass 'Parsed)]
[GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
tys') }

cvtDec (PragmaD Pragma
prag)
  = Pragma -> CvtM (Maybe (LHsDecl (GhcPass 'Parsed)))
cvtPragmaD Pragma
prag

cvtDec (TySynD Name
tc [TyVarBndr ()]
tvs Type
rhs)
  = do  { (GenLocated
  SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
_, GenLocated SrcSpanAnnN RdrName
tc', LHsQTyVars (GhcPass 'Parsed)
tvs') <- [Type]
-> Name
-> [TyVarBndr ()]
-> CvtM
     (LHsContext (GhcPass 'Parsed), GenLocated SrcSpanAnnN RdrName,
      LHsQTyVars (GhcPass 'Parsed))
cvt_tycl_hdr [] Name
tc [TyVarBndr ()]
tvs
        ; GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
rhs' <- Type -> CvtM (LHsType (GhcPass 'Parsed))
cvtType Type
rhs
        ; HsDecl (GhcPass 'Parsed)
-> CvtM (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))))
forall a. a -> CvtM (Maybe (LocatedA a))
returnJustLA (HsDecl (GhcPass 'Parsed)
 -> CvtM
      (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed)))))
-> HsDecl (GhcPass 'Parsed)
-> CvtM (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))))
forall a b. (a -> b) -> a -> b
$ XTyClD (GhcPass 'Parsed)
-> TyClDecl (GhcPass 'Parsed) -> HsDecl (GhcPass 'Parsed)
forall p. XTyClD p -> TyClDecl p -> HsDecl p
TyClD XTyClD (GhcPass 'Parsed)
NoExtField
noExtField (TyClDecl (GhcPass 'Parsed) -> HsDecl (GhcPass 'Parsed))
-> TyClDecl (GhcPass 'Parsed) -> HsDecl (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$
          SynDecl { tcdSExt :: XSynDecl (GhcPass 'Parsed)
tcdSExt = XSynDecl (GhcPass 'Parsed)
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn, tcdLName :: LIdP (GhcPass 'Parsed)
tcdLName = LIdP (GhcPass 'Parsed)
GenLocated SrcSpanAnnN RdrName
tc', tcdTyVars :: LHsQTyVars (GhcPass 'Parsed)
tcdTyVars = LHsQTyVars (GhcPass 'Parsed)
tvs'
                  , tcdFixity :: LexicalFixity
tcdFixity = LexicalFixity
Prefix
                  , tcdRhs :: LHsType (GhcPass 'Parsed)
tcdRhs = LHsType (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
rhs' } }

cvtDec (DataD [Type]
ctxt Name
tc [TyVarBndr ()]
tvs Maybe Type
ksig [Con]
constrs [DerivClause]
derivs)
  = do  { let isGadtCon :: Con -> Bool
isGadtCon (GadtC    [Name]
_ [BangType]
_ Type
_) = Bool
True
              isGadtCon (RecGadtC [Name]
_ [VarBangType]
_ Type
_) = Bool
True
              isGadtCon (ForallC  [TyVarBndr Specificity]
_ [Type]
_ Con
c) = Con -> Bool
isGadtCon Con
c
              isGadtCon Con
_                = Bool
False
              isGadtDecl :: Bool
isGadtDecl  = (Con -> Bool) -> [Con] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Con -> Bool
isGadtCon [Con]
constrs
              isH98Decl :: Bool
isH98Decl   = (Con -> Bool) -> [Con] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Bool -> Bool
not (Bool -> Bool) -> (Con -> Bool) -> Con -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Con -> Bool
isGadtCon) [Con]
constrs
        ; Bool -> CvtM () -> CvtM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Bool
isGadtDecl Bool -> Bool -> Bool
|| Bool
isH98Decl)
                 (SDoc -> CvtM ()
forall a. SDoc -> CvtM a
failWith (String -> SDoc
text String
"Cannot mix GADT constructors with Haskell 98"
                        SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"constructors"))
        ; Bool -> CvtM () -> CvtM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Maybe Type -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Type
ksig Bool -> Bool -> Bool
|| Bool
isGadtDecl)
                 (SDoc -> CvtM ()
forall a. SDoc -> CvtM a
failWith (String -> SDoc
text String
"Kind signatures are only allowed on GADTs"))
        ; (GenLocated
  SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
ctxt', GenLocated SrcSpanAnnN RdrName
tc', LHsQTyVars (GhcPass 'Parsed)
tvs') <- [Type]
-> Name
-> [TyVarBndr ()]
-> CvtM
     (LHsContext (GhcPass 'Parsed), GenLocated SrcSpanAnnN RdrName,
      LHsQTyVars (GhcPass 'Parsed))
cvt_tycl_hdr [Type]
ctxt Name
tc [TyVarBndr ()]
tvs
        ; Maybe (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
ksig' <- Type -> CvtM (LHsType (GhcPass 'Parsed))
Type -> CvtM (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
cvtKind (Type -> CvtM (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))))
-> Maybe Type
-> CvtM (Maybe (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
`traverse` Maybe Type
ksig
        ; [GenLocated SrcSpanAnnA (ConDecl (GhcPass 'Parsed))]
cons' <- (Con -> CvtM (GenLocated SrcSpanAnnA (ConDecl (GhcPass 'Parsed))))
-> [Con]
-> CvtM [GenLocated SrcSpanAnnA (ConDecl (GhcPass 'Parsed))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Con -> CvtM (LConDecl (GhcPass 'Parsed))
Con -> CvtM (GenLocated SrcSpanAnnA (ConDecl (GhcPass 'Parsed)))
cvtConstr [Con]
constrs
        ; [GenLocated (SrcAnn NoEpAnns) (HsDerivingClause (GhcPass 'Parsed))]
derivs' <- [DerivClause] -> CvtM (HsDeriving (GhcPass 'Parsed))
cvtDerivs [DerivClause]
derivs
        ; let defn :: HsDataDefn (GhcPass 'Parsed)
defn = HsDataDefn { dd_ext :: XCHsDataDefn (GhcPass 'Parsed)
dd_ext = XCHsDataDefn (GhcPass 'Parsed)
NoExtField
noExtField
                                , dd_ND :: NewOrData
dd_ND = NewOrData
DataType, dd_cType :: Maybe (XRec (GhcPass 'Parsed) CType)
dd_cType = Maybe (XRec (GhcPass 'Parsed) CType)
Maybe (GenLocated SrcSpanAnnP CType)
forall a. Maybe a
Nothing
                                , dd_ctxt :: Maybe (LHsContext (GhcPass 'Parsed))
dd_ctxt = LHsContext (GhcPass 'Parsed)
-> Maybe (LHsContext (GhcPass 'Parsed))
mkHsContextMaybe LHsContext (GhcPass 'Parsed)
GenLocated
  SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
ctxt'
                                , dd_kindSig :: Maybe (LHsType (GhcPass 'Parsed))
dd_kindSig = Maybe (LHsType (GhcPass 'Parsed))
Maybe (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
ksig'
                                , dd_cons :: [LConDecl (GhcPass 'Parsed)]
dd_cons = [LConDecl (GhcPass 'Parsed)]
[GenLocated SrcSpanAnnA (ConDecl (GhcPass 'Parsed))]
cons', dd_derivs :: HsDeriving (GhcPass 'Parsed)
dd_derivs = HsDeriving (GhcPass 'Parsed)
[GenLocated (SrcAnn NoEpAnns) (HsDerivingClause (GhcPass 'Parsed))]
derivs' }
        ; HsDecl (GhcPass 'Parsed)
-> CvtM (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))))
forall a. a -> CvtM (Maybe (LocatedA a))
returnJustLA (HsDecl (GhcPass 'Parsed)
 -> CvtM
      (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed)))))
-> HsDecl (GhcPass 'Parsed)
-> CvtM (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))))
forall a b. (a -> b) -> a -> b
$ XTyClD (GhcPass 'Parsed)
-> TyClDecl (GhcPass 'Parsed) -> HsDecl (GhcPass 'Parsed)
forall p. XTyClD p -> TyClDecl p -> HsDecl p
TyClD XTyClD (GhcPass 'Parsed)
NoExtField
noExtField (TyClDecl (GhcPass 'Parsed) -> HsDecl (GhcPass 'Parsed))
-> TyClDecl (GhcPass 'Parsed) -> HsDecl (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$
          DataDecl { tcdDExt :: XDataDecl (GhcPass 'Parsed)
tcdDExt = XDataDecl (GhcPass 'Parsed)
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn
                   , tcdLName :: LIdP (GhcPass 'Parsed)
tcdLName = LIdP (GhcPass 'Parsed)
GenLocated SrcSpanAnnN RdrName
tc', tcdTyVars :: LHsQTyVars (GhcPass 'Parsed)
tcdTyVars = LHsQTyVars (GhcPass 'Parsed)
tvs'
                   , tcdFixity :: LexicalFixity
tcdFixity = LexicalFixity
Prefix
                   , tcdDataDefn :: HsDataDefn (GhcPass 'Parsed)
tcdDataDefn = HsDataDefn (GhcPass 'Parsed)
defn } }

cvtDec (NewtypeD [Type]
ctxt Name
tc [TyVarBndr ()]
tvs Maybe Type
ksig Con
constr [DerivClause]
derivs)
  = do  { (GenLocated
  SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
ctxt', GenLocated SrcSpanAnnN RdrName
tc', LHsQTyVars (GhcPass 'Parsed)
tvs') <- [Type]
-> Name
-> [TyVarBndr ()]
-> CvtM
     (LHsContext (GhcPass 'Parsed), GenLocated SrcSpanAnnN RdrName,
      LHsQTyVars (GhcPass 'Parsed))
cvt_tycl_hdr [Type]
ctxt Name
tc [TyVarBndr ()]
tvs
        ; Maybe (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
ksig' <- Type -> CvtM (LHsType (GhcPass 'Parsed))
Type -> CvtM (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
cvtKind (Type -> CvtM (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))))
-> Maybe Type
-> CvtM (Maybe (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
`traverse` Maybe Type
ksig
        ; GenLocated SrcSpanAnnA (ConDecl (GhcPass 'Parsed))
con' <- Con -> CvtM (LConDecl (GhcPass 'Parsed))
cvtConstr Con
constr
        ; [GenLocated (SrcAnn NoEpAnns) (HsDerivingClause (GhcPass 'Parsed))]
derivs' <- [DerivClause] -> CvtM (HsDeriving (GhcPass 'Parsed))
cvtDerivs [DerivClause]
derivs
        ; let defn :: HsDataDefn (GhcPass 'Parsed)
defn = HsDataDefn { dd_ext :: XCHsDataDefn (GhcPass 'Parsed)
dd_ext = XCHsDataDefn (GhcPass 'Parsed)
NoExtField
noExtField
                                , dd_ND :: NewOrData
dd_ND = NewOrData
NewType, dd_cType :: Maybe (XRec (GhcPass 'Parsed) CType)
dd_cType = Maybe (XRec (GhcPass 'Parsed) CType)
Maybe (GenLocated SrcSpanAnnP CType)
forall a. Maybe a
Nothing
                                , dd_ctxt :: Maybe (LHsContext (GhcPass 'Parsed))
dd_ctxt = LHsContext (GhcPass 'Parsed)
-> Maybe (LHsContext (GhcPass 'Parsed))
mkHsContextMaybe LHsContext (GhcPass 'Parsed)
GenLocated
  SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
ctxt'
                                , dd_kindSig :: Maybe (LHsType (GhcPass 'Parsed))
dd_kindSig = Maybe (LHsType (GhcPass 'Parsed))
Maybe (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
ksig'
                                , dd_cons :: [LConDecl (GhcPass 'Parsed)]
dd_cons = [LConDecl (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (ConDecl (GhcPass 'Parsed))
con']
                                , dd_derivs :: HsDeriving (GhcPass 'Parsed)
dd_derivs = HsDeriving (GhcPass 'Parsed)
[GenLocated (SrcAnn NoEpAnns) (HsDerivingClause (GhcPass 'Parsed))]
derivs' }
        ; HsDecl (GhcPass 'Parsed)
-> CvtM (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))))
forall a. a -> CvtM (Maybe (LocatedA a))
returnJustLA (HsDecl (GhcPass 'Parsed)
 -> CvtM
      (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed)))))
-> HsDecl (GhcPass 'Parsed)
-> CvtM (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))))
forall a b. (a -> b) -> a -> b
$ XTyClD (GhcPass 'Parsed)
-> TyClDecl (GhcPass 'Parsed) -> HsDecl (GhcPass 'Parsed)
forall p. XTyClD p -> TyClDecl p -> HsDecl p
TyClD XTyClD (GhcPass 'Parsed)
NoExtField
noExtField (TyClDecl (GhcPass 'Parsed) -> HsDecl (GhcPass 'Parsed))
-> TyClDecl (GhcPass 'Parsed) -> HsDecl (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$
          DataDecl { tcdDExt :: XDataDecl (GhcPass 'Parsed)
tcdDExt = XDataDecl (GhcPass 'Parsed)
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn
                   , tcdLName :: LIdP (GhcPass 'Parsed)
tcdLName = LIdP (GhcPass 'Parsed)
GenLocated SrcSpanAnnN RdrName
tc', tcdTyVars :: LHsQTyVars (GhcPass 'Parsed)
tcdTyVars = LHsQTyVars (GhcPass 'Parsed)
tvs'
                   , tcdFixity :: LexicalFixity
tcdFixity = LexicalFixity
Prefix
                   , tcdDataDefn :: HsDataDefn (GhcPass 'Parsed)
tcdDataDefn = HsDataDefn (GhcPass 'Parsed)
defn } }

cvtDec (ClassD [Type]
ctxt Name
cl [TyVarBndr ()]
tvs [FunDep]
fds [Dec]
decs)
  = do  { (GenLocated
  SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
cxt', GenLocated SrcSpanAnnN RdrName
tc', LHsQTyVars (GhcPass 'Parsed)
tvs') <- [Type]
-> Name
-> [TyVarBndr ()]
-> CvtM
     (LHsContext (GhcPass 'Parsed), GenLocated SrcSpanAnnN RdrName,
      LHsQTyVars (GhcPass 'Parsed))
cvt_tycl_hdr [Type]
ctxt Name
cl [TyVarBndr ()]
tvs
        ; [GenLocated SrcSpanAnnA (FunDep (GhcPass 'Parsed))]
fds'  <- (FunDep
 -> CvtM (GenLocated SrcSpanAnnA (FunDep (GhcPass 'Parsed))))
-> [FunDep]
-> CvtM [GenLocated SrcSpanAnnA (FunDep (GhcPass 'Parsed))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM FunDep -> CvtM (LHsFunDep (GhcPass 'Parsed))
FunDep -> CvtM (GenLocated SrcSpanAnnA (FunDep (GhcPass 'Parsed)))
cvt_fundep [FunDep]
fds
        ; (Bag (GenLocated SrcSpanAnnA (HsBind (GhcPass 'Parsed)))
binds', [GenLocated SrcSpanAnnA (Sig (GhcPass 'Parsed))]
sigs', [GenLocated SrcSpanAnnA (FamilyDecl (GhcPass 'Parsed))]
fams', [GenLocated SrcSpanAnnA (TyFamInstDecl (GhcPass 'Parsed))]
at_defs', [GenLocated SrcSpanAnnA (DataFamInstDecl (GhcPass 'Parsed))]
adts') <- SDoc
-> [Dec]
-> CvtM
     (LHsBinds (GhcPass 'Parsed), [LSig (GhcPass 'Parsed)],
      [LFamilyDecl (GhcPass 'Parsed)],
      [LTyFamInstDecl (GhcPass 'Parsed)],
      [LDataFamInstDecl (GhcPass 'Parsed)])
cvt_ci_decs (String -> SDoc
text String
"a class declaration") [Dec]
decs
        ; Bool -> CvtM () -> CvtM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([GenLocated SrcSpanAnnA (DataFamInstDecl (GhcPass 'Parsed))]
-> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GenLocated SrcSpanAnnA (DataFamInstDecl (GhcPass 'Parsed))]
adts')
            (SDoc -> CvtM ()
forall a. SDoc -> CvtM a
failWith (SDoc -> CvtM ()) -> SDoc -> CvtM ()
forall a b. (a -> b) -> a -> b
$ (String -> SDoc
text String
"Default data instance declarations"
                     SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"are not allowed:")
                   SDoc -> SDoc -> SDoc
$$ ([GenLocated SrcSpanAnnA (DataFamInstDecl (GhcPass 'Parsed))]
-> SDoc
forall a. Outputable a => a -> SDoc
Outputable.ppr [GenLocated SrcSpanAnnA (DataFamInstDecl (GhcPass 'Parsed))]
adts'))
        ; HsDecl (GhcPass 'Parsed)
-> CvtM (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))))
forall a. a -> CvtM (Maybe (LocatedA a))
returnJustLA (HsDecl (GhcPass 'Parsed)
 -> CvtM
      (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed)))))
-> HsDecl (GhcPass 'Parsed)
-> CvtM (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))))
forall a b. (a -> b) -> a -> b
$ XTyClD (GhcPass 'Parsed)
-> TyClDecl (GhcPass 'Parsed) -> HsDecl (GhcPass 'Parsed)
forall p. XTyClD p -> TyClDecl p -> HsDecl p
TyClD XTyClD (GhcPass 'Parsed)
NoExtField
noExtField (TyClDecl (GhcPass 'Parsed) -> HsDecl (GhcPass 'Parsed))
-> TyClDecl (GhcPass 'Parsed) -> HsDecl (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$
          ClassDecl { tcdCExt :: XClassDecl (GhcPass 'Parsed)
tcdCExt = (EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn, AnnSortKey
NoAnnSortKey, LayoutInfo
NoLayoutInfo)
                    , tcdCtxt :: Maybe (LHsContext (GhcPass 'Parsed))
tcdCtxt = LHsContext (GhcPass 'Parsed)
-> Maybe (LHsContext (GhcPass 'Parsed))
mkHsContextMaybe LHsContext (GhcPass 'Parsed)
GenLocated
  SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
cxt', tcdLName :: LIdP (GhcPass 'Parsed)
tcdLName = LIdP (GhcPass 'Parsed)
GenLocated SrcSpanAnnN RdrName
tc', tcdTyVars :: LHsQTyVars (GhcPass 'Parsed)
tcdTyVars = LHsQTyVars (GhcPass 'Parsed)
tvs'
                    , tcdFixity :: LexicalFixity
tcdFixity = LexicalFixity
Prefix
                    , tcdFDs :: [LHsFunDep (GhcPass 'Parsed)]
tcdFDs = [LHsFunDep (GhcPass 'Parsed)]
[GenLocated SrcSpanAnnA (FunDep (GhcPass 'Parsed))]
fds', tcdSigs :: [LSig (GhcPass 'Parsed)]
tcdSigs = [LSig (GhcPass 'Parsed)] -> [LSig (GhcPass 'Parsed)]
Hs.mkClassOpSigs [LSig (GhcPass 'Parsed)]
[GenLocated SrcSpanAnnA (Sig (GhcPass 'Parsed))]
sigs'
                    , tcdMeths :: LHsBinds (GhcPass 'Parsed)
tcdMeths = LHsBinds (GhcPass 'Parsed)
Bag (GenLocated SrcSpanAnnA (HsBind (GhcPass 'Parsed)))
binds'
                    , tcdATs :: [LFamilyDecl (GhcPass 'Parsed)]
tcdATs = [LFamilyDecl (GhcPass 'Parsed)]
[GenLocated SrcSpanAnnA (FamilyDecl (GhcPass 'Parsed))]
fams', tcdATDefs :: [LTyFamInstDecl (GhcPass 'Parsed)]
tcdATDefs = [LTyFamInstDecl (GhcPass 'Parsed)]
[GenLocated SrcSpanAnnA (TyFamInstDecl (GhcPass 'Parsed))]
at_defs', tcdDocs :: [LDocDecl (GhcPass 'Parsed)]
tcdDocs = [] }
                              -- no docs in TH ^^
        }

cvtDec (InstanceD Maybe Overlap
o [Type]
ctxt Type
ty [Dec]
decs)
  = do  { let doc :: SDoc
doc = String -> SDoc
text String
"an instance declaration"
        ; (Bag (GenLocated SrcSpanAnnA (HsBind (GhcPass 'Parsed)))
binds', [GenLocated SrcSpanAnnA (Sig (GhcPass 'Parsed))]
sigs', [GenLocated SrcSpanAnnA (FamilyDecl (GhcPass 'Parsed))]
fams', [GenLocated SrcSpanAnnA (TyFamInstDecl (GhcPass 'Parsed))]
ats', [GenLocated SrcSpanAnnA (DataFamInstDecl (GhcPass 'Parsed))]
adts') <- SDoc
-> [Dec]
-> CvtM
     (LHsBinds (GhcPass 'Parsed), [LSig (GhcPass 'Parsed)],
      [LFamilyDecl (GhcPass 'Parsed)],
      [LTyFamInstDecl (GhcPass 'Parsed)],
      [LDataFamInstDecl (GhcPass 'Parsed)])
cvt_ci_decs SDoc
doc [Dec]
decs
        ; Bool -> CvtM () -> CvtM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([GenLocated SrcSpanAnnA (FamilyDecl (GhcPass 'Parsed))] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GenLocated SrcSpanAnnA (FamilyDecl (GhcPass 'Parsed))]
fams') (SDoc -> CvtM ()
forall a. SDoc -> CvtM a
failWith (SDoc
-> [GenLocated SrcSpanAnnA (FamilyDecl (GhcPass 'Parsed))] -> SDoc
forall a. Outputable a => SDoc -> [a] -> SDoc
mkBadDecMsg SDoc
doc [GenLocated SrcSpanAnnA (FamilyDecl (GhcPass 'Parsed))]
fams'))
        ; GenLocated
  SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
ctxt' <- PprPrec -> [Type] -> CvtM (LHsContext (GhcPass 'Parsed))
cvtContext PprPrec
funPrec [Type]
ctxt
        ; (L SrcSpanAnnA
loc HsType (GhcPass 'Parsed)
ty') <- Type -> CvtM (LHsType (GhcPass 'Parsed))
cvtType Type
ty
        ; let inst_ty' :: GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Parsed))
inst_ty' = SrcSpanAnnA
-> HsSigType (GhcPass 'Parsed)
-> GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Parsed))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc (HsSigType (GhcPass 'Parsed)
 -> GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Parsed)))
-> HsSigType (GhcPass 'Parsed)
-> GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ LHsType (GhcPass 'Parsed) -> HsSigType (GhcPass 'Parsed)
mkHsImplicitSigType (LHsType (GhcPass 'Parsed) -> HsSigType (GhcPass 'Parsed))
-> LHsType (GhcPass 'Parsed) -> HsSigType (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$
                         [Type]
-> SrcSpanAnnA
-> LHsContext (GhcPass 'Parsed)
-> LHsType (GhcPass 'Parsed)
-> LHsType (GhcPass 'Parsed)
mkHsQualTy [Type]
ctxt SrcSpanAnnA
loc LHsContext (GhcPass 'Parsed)
GenLocated
  SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
ctxt' (LHsType (GhcPass 'Parsed) -> LHsType (GhcPass 'Parsed))
-> LHsType (GhcPass 'Parsed) -> LHsType (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA
-> HsType (GhcPass 'Parsed)
-> GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc HsType (GhcPass 'Parsed)
ty'
        ; HsDecl (GhcPass 'Parsed)
-> CvtM (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))))
forall a. a -> CvtM (Maybe (LocatedA a))
returnJustLA (HsDecl (GhcPass 'Parsed)
 -> CvtM
      (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed)))))
-> HsDecl (GhcPass 'Parsed)
-> CvtM (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))))
forall a b. (a -> b) -> a -> b
$ XInstD (GhcPass 'Parsed)
-> InstDecl (GhcPass 'Parsed) -> HsDecl (GhcPass 'Parsed)
forall p. XInstD p -> InstDecl p -> HsDecl p
InstD XInstD (GhcPass 'Parsed)
NoExtField
noExtField (InstDecl (GhcPass 'Parsed) -> HsDecl (GhcPass 'Parsed))
-> InstDecl (GhcPass 'Parsed) -> HsDecl (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$ XClsInstD (GhcPass 'Parsed)
-> ClsInstDecl (GhcPass 'Parsed) -> InstDecl (GhcPass 'Parsed)
forall pass. XClsInstD pass -> ClsInstDecl pass -> InstDecl pass
ClsInstD XClsInstD (GhcPass 'Parsed)
NoExtField
noExtField (ClsInstDecl (GhcPass 'Parsed) -> InstDecl (GhcPass 'Parsed))
-> ClsInstDecl (GhcPass 'Parsed) -> InstDecl (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$
          ClsInstDecl { cid_ext :: XCClsInstDecl (GhcPass 'Parsed)
cid_ext = (EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn, AnnSortKey
NoAnnSortKey), cid_poly_ty :: LHsSigType (GhcPass 'Parsed)
cid_poly_ty = LHsSigType (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Parsed))
inst_ty'
                      , cid_binds :: LHsBinds (GhcPass 'Parsed)
cid_binds = LHsBinds (GhcPass 'Parsed)
Bag (GenLocated SrcSpanAnnA (HsBind (GhcPass 'Parsed)))
binds'
                      , cid_sigs :: [LSig (GhcPass 'Parsed)]
cid_sigs = [LSig (GhcPass 'Parsed)] -> [LSig (GhcPass 'Parsed)]
Hs.mkClassOpSigs [LSig (GhcPass 'Parsed)]
[GenLocated SrcSpanAnnA (Sig (GhcPass 'Parsed))]
sigs'
                      , cid_tyfam_insts :: [LTyFamInstDecl (GhcPass 'Parsed)]
cid_tyfam_insts = [LTyFamInstDecl (GhcPass 'Parsed)]
[GenLocated SrcSpanAnnA (TyFamInstDecl (GhcPass 'Parsed))]
ats', cid_datafam_insts :: [LDataFamInstDecl (GhcPass 'Parsed)]
cid_datafam_insts = [LDataFamInstDecl (GhcPass 'Parsed)]
[GenLocated SrcSpanAnnA (DataFamInstDecl (GhcPass 'Parsed))]
adts'
                      , cid_overlap_mode :: Maybe (XRec (GhcPass 'Parsed) OverlapMode)
cid_overlap_mode
                                   = (Overlap -> GenLocated SrcSpanAnnP OverlapMode)
-> Maybe Overlap -> Maybe (GenLocated SrcSpanAnnP OverlapMode)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SrcSpanAnnP -> OverlapMode -> GenLocated SrcSpanAnnP OverlapMode
forall l e. l -> e -> GenLocated l e
L (SrcSpanAnnA -> SrcSpanAnnP
forall a ann. SrcSpanAnn' a -> SrcAnn ann
l2l SrcSpanAnnA
loc) (OverlapMode -> GenLocated SrcSpanAnnP OverlapMode)
-> (Overlap -> OverlapMode)
-> Overlap
-> GenLocated SrcSpanAnnP OverlapMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Overlap -> OverlapMode
overlap) Maybe Overlap
o } }
  where
  overlap :: Overlap -> OverlapMode
overlap Overlap
pragma =
    case Overlap
pragma of
      Overlap
TH.Overlaps      -> SourceText -> OverlapMode
Hs.Overlaps     (String -> SourceText
SourceText String
"OVERLAPS")
      Overlap
TH.Overlappable  -> SourceText -> OverlapMode
Hs.Overlappable (String -> SourceText
SourceText String
"OVERLAPPABLE")
      Overlap
TH.Overlapping   -> SourceText -> OverlapMode
Hs.Overlapping  (String -> SourceText
SourceText String
"OVERLAPPING")
      Overlap
TH.Incoherent    -> SourceText -> OverlapMode
Hs.Incoherent   (String -> SourceText
SourceText String
"INCOHERENT")




cvtDec (ForeignD Foreign
ford)
  = do { ForeignDecl (GhcPass 'Parsed)
ford' <- Foreign -> CvtM (ForeignDecl (GhcPass 'Parsed))
cvtForD Foreign
ford
       ; HsDecl (GhcPass 'Parsed)
-> CvtM (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))))
forall a. a -> CvtM (Maybe (LocatedA a))
returnJustLA (HsDecl (GhcPass 'Parsed)
 -> CvtM
      (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed)))))
-> HsDecl (GhcPass 'Parsed)
-> CvtM (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))))
forall a b. (a -> b) -> a -> b
$ XForD (GhcPass 'Parsed)
-> ForeignDecl (GhcPass 'Parsed) -> HsDecl (GhcPass 'Parsed)
forall p. XForD p -> ForeignDecl p -> HsDecl p
ForD XForD (GhcPass 'Parsed)
NoExtField
noExtField ForeignDecl (GhcPass 'Parsed)
ford' }

cvtDec (DataFamilyD Name
tc [TyVarBndr ()]
tvs Maybe Type
kind)
  = do { (GenLocated
  SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
_, GenLocated SrcSpanAnnN RdrName
tc', LHsQTyVars (GhcPass 'Parsed)
tvs') <- [Type]
-> Name
-> [TyVarBndr ()]
-> CvtM
     (LHsContext (GhcPass 'Parsed), GenLocated SrcSpanAnnN RdrName,
      LHsQTyVars (GhcPass 'Parsed))
cvt_tycl_hdr [] Name
tc [TyVarBndr ()]
tvs
       ; GenLocated (SrcAnn NoEpAnns) (FamilyResultSig (GhcPass 'Parsed))
result <- Maybe Type -> CvtM (LFamilyResultSig (GhcPass 'Parsed))
cvtMaybeKindToFamilyResultSig Maybe Type
kind
       ; HsDecl (GhcPass 'Parsed)
-> CvtM (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))))
forall a. a -> CvtM (Maybe (LocatedA a))
returnJustLA (HsDecl (GhcPass 'Parsed)
 -> CvtM
      (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed)))))
-> HsDecl (GhcPass 'Parsed)
-> CvtM (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))))
forall a b. (a -> b) -> a -> b
$ XTyClD (GhcPass 'Parsed)
-> TyClDecl (GhcPass 'Parsed) -> HsDecl (GhcPass 'Parsed)
forall p. XTyClD p -> TyClDecl p -> HsDecl p
TyClD XTyClD (GhcPass 'Parsed)
NoExtField
noExtField (TyClDecl (GhcPass 'Parsed) -> HsDecl (GhcPass 'Parsed))
-> TyClDecl (GhcPass 'Parsed) -> HsDecl (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$ XFamDecl (GhcPass 'Parsed)
-> FamilyDecl (GhcPass 'Parsed) -> TyClDecl (GhcPass 'Parsed)
forall pass. XFamDecl pass -> FamilyDecl pass -> TyClDecl pass
FamDecl XFamDecl (GhcPass 'Parsed)
NoExtField
noExtField (FamilyDecl (GhcPass 'Parsed) -> TyClDecl (GhcPass 'Parsed))
-> FamilyDecl (GhcPass 'Parsed) -> TyClDecl (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$
         XCFamilyDecl (GhcPass 'Parsed)
-> FamilyInfo (GhcPass 'Parsed)
-> TopLevelFlag
-> LIdP (GhcPass 'Parsed)
-> LHsQTyVars (GhcPass 'Parsed)
-> LexicalFixity
-> LFamilyResultSig (GhcPass 'Parsed)
-> Maybe (LInjectivityAnn (GhcPass 'Parsed))
-> FamilyDecl (GhcPass 'Parsed)
forall pass.
XCFamilyDecl pass
-> FamilyInfo pass
-> TopLevelFlag
-> LIdP pass
-> LHsQTyVars pass
-> LexicalFixity
-> LFamilyResultSig pass
-> Maybe (LInjectivityAnn pass)
-> FamilyDecl pass
FamilyDecl XCFamilyDecl (GhcPass 'Parsed)
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn FamilyInfo (GhcPass 'Parsed)
forall pass. FamilyInfo pass
DataFamily TopLevelFlag
TopLevel LIdP (GhcPass 'Parsed)
GenLocated SrcSpanAnnN RdrName
tc' LHsQTyVars (GhcPass 'Parsed)
tvs' LexicalFixity
Prefix LFamilyResultSig (GhcPass 'Parsed)
GenLocated (SrcAnn NoEpAnns) (FamilyResultSig (GhcPass 'Parsed))
result Maybe (LInjectivityAnn (GhcPass 'Parsed))
Maybe
  (GenLocated (SrcAnn NoEpAnns) (InjectivityAnn (GhcPass 'Parsed)))
forall a. Maybe a
Nothing }

cvtDec (DataInstD [Type]
ctxt Maybe [TyVarBndr ()]
bndrs Type
tys Maybe Type
ksig [Con]
constrs [DerivClause]
derivs)
  = do { (GenLocated
  SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
ctxt', GenLocated SrcSpanAnnN RdrName
tc', HsOuterFamEqnTyVarBndrs (GhcPass 'Parsed)
bndrs', [HsArg
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))]
typats') <- [Type]
-> Maybe [TyVarBndr ()]
-> Type
-> CvtM
     (LHsContext (GhcPass 'Parsed), GenLocated SrcSpanAnnN RdrName,
      HsOuterFamEqnTyVarBndrs (GhcPass 'Parsed),
      HsTyPats (GhcPass 'Parsed))
cvt_datainst_hdr [Type]
ctxt Maybe [TyVarBndr ()]
bndrs Type
tys
       ; Maybe (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
ksig' <- Type -> CvtM (LHsType (GhcPass 'Parsed))
Type -> CvtM (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
cvtKind (Type -> CvtM (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))))
-> Maybe Type
-> CvtM (Maybe (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
`traverse` Maybe Type
ksig
       ; [GenLocated SrcSpanAnnA (ConDecl (GhcPass 'Parsed))]
cons' <- (Con -> CvtM (GenLocated SrcSpanAnnA (ConDecl (GhcPass 'Parsed))))
-> [Con]
-> CvtM [GenLocated SrcSpanAnnA (ConDecl (GhcPass 'Parsed))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Con -> CvtM (LConDecl (GhcPass 'Parsed))
Con -> CvtM (GenLocated SrcSpanAnnA (ConDecl (GhcPass 'Parsed)))
cvtConstr [Con]
constrs
       ; [GenLocated (SrcAnn NoEpAnns) (HsDerivingClause (GhcPass 'Parsed))]
derivs' <- [DerivClause] -> CvtM (HsDeriving (GhcPass 'Parsed))
cvtDerivs [DerivClause]
derivs
       ; let defn :: HsDataDefn (GhcPass 'Parsed)
defn = HsDataDefn { dd_ext :: XCHsDataDefn (GhcPass 'Parsed)
dd_ext = XCHsDataDefn (GhcPass 'Parsed)
NoExtField
noExtField
                               , dd_ND :: NewOrData
dd_ND = NewOrData
DataType, dd_cType :: Maybe (XRec (GhcPass 'Parsed) CType)
dd_cType = Maybe (XRec (GhcPass 'Parsed) CType)
Maybe (GenLocated SrcSpanAnnP CType)
forall a. Maybe a
Nothing
                               , dd_ctxt :: Maybe (LHsContext (GhcPass 'Parsed))
dd_ctxt = LHsContext (GhcPass 'Parsed)
-> Maybe (LHsContext (GhcPass 'Parsed))
mkHsContextMaybe LHsContext (GhcPass 'Parsed)
GenLocated
  SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
ctxt'
                               , dd_kindSig :: Maybe (LHsType (GhcPass 'Parsed))
dd_kindSig = Maybe (LHsType (GhcPass 'Parsed))
Maybe (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
ksig'
                               , dd_cons :: [LConDecl (GhcPass 'Parsed)]
dd_cons = [LConDecl (GhcPass 'Parsed)]
[GenLocated SrcSpanAnnA (ConDecl (GhcPass 'Parsed))]
cons', dd_derivs :: HsDeriving (GhcPass 'Parsed)
dd_derivs = HsDeriving (GhcPass 'Parsed)
[GenLocated (SrcAnn NoEpAnns) (HsDerivingClause (GhcPass 'Parsed))]
derivs' }

       ; HsDecl (GhcPass 'Parsed)
-> CvtM (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))))
forall a. a -> CvtM (Maybe (LocatedA a))
returnJustLA (HsDecl (GhcPass 'Parsed)
 -> CvtM
      (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed)))))
-> HsDecl (GhcPass 'Parsed)
-> CvtM (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))))
forall a b. (a -> b) -> a -> b
$ XInstD (GhcPass 'Parsed)
-> InstDecl (GhcPass 'Parsed) -> HsDecl (GhcPass 'Parsed)
forall p. XInstD p -> InstDecl p -> HsDecl p
InstD XInstD (GhcPass 'Parsed)
NoExtField
noExtField (InstDecl (GhcPass 'Parsed) -> HsDecl (GhcPass 'Parsed))
-> InstDecl (GhcPass 'Parsed) -> HsDecl (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$ DataFamInstD
           { dfid_ext :: XDataFamInstD (GhcPass 'Parsed)
dfid_ext = XDataFamInstD (GhcPass 'Parsed)
NoExtField
noExtField
           , dfid_inst :: DataFamInstDecl (GhcPass 'Parsed)
dfid_inst = DataFamInstDecl { dfid_eqn :: FamEqn (GhcPass 'Parsed) (HsDataDefn (GhcPass 'Parsed))
dfid_eqn =
                           FamEqn { feqn_ext :: XCFamEqn (GhcPass 'Parsed) (HsDataDefn (GhcPass 'Parsed))
feqn_ext = XCFamEqn (GhcPass 'Parsed) (HsDataDefn (GhcPass 'Parsed))
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn
                                  , feqn_tycon :: LIdP (GhcPass 'Parsed)
feqn_tycon = LIdP (GhcPass 'Parsed)
GenLocated SrcSpanAnnN RdrName
tc'
                                  , feqn_bndrs :: HsOuterFamEqnTyVarBndrs (GhcPass 'Parsed)
feqn_bndrs = HsOuterFamEqnTyVarBndrs (GhcPass 'Parsed)
bndrs'
                                  , feqn_pats :: HsTyPats (GhcPass 'Parsed)
feqn_pats = HsTyPats (GhcPass 'Parsed)
[HsArg
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))]
typats'
                                  , feqn_rhs :: HsDataDefn (GhcPass 'Parsed)
feqn_rhs = HsDataDefn (GhcPass 'Parsed)
defn
                                  , feqn_fixity :: LexicalFixity
feqn_fixity = LexicalFixity
Prefix } }}}

cvtDec (NewtypeInstD [Type]
ctxt Maybe [TyVarBndr ()]
bndrs Type
tys Maybe Type
ksig Con
constr [DerivClause]
derivs)
  = do { (GenLocated
  SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
ctxt', GenLocated SrcSpanAnnN RdrName
tc', HsOuterFamEqnTyVarBndrs (GhcPass 'Parsed)
bndrs', [HsArg
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))]
typats') <- [Type]
-> Maybe [TyVarBndr ()]
-> Type
-> CvtM
     (LHsContext (GhcPass 'Parsed), GenLocated SrcSpanAnnN RdrName,
      HsOuterFamEqnTyVarBndrs (GhcPass 'Parsed),
      HsTyPats (GhcPass 'Parsed))
cvt_datainst_hdr [Type]
ctxt Maybe [TyVarBndr ()]
bndrs Type
tys
       ; Maybe (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
ksig' <- Type -> CvtM (LHsType (GhcPass 'Parsed))
Type -> CvtM (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
cvtKind (Type -> CvtM (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))))
-> Maybe Type
-> CvtM (Maybe (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
`traverse` Maybe Type
ksig
       ; GenLocated SrcSpanAnnA (ConDecl (GhcPass 'Parsed))
con' <- Con -> CvtM (LConDecl (GhcPass 'Parsed))
cvtConstr Con
constr
       ; [GenLocated (SrcAnn NoEpAnns) (HsDerivingClause (GhcPass 'Parsed))]
derivs' <- [DerivClause] -> CvtM (HsDeriving (GhcPass 'Parsed))
cvtDerivs [DerivClause]
derivs
       ; let defn :: HsDataDefn (GhcPass 'Parsed)
defn = HsDataDefn { dd_ext :: XCHsDataDefn (GhcPass 'Parsed)
dd_ext = XCHsDataDefn (GhcPass 'Parsed)
NoExtField
noExtField
                               , dd_ND :: NewOrData
dd_ND = NewOrData
NewType, dd_cType :: Maybe (XRec (GhcPass 'Parsed) CType)
dd_cType = Maybe (XRec (GhcPass 'Parsed) CType)
Maybe (GenLocated SrcSpanAnnP CType)
forall a. Maybe a
Nothing
                               , dd_ctxt :: Maybe (LHsContext (GhcPass 'Parsed))
dd_ctxt = LHsContext (GhcPass 'Parsed)
-> Maybe (LHsContext (GhcPass 'Parsed))
mkHsContextMaybe LHsContext (GhcPass 'Parsed)
GenLocated
  SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
ctxt'
                               , dd_kindSig :: Maybe (LHsType (GhcPass 'Parsed))
dd_kindSig = Maybe (LHsType (GhcPass 'Parsed))
Maybe (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
ksig'
                               , dd_cons :: [LConDecl (GhcPass 'Parsed)]
dd_cons = [LConDecl (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (ConDecl (GhcPass 'Parsed))
con'], dd_derivs :: HsDeriving (GhcPass 'Parsed)
dd_derivs = HsDeriving (GhcPass 'Parsed)
[GenLocated (SrcAnn NoEpAnns) (HsDerivingClause (GhcPass 'Parsed))]
derivs' }
       ; HsDecl (GhcPass 'Parsed)
-> CvtM (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))))
forall a. a -> CvtM (Maybe (LocatedA a))
returnJustLA (HsDecl (GhcPass 'Parsed)
 -> CvtM
      (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed)))))
-> HsDecl (GhcPass 'Parsed)
-> CvtM (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))))
forall a b. (a -> b) -> a -> b
$ XInstD (GhcPass 'Parsed)
-> InstDecl (GhcPass 'Parsed) -> HsDecl (GhcPass 'Parsed)
forall p. XInstD p -> InstDecl p -> HsDecl p
InstD XInstD (GhcPass 'Parsed)
NoExtField
noExtField (InstDecl (GhcPass 'Parsed) -> HsDecl (GhcPass 'Parsed))
-> InstDecl (GhcPass 'Parsed) -> HsDecl (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$ DataFamInstD
           { dfid_ext :: XDataFamInstD (GhcPass 'Parsed)
dfid_ext = XDataFamInstD (GhcPass 'Parsed)
NoExtField
noExtField
           , dfid_inst :: DataFamInstDecl (GhcPass 'Parsed)
dfid_inst = DataFamInstDecl { dfid_eqn :: FamEqn (GhcPass 'Parsed) (HsDataDefn (GhcPass 'Parsed))
dfid_eqn =
                           FamEqn { feqn_ext :: XCFamEqn (GhcPass 'Parsed) (HsDataDefn (GhcPass 'Parsed))
feqn_ext = XCFamEqn (GhcPass 'Parsed) (HsDataDefn (GhcPass 'Parsed))
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn
                                  , feqn_tycon :: LIdP (GhcPass 'Parsed)
feqn_tycon = LIdP (GhcPass 'Parsed)
GenLocated SrcSpanAnnN RdrName
tc'
                                  , feqn_bndrs :: HsOuterFamEqnTyVarBndrs (GhcPass 'Parsed)
feqn_bndrs = HsOuterFamEqnTyVarBndrs (GhcPass 'Parsed)
bndrs'
                                  , feqn_pats :: HsTyPats (GhcPass 'Parsed)
feqn_pats = HsTyPats (GhcPass 'Parsed)
[HsArg
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))]
typats'
                                  , feqn_rhs :: HsDataDefn (GhcPass 'Parsed)
feqn_rhs = HsDataDefn (GhcPass 'Parsed)
defn
                                  , feqn_fixity :: LexicalFixity
feqn_fixity = LexicalFixity
Prefix } }}}

cvtDec (TySynInstD TySynEqn
eqn)
  = do  { (L SrcSpanAnnA
_ FamEqn
  (GhcPass 'Parsed)
  (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
eqn') <- TySynEqn -> CvtM (LTyFamInstEqn (GhcPass 'Parsed))
cvtTySynEqn TySynEqn
eqn
        ; HsDecl (GhcPass 'Parsed)
-> CvtM (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))))
forall a. a -> CvtM (Maybe (LocatedA a))
returnJustLA (HsDecl (GhcPass 'Parsed)
 -> CvtM
      (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed)))))
-> HsDecl (GhcPass 'Parsed)
-> CvtM (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))))
forall a b. (a -> b) -> a -> b
$ XInstD (GhcPass 'Parsed)
-> InstDecl (GhcPass 'Parsed) -> HsDecl (GhcPass 'Parsed)
forall p. XInstD p -> InstDecl p -> HsDecl p
InstD XInstD (GhcPass 'Parsed)
NoExtField
noExtField (InstDecl (GhcPass 'Parsed) -> HsDecl (GhcPass 'Parsed))
-> InstDecl (GhcPass 'Parsed) -> HsDecl (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$ TyFamInstD
            { tfid_ext :: XTyFamInstD (GhcPass 'Parsed)
tfid_ext = XTyFamInstD (GhcPass 'Parsed)
NoExtField
noExtField
            , tfid_inst :: TyFamInstDecl (GhcPass 'Parsed)
tfid_inst = TyFamInstDecl { tfid_xtn :: XCTyFamInstDecl (GhcPass 'Parsed)
tfid_xtn = XCTyFamInstDecl (GhcPass 'Parsed)
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn, tfid_eqn :: TyFamInstEqn (GhcPass 'Parsed)
tfid_eqn = TyFamInstEqn (GhcPass 'Parsed)
FamEqn
  (GhcPass 'Parsed)
  (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
eqn' } }}

cvtDec (OpenTypeFamilyD TypeFamilyHead
head)
  = do { (GenLocated SrcSpanAnnN RdrName
tc', LHsQTyVars (GhcPass 'Parsed)
tyvars', GenLocated (SrcAnn NoEpAnns) (FamilyResultSig (GhcPass 'Parsed))
result', Maybe
  (GenLocated (SrcAnn NoEpAnns) (InjectivityAnn (GhcPass 'Parsed)))
injectivity') <- TypeFamilyHead
-> CvtM
     (GenLocated SrcSpanAnnN RdrName, LHsQTyVars (GhcPass 'Parsed),
      LFamilyResultSig (GhcPass 'Parsed),
      Maybe (LInjectivityAnn (GhcPass 'Parsed)))
cvt_tyfam_head TypeFamilyHead
head
       ; HsDecl (GhcPass 'Parsed)
-> CvtM (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))))
forall a. a -> CvtM (Maybe (LocatedA a))
returnJustLA (HsDecl (GhcPass 'Parsed)
 -> CvtM
      (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed)))))
-> HsDecl (GhcPass 'Parsed)
-> CvtM (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))))
forall a b. (a -> b) -> a -> b
$ XTyClD (GhcPass 'Parsed)
-> TyClDecl (GhcPass 'Parsed) -> HsDecl (GhcPass 'Parsed)
forall p. XTyClD p -> TyClDecl p -> HsDecl p
TyClD XTyClD (GhcPass 'Parsed)
NoExtField
noExtField (TyClDecl (GhcPass 'Parsed) -> HsDecl (GhcPass 'Parsed))
-> TyClDecl (GhcPass 'Parsed) -> HsDecl (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$ XFamDecl (GhcPass 'Parsed)
-> FamilyDecl (GhcPass 'Parsed) -> TyClDecl (GhcPass 'Parsed)
forall pass. XFamDecl pass -> FamilyDecl pass -> TyClDecl pass
FamDecl XFamDecl (GhcPass 'Parsed)
NoExtField
noExtField (FamilyDecl (GhcPass 'Parsed) -> TyClDecl (GhcPass 'Parsed))
-> FamilyDecl (GhcPass 'Parsed) -> TyClDecl (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$
         XCFamilyDecl (GhcPass 'Parsed)
-> FamilyInfo (GhcPass 'Parsed)
-> TopLevelFlag
-> LIdP (GhcPass 'Parsed)
-> LHsQTyVars (GhcPass 'Parsed)
-> LexicalFixity
-> LFamilyResultSig (GhcPass 'Parsed)
-> Maybe (LInjectivityAnn (GhcPass 'Parsed))
-> FamilyDecl (GhcPass 'Parsed)
forall pass.
XCFamilyDecl pass
-> FamilyInfo pass
-> TopLevelFlag
-> LIdP pass
-> LHsQTyVars pass
-> LexicalFixity
-> LFamilyResultSig pass
-> Maybe (LInjectivityAnn pass)
-> FamilyDecl pass
FamilyDecl XCFamilyDecl (GhcPass 'Parsed)
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn FamilyInfo (GhcPass 'Parsed)
forall pass. FamilyInfo pass
OpenTypeFamily TopLevelFlag
TopLevel LIdP (GhcPass 'Parsed)
GenLocated SrcSpanAnnN RdrName
tc' LHsQTyVars (GhcPass 'Parsed)
tyvars' LexicalFixity
Prefix LFamilyResultSig (GhcPass 'Parsed)
GenLocated (SrcAnn NoEpAnns) (FamilyResultSig (GhcPass 'Parsed))
result' Maybe (LInjectivityAnn (GhcPass 'Parsed))
Maybe
  (GenLocated (SrcAnn NoEpAnns) (InjectivityAnn (GhcPass 'Parsed)))
injectivity'
       }

cvtDec (ClosedTypeFamilyD TypeFamilyHead
head [TySynEqn]
eqns)
  = do { (GenLocated SrcSpanAnnN RdrName
tc', LHsQTyVars (GhcPass 'Parsed)
tyvars', GenLocated (SrcAnn NoEpAnns) (FamilyResultSig (GhcPass 'Parsed))
result', Maybe
  (GenLocated (SrcAnn NoEpAnns) (InjectivityAnn (GhcPass 'Parsed)))
injectivity') <- TypeFamilyHead
-> CvtM
     (GenLocated SrcSpanAnnN RdrName, LHsQTyVars (GhcPass 'Parsed),
      LFamilyResultSig (GhcPass 'Parsed),
      Maybe (LInjectivityAnn (GhcPass 'Parsed)))
cvt_tyfam_head TypeFamilyHead
head
       ; [GenLocated
   SrcSpanAnnA
   (FamEqn
      (GhcPass 'Parsed)
      (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))))]
eqns' <- (TySynEqn
 -> CvtM
      (GenLocated
         SrcSpanAnnA
         (FamEqn
            (GhcPass 'Parsed)
            (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))))))
-> [TySynEqn]
-> CvtM
     [GenLocated
        SrcSpanAnnA
        (FamEqn
           (GhcPass 'Parsed)
           (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM TySynEqn -> CvtM (LTyFamInstEqn (GhcPass 'Parsed))
TySynEqn
-> CvtM
     (GenLocated
        SrcSpanAnnA
        (FamEqn
           (GhcPass 'Parsed)
           (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))))
cvtTySynEqn [TySynEqn]
eqns
       ; HsDecl (GhcPass 'Parsed)
-> CvtM (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))))
forall a. a -> CvtM (Maybe (LocatedA a))
returnJustLA (HsDecl (GhcPass 'Parsed)
 -> CvtM
      (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed)))))
-> HsDecl (GhcPass 'Parsed)
-> CvtM (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))))
forall a b. (a -> b) -> a -> b
$ XTyClD (GhcPass 'Parsed)
-> TyClDecl (GhcPass 'Parsed) -> HsDecl (GhcPass 'Parsed)
forall p. XTyClD p -> TyClDecl p -> HsDecl p
TyClD XTyClD (GhcPass 'Parsed)
NoExtField
noExtField (TyClDecl (GhcPass 'Parsed) -> HsDecl (GhcPass 'Parsed))
-> TyClDecl (GhcPass 'Parsed) -> HsDecl (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$ XFamDecl (GhcPass 'Parsed)
-> FamilyDecl (GhcPass 'Parsed) -> TyClDecl (GhcPass 'Parsed)
forall pass. XFamDecl pass -> FamilyDecl pass -> TyClDecl pass
FamDecl XFamDecl (GhcPass 'Parsed)
NoExtField
noExtField (FamilyDecl (GhcPass 'Parsed) -> TyClDecl (GhcPass 'Parsed))
-> FamilyDecl (GhcPass 'Parsed) -> TyClDecl (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$
         XCFamilyDecl (GhcPass 'Parsed)
-> FamilyInfo (GhcPass 'Parsed)
-> TopLevelFlag
-> LIdP (GhcPass 'Parsed)
-> LHsQTyVars (GhcPass 'Parsed)
-> LexicalFixity
-> LFamilyResultSig (GhcPass 'Parsed)
-> Maybe (LInjectivityAnn (GhcPass 'Parsed))
-> FamilyDecl (GhcPass 'Parsed)
forall pass.
XCFamilyDecl pass
-> FamilyInfo pass
-> TopLevelFlag
-> LIdP pass
-> LHsQTyVars pass
-> LexicalFixity
-> LFamilyResultSig pass
-> Maybe (LInjectivityAnn pass)
-> FamilyDecl pass
FamilyDecl XCFamilyDecl (GhcPass 'Parsed)
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn (Maybe [LTyFamInstEqn (GhcPass 'Parsed)]
-> FamilyInfo (GhcPass 'Parsed)
forall pass. Maybe [LTyFamInstEqn pass] -> FamilyInfo pass
ClosedTypeFamily ([GenLocated
   SrcSpanAnnA
   (FamEqn
      (GhcPass 'Parsed)
      (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))))]
-> Maybe
     [GenLocated
        SrcSpanAnnA
        (FamEqn
           (GhcPass 'Parsed)
           (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))))]
forall a. a -> Maybe a
Just [GenLocated
   SrcSpanAnnA
   (FamEqn
      (GhcPass 'Parsed)
      (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))))]
eqns')) TopLevelFlag
TopLevel LIdP (GhcPass 'Parsed)
GenLocated SrcSpanAnnN RdrName
tc' LHsQTyVars (GhcPass 'Parsed)
tyvars' LexicalFixity
Prefix
                           LFamilyResultSig (GhcPass 'Parsed)
GenLocated (SrcAnn NoEpAnns) (FamilyResultSig (GhcPass 'Parsed))
result' Maybe (LInjectivityAnn (GhcPass 'Parsed))
Maybe
  (GenLocated (SrcAnn NoEpAnns) (InjectivityAnn (GhcPass 'Parsed)))
injectivity' }

cvtDec (TH.RoleAnnotD Name
tc [Role]
roles)
  = do { GenLocated SrcSpanAnnN RdrName
tc' <- Name -> CvtM (GenLocated SrcSpanAnnN RdrName)
tconNameN Name
tc
       ; [LocatedAn NoEpAnns (Maybe Role)]
roles' <- (Role -> CvtM (LocatedAn NoEpAnns (Maybe Role)))
-> [Role] -> CvtM [LocatedAn NoEpAnns (Maybe Role)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Maybe Role -> CvtM (LocatedAn NoEpAnns (Maybe Role))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (Maybe Role -> CvtM (LocatedAn NoEpAnns (Maybe Role)))
-> (Role -> Maybe Role)
-> Role
-> CvtM (LocatedAn NoEpAnns (Maybe Role))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Role -> Maybe Role
cvtRole) [Role]
roles
       ; HsDecl (GhcPass 'Parsed)
-> CvtM (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))))
forall a. a -> CvtM (Maybe (LocatedA a))
returnJustLA
                   (HsDecl (GhcPass 'Parsed)
 -> CvtM
      (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed)))))
-> HsDecl (GhcPass 'Parsed)
-> CvtM (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))))
forall a b. (a -> b) -> a -> b
$ XRoleAnnotD (GhcPass 'Parsed)
-> RoleAnnotDecl (GhcPass 'Parsed) -> HsDecl (GhcPass 'Parsed)
forall p. XRoleAnnotD p -> RoleAnnotDecl p -> HsDecl p
Hs.RoleAnnotD XRoleAnnotD (GhcPass 'Parsed)
NoExtField
noExtField (XCRoleAnnotDecl (GhcPass 'Parsed)
-> LIdP (GhcPass 'Parsed)
-> [XRec (GhcPass 'Parsed) (Maybe Role)]
-> RoleAnnotDecl (GhcPass 'Parsed)
forall pass.
XCRoleAnnotDecl pass
-> LIdP pass -> [XRec pass (Maybe Role)] -> RoleAnnotDecl pass
RoleAnnotDecl XCRoleAnnotDecl (GhcPass 'Parsed)
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn LIdP (GhcPass 'Parsed)
GenLocated SrcSpanAnnN RdrName
tc' [XRec (GhcPass 'Parsed) (Maybe Role)]
[LocatedAn NoEpAnns (Maybe Role)]
roles') }

cvtDec (TH.StandaloneDerivD Maybe DerivStrategy
ds [Type]
cxt Type
ty)
  = do { GenLocated
  SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
cxt' <- PprPrec -> [Type] -> CvtM (LHsContext (GhcPass 'Parsed))
cvtContext PprPrec
funPrec [Type]
cxt
       ; Maybe
  (GenLocated (SrcAnn NoEpAnns) (DerivStrategy (GhcPass 'Parsed)))
ds'  <- (DerivStrategy
 -> CvtM
      (GenLocated (SrcAnn NoEpAnns) (DerivStrategy (GhcPass 'Parsed))))
-> Maybe DerivStrategy
-> CvtM
     (Maybe
        (GenLocated (SrcAnn NoEpAnns) (DerivStrategy (GhcPass 'Parsed))))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse DerivStrategy -> CvtM (LDerivStrategy (GhcPass 'Parsed))
DerivStrategy
-> CvtM
     (GenLocated (SrcAnn NoEpAnns) (DerivStrategy (GhcPass 'Parsed)))
cvtDerivStrategy Maybe DerivStrategy
ds
       ; (L SrcSpanAnnA
loc HsType (GhcPass 'Parsed)
ty') <- Type -> CvtM (LHsType (GhcPass 'Parsed))
cvtType Type
ty
       ; let inst_ty' :: GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Parsed))
inst_ty' = SrcSpanAnnA
-> HsSigType (GhcPass 'Parsed)
-> GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Parsed))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc (HsSigType (GhcPass 'Parsed)
 -> GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Parsed)))
-> HsSigType (GhcPass 'Parsed)
-> GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ LHsType (GhcPass 'Parsed) -> HsSigType (GhcPass 'Parsed)
mkHsImplicitSigType (LHsType (GhcPass 'Parsed) -> HsSigType (GhcPass 'Parsed))
-> LHsType (GhcPass 'Parsed) -> HsSigType (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$
                        [Type]
-> SrcSpanAnnA
-> LHsContext (GhcPass 'Parsed)
-> LHsType (GhcPass 'Parsed)
-> LHsType (GhcPass 'Parsed)
mkHsQualTy [Type]
cxt SrcSpanAnnA
loc LHsContext (GhcPass 'Parsed)
GenLocated
  SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
cxt' (LHsType (GhcPass 'Parsed) -> LHsType (GhcPass 'Parsed))
-> LHsType (GhcPass 'Parsed) -> LHsType (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA
-> HsType (GhcPass 'Parsed)
-> GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc HsType (GhcPass 'Parsed)
ty'
       ; HsDecl (GhcPass 'Parsed)
-> CvtM (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))))
forall a. a -> CvtM (Maybe (LocatedA a))
returnJustLA (HsDecl (GhcPass 'Parsed)
 -> CvtM
      (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed)))))
-> HsDecl (GhcPass 'Parsed)
-> CvtM (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))))
forall a b. (a -> b) -> a -> b
$ XDerivD (GhcPass 'Parsed)
-> DerivDecl (GhcPass 'Parsed) -> HsDecl (GhcPass 'Parsed)
forall p. XDerivD p -> DerivDecl p -> HsDecl p
DerivD XDerivD (GhcPass 'Parsed)
NoExtField
noExtField (DerivDecl (GhcPass 'Parsed) -> HsDecl (GhcPass 'Parsed))
-> DerivDecl (GhcPass 'Parsed) -> HsDecl (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$
         DerivDecl { deriv_ext :: XCDerivDecl (GhcPass 'Parsed)
deriv_ext = XCDerivDecl (GhcPass 'Parsed)
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn
                   , deriv_strategy :: Maybe (LDerivStrategy (GhcPass 'Parsed))
deriv_strategy = Maybe (LDerivStrategy (GhcPass 'Parsed))
Maybe
  (GenLocated (SrcAnn NoEpAnns) (DerivStrategy (GhcPass 'Parsed)))
ds'
                   , deriv_type :: LHsSigWcType (GhcPass 'Parsed)
deriv_type = GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Parsed))
-> HsWildCardBndrs
     (GhcPass 'Parsed)
     (GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Parsed)))
forall thing. thing -> HsWildCardBndrs (GhcPass 'Parsed) thing
mkHsWildCardBndrs GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Parsed))
inst_ty'
                   , deriv_overlap_mode :: Maybe (XRec (GhcPass 'Parsed) OverlapMode)
deriv_overlap_mode = Maybe (XRec (GhcPass 'Parsed) OverlapMode)
Maybe (GenLocated SrcSpanAnnP OverlapMode)
forall a. Maybe a
Nothing } }

cvtDec (TH.DefaultSigD Name
nm Type
typ)
  = do { GenLocated SrcSpanAnnN RdrName
nm' <- Name -> CvtM (GenLocated SrcSpanAnnN RdrName)
vNameN Name
nm
       ; GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Parsed))
ty' <- Type -> CvtM (LHsSigType (GhcPass 'Parsed))
cvtSigType Type
typ
       ; HsDecl (GhcPass 'Parsed)
-> CvtM (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))))
forall a. a -> CvtM (Maybe (LocatedA a))
returnJustLA (HsDecl (GhcPass 'Parsed)
 -> CvtM
      (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed)))))
-> HsDecl (GhcPass 'Parsed)
-> CvtM (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))))
forall a b. (a -> b) -> a -> b
$ XSigD (GhcPass 'Parsed)
-> Sig (GhcPass 'Parsed) -> HsDecl (GhcPass 'Parsed)
forall p. XSigD p -> Sig p -> HsDecl p
Hs.SigD XSigD (GhcPass 'Parsed)
NoExtField
noExtField
                      (Sig (GhcPass 'Parsed) -> HsDecl (GhcPass 'Parsed))
-> Sig (GhcPass 'Parsed) -> HsDecl (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$ XClassOpSig (GhcPass 'Parsed)
-> Bool
-> [LIdP (GhcPass 'Parsed)]
-> LHsSigType (GhcPass 'Parsed)
-> Sig (GhcPass 'Parsed)
forall pass.
XClassOpSig pass
-> Bool -> [LIdP pass] -> LHsSigType pass -> Sig pass
ClassOpSig XClassOpSig (GhcPass 'Parsed)
EpAnn AnnSig
forall a. EpAnn a
noAnn Bool
True [LIdP (GhcPass 'Parsed)
GenLocated SrcSpanAnnN RdrName
nm'] LHsSigType (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Parsed))
ty'}

cvtDec (TH.PatSynD Name
nm PatSynArgs
args PatSynDir
dir Pat
pat)
  = do { GenLocated SrcSpanAnnN RdrName
nm'   <- Name -> CvtM (GenLocated SrcSpanAnnN RdrName)
cNameN Name
nm
       ; HsConDetails
  Void
  (GenLocated SrcSpanAnnN RdrName)
  [RecordPatSynField (GhcPass 'Parsed)]
args' <- PatSynArgs
-> CvtM
     (HsConDetails
        Void
        (GenLocated SrcSpanAnnN RdrName)
        [RecordPatSynField (GhcPass 'Parsed)])
forall {pass}.
(XRec pass RdrName ~ GenLocated SrcSpanAnnN RdrName,
 XCFieldOcc pass ~ NoExtField, IdP pass ~ RdrName) =>
PatSynArgs
-> CvtM
     (HsConDetails
        Void (GenLocated SrcSpanAnnN RdrName) [RecordPatSynField pass])
cvtArgs PatSynArgs
args
       ; HsPatSynDir (GhcPass 'Parsed)
dir'  <- GenLocated SrcSpanAnnN RdrName
-> PatSynDir -> CvtM (HsPatSynDir (GhcPass 'Parsed))
cvtDir GenLocated SrcSpanAnnN RdrName
nm' PatSynDir
dir
       ; GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
pat'  <- Pat -> CvtM (LPat (GhcPass 'Parsed))
cvtPat Pat
pat
       ; HsDecl (GhcPass 'Parsed)
-> CvtM (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))))
forall a. a -> CvtM (Maybe (LocatedA a))
returnJustLA (HsDecl (GhcPass 'Parsed)
 -> CvtM
      (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed)))))
-> HsDecl (GhcPass 'Parsed)
-> CvtM (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))))
forall a b. (a -> b) -> a -> b
$ XValD (GhcPass 'Parsed)
-> HsBind (GhcPass 'Parsed) -> HsDecl (GhcPass 'Parsed)
forall p. XValD p -> HsBind p -> HsDecl p
Hs.ValD XValD (GhcPass 'Parsed)
NoExtField
noExtField (HsBind (GhcPass 'Parsed) -> HsDecl (GhcPass 'Parsed))
-> HsBind (GhcPass 'Parsed) -> HsDecl (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$ XPatSynBind (GhcPass 'Parsed) (GhcPass 'Parsed)
-> PatSynBind (GhcPass 'Parsed) (GhcPass 'Parsed)
-> HsBind (GhcPass 'Parsed)
forall idL idR.
XPatSynBind idL idR -> PatSynBind idL idR -> HsBindLR idL idR
PatSynBind XPatSynBind (GhcPass 'Parsed) (GhcPass 'Parsed)
NoExtField
noExtField (PatSynBind (GhcPass 'Parsed) (GhcPass 'Parsed)
 -> HsBind (GhcPass 'Parsed))
-> PatSynBind (GhcPass 'Parsed) (GhcPass 'Parsed)
-> HsBind (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$
           XPSB (GhcPass 'Parsed) (GhcPass 'Parsed)
-> LIdP (GhcPass 'Parsed)
-> HsPatSynDetails (GhcPass 'Parsed)
-> LPat (GhcPass 'Parsed)
-> HsPatSynDir (GhcPass 'Parsed)
-> PatSynBind (GhcPass 'Parsed) (GhcPass 'Parsed)
forall idL idR.
XPSB idL idR
-> LIdP idL
-> HsPatSynDetails idR
-> LPat idR
-> HsPatSynDir idR
-> PatSynBind idL idR
PSB XPSB (GhcPass 'Parsed) (GhcPass 'Parsed)
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn LIdP (GhcPass 'Parsed)
GenLocated SrcSpanAnnN RdrName
nm' HsPatSynDetails (GhcPass 'Parsed)
HsConDetails
  Void
  (GenLocated SrcSpanAnnN RdrName)
  [RecordPatSynField (GhcPass 'Parsed)]
args' LPat (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
pat' HsPatSynDir (GhcPass 'Parsed)
dir' }
  where
    cvtArgs :: PatSynArgs
-> CvtM
     (HsConDetails
        Void (GenLocated SrcSpanAnnN RdrName) [RecordPatSynField pass])
cvtArgs (TH.PrefixPatSyn [Name]
args) = [Void]
-> [GenLocated SrcSpanAnnN RdrName]
-> HsConDetails
     Void (GenLocated SrcSpanAnnN RdrName) [RecordPatSynField pass]
forall tyarg arg rec.
[tyarg] -> [arg] -> HsConDetails tyarg arg rec
Hs.PrefixCon [Void]
noTypeArgs ([GenLocated SrcSpanAnnN RdrName]
 -> HsConDetails
      Void (GenLocated SrcSpanAnnN RdrName) [RecordPatSynField pass])
-> CvtM [GenLocated SrcSpanAnnN RdrName]
-> CvtM
     (HsConDetails
        Void (GenLocated SrcSpanAnnN RdrName) [RecordPatSynField pass])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Name -> CvtM (GenLocated SrcSpanAnnN RdrName))
-> [Name] -> CvtM [GenLocated SrcSpanAnnN RdrName]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Name -> CvtM (GenLocated SrcSpanAnnN RdrName)
vNameN [Name]
args
    cvtArgs (TH.InfixPatSyn Name
a1 Name
a2) = GenLocated SrcSpanAnnN RdrName
-> GenLocated SrcSpanAnnN RdrName
-> HsConDetails
     Void (GenLocated SrcSpanAnnN RdrName) [RecordPatSynField pass]
forall tyarg arg rec. arg -> arg -> HsConDetails tyarg arg rec
Hs.InfixCon (GenLocated SrcSpanAnnN RdrName
 -> GenLocated SrcSpanAnnN RdrName
 -> HsConDetails
      Void (GenLocated SrcSpanAnnN RdrName) [RecordPatSynField pass])
-> CvtM (GenLocated SrcSpanAnnN RdrName)
-> CvtM
     (GenLocated SrcSpanAnnN RdrName
      -> HsConDetails
           Void (GenLocated SrcSpanAnnN RdrName) [RecordPatSynField pass])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> CvtM (GenLocated SrcSpanAnnN RdrName)
vNameN Name
a1 CvtM
  (GenLocated SrcSpanAnnN RdrName
   -> HsConDetails
        Void (GenLocated SrcSpanAnnN RdrName) [RecordPatSynField pass])
-> CvtM (GenLocated SrcSpanAnnN RdrName)
-> CvtM
     (HsConDetails
        Void (GenLocated SrcSpanAnnN RdrName) [RecordPatSynField pass])
forall a b. CvtM (a -> b) -> CvtM a -> CvtM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Name -> CvtM (GenLocated SrcSpanAnnN RdrName)
vNameN Name
a2
    cvtArgs (TH.RecordPatSyn [Name]
sels)
      = do { [FieldOcc pass]
sels' <- (Name -> CvtM (FieldOcc pass)) -> [Name] -> CvtM [FieldOcc pass]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((GenLocated SrcSpanAnnN RdrName -> FieldOcc pass)
-> CvtM (GenLocated SrcSpanAnnN RdrName) -> CvtM (FieldOcc pass)
forall a b. (a -> b) -> CvtM a -> CvtM b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ (L SrcSpanAnnN
li RdrName
i) -> XCFieldOcc pass -> XRec pass RdrName -> FieldOcc pass
forall pass. XCFieldOcc pass -> XRec pass RdrName -> FieldOcc pass
FieldOcc XCFieldOcc pass
NoExtField
noExtField (SrcSpanAnnN -> RdrName -> GenLocated SrcSpanAnnN RdrName
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnN
li RdrName
i)) (CvtM (GenLocated SrcSpanAnnN RdrName) -> CvtM (FieldOcc pass))
-> (Name -> CvtM (GenLocated SrcSpanAnnN RdrName))
-> Name
-> CvtM (FieldOcc pass)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> CvtM (GenLocated SrcSpanAnnN RdrName)
vNameN) [Name]
sels
           ; [GenLocated SrcSpanAnnN RdrName]
vars' <- (Name -> CvtM (GenLocated SrcSpanAnnN RdrName))
-> [Name] -> CvtM [GenLocated SrcSpanAnnN RdrName]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Name -> CvtM (GenLocated SrcSpanAnnN RdrName)
vNameN (Name -> CvtM (GenLocated SrcSpanAnnN RdrName))
-> (Name -> Name) -> Name -> CvtM (GenLocated SrcSpanAnnN RdrName)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Name
mkNameS (String -> Name) -> (Name -> String) -> Name -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> String
nameBase) [Name]
sels
           ; HsConDetails
  Void (GenLocated SrcSpanAnnN RdrName) [RecordPatSynField pass]
-> CvtM
     (HsConDetails
        Void (GenLocated SrcSpanAnnN RdrName) [RecordPatSynField pass])
forall a. a -> CvtM a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsConDetails
   Void (GenLocated SrcSpanAnnN RdrName) [RecordPatSynField pass]
 -> CvtM
      (HsConDetails
         Void (GenLocated SrcSpanAnnN RdrName) [RecordPatSynField pass]))
-> HsConDetails
     Void (GenLocated SrcSpanAnnN RdrName) [RecordPatSynField pass]
-> CvtM
     (HsConDetails
        Void (GenLocated SrcSpanAnnN RdrName) [RecordPatSynField pass])
forall a b. (a -> b) -> a -> b
$ [RecordPatSynField pass]
-> HsConDetails
     Void (GenLocated SrcSpanAnnN RdrName) [RecordPatSynField pass]
forall tyarg arg rec. rec -> HsConDetails tyarg arg rec
Hs.RecCon ([RecordPatSynField pass]
 -> HsConDetails
      Void (GenLocated SrcSpanAnnN RdrName) [RecordPatSynField pass])
-> [RecordPatSynField pass]
-> HsConDetails
     Void (GenLocated SrcSpanAnnN RdrName) [RecordPatSynField pass]
forall a b. (a -> b) -> a -> b
$ (FieldOcc pass
 -> GenLocated SrcSpanAnnN RdrName -> RecordPatSynField pass)
-> [FieldOcc pass]
-> [GenLocated SrcSpanAnnN RdrName]
-> [RecordPatSynField pass]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith FieldOcc pass -> LIdP pass -> RecordPatSynField pass
FieldOcc pass
-> GenLocated SrcSpanAnnN RdrName -> RecordPatSynField pass
forall pass. FieldOcc pass -> LIdP pass -> RecordPatSynField pass
RecordPatSynField [FieldOcc pass]
sels' [GenLocated SrcSpanAnnN RdrName]
vars' }

    -- cvtDir :: LocatedN RdrName -> (PatSynDir -> CvtM (HsPatSynDir RdrName))
    cvtDir :: GenLocated SrcSpanAnnN RdrName
-> PatSynDir -> CvtM (HsPatSynDir (GhcPass 'Parsed))
cvtDir GenLocated SrcSpanAnnN RdrName
_ PatSynDir
Unidir          = HsPatSynDir (GhcPass 'Parsed)
-> CvtM (HsPatSynDir (GhcPass 'Parsed))
forall a. a -> CvtM a
forall (m :: * -> *) a. Monad m => a -> m a
return HsPatSynDir (GhcPass 'Parsed)
forall id. HsPatSynDir id
Unidirectional
    cvtDir GenLocated SrcSpanAnnN RdrName
_ PatSynDir
ImplBidir       = HsPatSynDir (GhcPass 'Parsed)
-> CvtM (HsPatSynDir (GhcPass 'Parsed))
forall a. a -> CvtM a
forall (m :: * -> *) a. Monad m => a -> m a
return HsPatSynDir (GhcPass 'Parsed)
forall id. HsPatSynDir id
ImplicitBidirectional
    cvtDir GenLocated SrcSpanAnnN RdrName
n (ExplBidir [Clause]
cls) =
      do { [GenLocated
   SrcSpanAnnA
   (Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
ms <- (Clause
 -> CvtM
      (GenLocated
         SrcSpanAnnA
         (Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))))
-> [Clause]
-> CvtM
     [GenLocated
        SrcSpanAnnA
        (Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (HsMatchContext (GhcPass 'Parsed)
-> Clause
-> CvtM (LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)))
cvtClause (LIdP (NoGhcTc (GhcPass 'Parsed))
-> HsMatchContext (GhcPass 'Parsed)
forall p. LIdP (NoGhcTc p) -> HsMatchContext p
mkPrefixFunRhs LIdP (NoGhcTc (GhcPass 'Parsed))
GenLocated SrcSpanAnnN RdrName
n)) [Clause]
cls
         ; Origin
th_origin <- CvtM Origin
getOrigin
         ; (LocatedAn
   AnnList
   [GenLocated
      SrcSpanAnnA
      (Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
 -> HsPatSynDir (GhcPass 'Parsed))
-> [GenLocated
      SrcSpanAnnA
      (Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
-> CvtM (HsPatSynDir (GhcPass 'Parsed))
forall ann a b. (LocatedAn ann a -> b) -> a -> CvtM b
wrapParLA (MatchGroup (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
-> HsPatSynDir (GhcPass 'Parsed)
MatchGroup (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
-> HsPatSynDir (GhcPass 'Parsed)
forall id. MatchGroup id (LHsExpr id) -> HsPatSynDir id
ExplicitBidirectional (MatchGroup (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
 -> HsPatSynDir (GhcPass 'Parsed))
-> (LocatedAn
      AnnList
      [GenLocated
         SrcSpanAnnA
         (Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
    -> MatchGroup
         (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))
-> LocatedAn
     AnnList
     [GenLocated
        SrcSpanAnnA
        (Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
-> HsPatSynDir (GhcPass 'Parsed)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Origin
-> LocatedAn
     AnnList
     [GenLocated
        SrcSpanAnnA
        (Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
-> MatchGroup
     (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
forall (p :: Pass) (body :: * -> *).
AnnoBody p body =>
Origin
-> LocatedL
     [LocatedA (Match (GhcPass p) (LocatedA (body (GhcPass p))))]
-> MatchGroup (GhcPass p) (LocatedA (body (GhcPass p)))
mkMatchGroup Origin
th_origin) [GenLocated
   SrcSpanAnnA
   (Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
ms }

cvtDec (TH.PatSynSigD Name
nm Type
ty)
  = do { GenLocated SrcSpanAnnN RdrName
nm' <- Name -> CvtM (GenLocated SrcSpanAnnN RdrName)
cNameN Name
nm
       ; GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Parsed))
ty' <- Type -> CvtM (LHsSigType (GhcPass 'Parsed))
cvtPatSynSigTy Type
ty
       ; HsDecl (GhcPass 'Parsed)
-> CvtM (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))))
forall a. a -> CvtM (Maybe (LocatedA a))
returnJustLA (HsDecl (GhcPass 'Parsed)
 -> CvtM
      (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed)))))
-> HsDecl (GhcPass 'Parsed)
-> CvtM (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))))
forall a b. (a -> b) -> a -> b
$ XSigD (GhcPass 'Parsed)
-> Sig (GhcPass 'Parsed) -> HsDecl (GhcPass 'Parsed)
forall p. XSigD p -> Sig p -> HsDecl p
Hs.SigD XSigD (GhcPass 'Parsed)
NoExtField
noExtField (Sig (GhcPass 'Parsed) -> HsDecl (GhcPass 'Parsed))
-> Sig (GhcPass 'Parsed) -> HsDecl (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$ XPatSynSig (GhcPass 'Parsed)
-> [LIdP (GhcPass 'Parsed)]
-> LHsSigType (GhcPass 'Parsed)
-> Sig (GhcPass 'Parsed)
forall pass.
XPatSynSig pass -> [LIdP pass] -> LHsSigType pass -> Sig pass
PatSynSig XPatSynSig (GhcPass 'Parsed)
EpAnn AnnSig
forall a. EpAnn a
noAnn [LIdP (GhcPass 'Parsed)
GenLocated SrcSpanAnnN RdrName
nm'] LHsSigType (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Parsed))
ty'}

-- Implicit parameter bindings are handled in cvtLocalDecs and
-- cvtImplicitParamBind. They are not allowed in any other scope, so
-- reaching this case indicates an error.
cvtDec (TH.ImplicitParamBindD String
_ Exp
_)
  = SDoc
-> CvtM (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))))
forall a. SDoc -> CvtM a
failWith (String -> SDoc
text String
"Implicit parameter binding only allowed in let or where")

----------------
cvtTySynEqn :: TySynEqn -> CvtM (LTyFamInstEqn GhcPs)
cvtTySynEqn :: TySynEqn -> CvtM (LTyFamInstEqn (GhcPass 'Parsed))
cvtTySynEqn (TySynEqn Maybe [TyVarBndr ()]
mb_bndrs Type
lhs Type
rhs)
  = do { Maybe [GenLocated SrcSpanAnnA (HsTyVarBndr () (GhcPass 'Parsed))]
mb_bndrs' <- ([TyVarBndr ()]
 -> CvtM
      [GenLocated SrcSpanAnnA (HsTyVarBndr () (GhcPass 'Parsed))])
-> Maybe [TyVarBndr ()]
-> CvtM
     (Maybe [GenLocated SrcSpanAnnA (HsTyVarBndr () (GhcPass 'Parsed))])
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse ((TyVarBndr ()
 -> CvtM
      (GenLocated SrcSpanAnnA (HsTyVarBndr () (GhcPass 'Parsed))))
-> [TyVarBndr ()]
-> CvtM [GenLocated SrcSpanAnnA (HsTyVarBndr () (GhcPass 'Parsed))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM TyVarBndr () -> CvtM (LHsTyVarBndr () (GhcPass 'Parsed))
TyVarBndr ()
-> CvtM (GenLocated SrcSpanAnnA (HsTyVarBndr () (GhcPass 'Parsed)))
forall flag flag'.
CvtFlag flag flag' =>
TyVarBndr flag -> CvtM (LHsTyVarBndr flag' (GhcPass 'Parsed))
cvt_tv) Maybe [TyVarBndr ()]
mb_bndrs
       ; let outer_bndrs :: HsOuterFamEqnTyVarBndrs (GhcPass 'Parsed)
outer_bndrs = Maybe [LHsTyVarBndr () (GhcPass 'Parsed)]
-> HsOuterFamEqnTyVarBndrs (GhcPass 'Parsed)
mkHsOuterFamEqnTyVarBndrs Maybe [LHsTyVarBndr () (GhcPass 'Parsed)]
Maybe [GenLocated SrcSpanAnnA (HsTyVarBndr () (GhcPass 'Parsed))]
mb_bndrs'
       ; (Type
head_ty, [HsArg
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))]
args) <- Type -> CvtM (Type, HsTyPats (GhcPass 'Parsed))
split_ty_app Type
lhs
       ; case Type
head_ty of
           ConT Name
nm -> do { GenLocated SrcSpanAnnN RdrName
nm' <- Name -> CvtM (GenLocated SrcSpanAnnN RdrName)
tconNameN Name
nm
                         ; GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
rhs' <- Type -> CvtM (LHsType (GhcPass 'Parsed))
cvtType Type
rhs
                         ; let args' :: [HsArg
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))]
args' = (HsArg
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
 -> HsArg
      (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
      (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))))
-> [HsArg
      (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
      (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))]
-> [HsArg
      (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
      (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))]
forall a b. (a -> b) -> [a] -> [b]
map LHsTypeArg (GhcPass 'Parsed) -> LHsTypeArg (GhcPass 'Parsed)
HsArg
  (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
  (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
-> HsArg
     (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
     (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
wrap_tyarg [HsArg
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))]
args
                         ; FamEqn
  (GhcPass 'Parsed)
  (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
-> CvtM
     (GenLocated
        SrcSpanAnnA
        (FamEqn
           (GhcPass 'Parsed)
           (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA
                            (FamEqn
   (GhcPass 'Parsed)
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
 -> CvtM
      (GenLocated
         SrcSpanAnnA
         (FamEqn
            (GhcPass 'Parsed)
            (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))))))
-> FamEqn
     (GhcPass 'Parsed)
     (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
-> CvtM
     (GenLocated
        SrcSpanAnnA
        (FamEqn
           (GhcPass 'Parsed)
           (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))))
forall a b. (a -> b) -> a -> b
$ FamEqn { feqn_ext :: XCFamEqn
  (GhcPass 'Parsed)
  (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
feqn_ext    = XCFamEqn
  (GhcPass 'Parsed)
  (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn
                                     , feqn_tycon :: LIdP (GhcPass 'Parsed)
feqn_tycon  = LIdP (GhcPass 'Parsed)
GenLocated SrcSpanAnnN RdrName
nm'
                                     , feqn_bndrs :: HsOuterFamEqnTyVarBndrs (GhcPass 'Parsed)
feqn_bndrs  = HsOuterFamEqnTyVarBndrs (GhcPass 'Parsed)
outer_bndrs
                                     , feqn_pats :: HsTyPats (GhcPass 'Parsed)
feqn_pats   = HsTyPats (GhcPass 'Parsed)
[HsArg
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))]
args'
                                     , feqn_fixity :: LexicalFixity
feqn_fixity = LexicalFixity
Prefix
                                     , feqn_rhs :: GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
feqn_rhs    = GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
rhs' } }
           InfixT Type
t1 Name
nm Type
t2 -> do { GenLocated SrcSpanAnnN RdrName
nm' <- Name -> CvtM (GenLocated SrcSpanAnnN RdrName)
tconNameN Name
nm
                                 ; [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
args' <- (Type -> CvtM (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))))
-> [Type]
-> CvtM [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Type -> CvtM (LHsType (GhcPass 'Parsed))
Type -> CvtM (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
cvtType [Type
t1,Type
t2]
                                 ; GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
rhs' <- Type -> CvtM (LHsType (GhcPass 'Parsed))
cvtType Type
rhs
                                 ; FamEqn
  (GhcPass 'Parsed)
  (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
-> CvtM
     (GenLocated
        SrcSpanAnnA
        (FamEqn
           (GhcPass 'Parsed)
           (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA
                                      (FamEqn
   (GhcPass 'Parsed)
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
 -> CvtM
      (GenLocated
         SrcSpanAnnA
         (FamEqn
            (GhcPass 'Parsed)
            (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))))))
-> FamEqn
     (GhcPass 'Parsed)
     (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
-> CvtM
     (GenLocated
        SrcSpanAnnA
        (FamEqn
           (GhcPass 'Parsed)
           (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))))
forall a b. (a -> b) -> a -> b
$ FamEqn { feqn_ext :: XCFamEqn
  (GhcPass 'Parsed)
  (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
feqn_ext    = XCFamEqn
  (GhcPass 'Parsed)
  (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn
                                               , feqn_tycon :: LIdP (GhcPass 'Parsed)
feqn_tycon  = LIdP (GhcPass 'Parsed)
GenLocated SrcSpanAnnN RdrName
nm'
                                               , feqn_bndrs :: HsOuterFamEqnTyVarBndrs (GhcPass 'Parsed)
feqn_bndrs  = HsOuterFamEqnTyVarBndrs (GhcPass 'Parsed)
outer_bndrs
                                               , feqn_pats :: HsTyPats (GhcPass 'Parsed)
feqn_pats   =
                                                ((GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
 -> HsArg
      (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
      (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))))
-> [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
-> [HsArg
      (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
      (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
-> HsArg
     (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
     (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
forall tm ty. tm -> HsArg tm ty
HsValArg [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
args') [HsArg
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))]
-> [HsArg
      (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
      (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))]
-> [HsArg
      (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
      (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))]
forall a. [a] -> [a] -> [a]
++ [HsArg
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))]
args
                                               , feqn_fixity :: LexicalFixity
feqn_fixity = LexicalFixity
Hs.Infix
                                               , feqn_rhs :: GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
feqn_rhs    = GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
rhs' } }
           Type
_ -> SDoc
-> CvtM
     (GenLocated
        SrcSpanAnnA
        (FamEqn
           (GhcPass 'Parsed)
           (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))))
forall a. SDoc -> CvtM a
failWith (SDoc
 -> CvtM
      (GenLocated
         SrcSpanAnnA
         (FamEqn
            (GhcPass 'Parsed)
            (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))))))
-> SDoc
-> CvtM
     (GenLocated
        SrcSpanAnnA
        (FamEqn
           (GhcPass 'Parsed)
           (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))))
forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"Invalid type family instance LHS:"
                          SDoc -> SDoc -> SDoc
<+> String -> SDoc
text (Type -> String
forall a. Show a => a -> String
show Type
lhs)
        }

----------------
cvt_ci_decs :: SDoc -> [TH.Dec]
            -> CvtM (LHsBinds GhcPs,
                     [LSig GhcPs],
                     [LFamilyDecl GhcPs],
                     [LTyFamInstDecl GhcPs],
                     [LDataFamInstDecl GhcPs])
-- Convert the declarations inside a class or instance decl
-- ie signatures, bindings, and associated types
cvt_ci_decs :: SDoc
-> [Dec]
-> CvtM
     (LHsBinds (GhcPass 'Parsed), [LSig (GhcPass 'Parsed)],
      [LFamilyDecl (GhcPass 'Parsed)],
      [LTyFamInstDecl (GhcPass 'Parsed)],
      [LDataFamInstDecl (GhcPass 'Parsed)])
cvt_ci_decs SDoc
doc [Dec]
decs
  = do  { [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))]
decs' <- [Dec] -> CvtM [LHsDecl (GhcPass 'Parsed)]
cvtDecs [Dec]
decs
        ; let ([GenLocated SrcSpanAnnA (TyFamInstDecl (GhcPass 'Parsed))]
ats', [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))]
bind_sig_decs') = (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))
 -> Either
      (GenLocated SrcSpanAnnA (TyFamInstDecl (GhcPass 'Parsed)))
      (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))))
-> [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))]
-> ([GenLocated SrcSpanAnnA (TyFamInstDecl (GhcPass 'Parsed))],
    [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))])
forall a b c. (a -> Either b c) -> [a] -> ([b], [c])
partitionWith LHsDecl (GhcPass 'Parsed)
-> Either
     (LTyFamInstDecl (GhcPass 'Parsed)) (LHsDecl (GhcPass 'Parsed))
GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))
-> Either
     (GenLocated SrcSpanAnnA (TyFamInstDecl (GhcPass 'Parsed)))
     (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed)))
is_tyfam_inst [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))]
decs'
        ; let ([GenLocated SrcSpanAnnA (DataFamInstDecl (GhcPass 'Parsed))]
adts', [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))]
no_ats')       = (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))
 -> Either
      (GenLocated SrcSpanAnnA (DataFamInstDecl (GhcPass 'Parsed)))
      (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))))
-> [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))]
-> ([GenLocated SrcSpanAnnA (DataFamInstDecl (GhcPass 'Parsed))],
    [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))])
forall a b c. (a -> Either b c) -> [a] -> ([b], [c])
partitionWith LHsDecl (GhcPass 'Parsed)
-> Either
     (LDataFamInstDecl (GhcPass 'Parsed)) (LHsDecl (GhcPass 'Parsed))
GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))
-> Either
     (GenLocated SrcSpanAnnA (DataFamInstDecl (GhcPass 'Parsed)))
     (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed)))
is_datafam_inst [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))]
bind_sig_decs'
        ; let ([GenLocated SrcSpanAnnA (Sig (GhcPass 'Parsed))]
sigs', [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))]
prob_binds')   = (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))
 -> Either
      (GenLocated SrcSpanAnnA (Sig (GhcPass 'Parsed)))
      (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))))
-> [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))]
-> ([GenLocated SrcSpanAnnA (Sig (GhcPass 'Parsed))],
    [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))])
forall a b c. (a -> Either b c) -> [a] -> ([b], [c])
partitionWith LHsDecl (GhcPass 'Parsed)
-> Either (LSig (GhcPass 'Parsed)) (LHsDecl (GhcPass 'Parsed))
GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))
-> Either
     (GenLocated SrcSpanAnnA (Sig (GhcPass 'Parsed)))
     (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed)))
is_sig [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))]
no_ats'
        ; let ([GenLocated SrcSpanAnnA (HsBind (GhcPass 'Parsed))]
binds', [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))]
prob_fams')   = (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))
 -> Either
      (GenLocated SrcSpanAnnA (HsBind (GhcPass 'Parsed)))
      (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))))
-> [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))]
-> ([GenLocated SrcSpanAnnA (HsBind (GhcPass 'Parsed))],
    [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))])
forall a b c. (a -> Either b c) -> [a] -> ([b], [c])
partitionWith LHsDecl (GhcPass 'Parsed)
-> Either (LHsBind (GhcPass 'Parsed)) (LHsDecl (GhcPass 'Parsed))
GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))
-> Either
     (GenLocated SrcSpanAnnA (HsBind (GhcPass 'Parsed)))
     (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed)))
is_bind [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))]
prob_binds'
        ; let ([GenLocated SrcSpanAnnA (FamilyDecl (GhcPass 'Parsed))]
fams', [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))]
bads)          = (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))
 -> Either
      (GenLocated SrcSpanAnnA (FamilyDecl (GhcPass 'Parsed)))
      (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))))
-> [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))]
-> ([GenLocated SrcSpanAnnA (FamilyDecl (GhcPass 'Parsed))],
    [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))])
forall a b c. (a -> Either b c) -> [a] -> ([b], [c])
partitionWith LHsDecl (GhcPass 'Parsed)
-> Either
     (LFamilyDecl (GhcPass 'Parsed)) (LHsDecl (GhcPass 'Parsed))
GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))
-> Either
     (GenLocated SrcSpanAnnA (FamilyDecl (GhcPass 'Parsed)))
     (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed)))
is_fam_decl [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))]
prob_fams'
        ; Bool -> CvtM () -> CvtM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))]
bads) (SDoc -> CvtM ()
forall a. SDoc -> CvtM a
failWith (SDoc -> [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))] -> SDoc
forall a. Outputable a => SDoc -> [a] -> SDoc
mkBadDecMsg SDoc
doc [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))]
bads))
        ; (Bag (GenLocated SrcSpanAnnA (HsBind (GhcPass 'Parsed))),
 [GenLocated SrcSpanAnnA (Sig (GhcPass 'Parsed))],
 [GenLocated SrcSpanAnnA (FamilyDecl (GhcPass 'Parsed))],
 [GenLocated SrcSpanAnnA (TyFamInstDecl (GhcPass 'Parsed))],
 [GenLocated SrcSpanAnnA (DataFamInstDecl (GhcPass 'Parsed))])
-> CvtM
     (Bag (GenLocated SrcSpanAnnA (HsBind (GhcPass 'Parsed))),
      [GenLocated SrcSpanAnnA (Sig (GhcPass 'Parsed))],
      [GenLocated SrcSpanAnnA (FamilyDecl (GhcPass 'Parsed))],
      [GenLocated SrcSpanAnnA (TyFamInstDecl (GhcPass 'Parsed))],
      [GenLocated SrcSpanAnnA (DataFamInstDecl (GhcPass 'Parsed))])
forall a. a -> CvtM a
forall (m :: * -> *) a. Monad m => a -> m a
return ([GenLocated SrcSpanAnnA (HsBind (GhcPass 'Parsed))]
-> Bag (GenLocated SrcSpanAnnA (HsBind (GhcPass 'Parsed)))
forall a. [a] -> Bag a
listToBag [GenLocated SrcSpanAnnA (HsBind (GhcPass 'Parsed))]
binds', [GenLocated SrcSpanAnnA (Sig (GhcPass 'Parsed))]
sigs', [GenLocated SrcSpanAnnA (FamilyDecl (GhcPass 'Parsed))]
fams', [GenLocated SrcSpanAnnA (TyFamInstDecl (GhcPass 'Parsed))]
ats', [GenLocated SrcSpanAnnA (DataFamInstDecl (GhcPass 'Parsed))]
adts') }

----------------
cvt_tycl_hdr :: TH.Cxt -> TH.Name -> [TH.TyVarBndr ()]
             -> CvtM ( LHsContext GhcPs
                     , LocatedN RdrName
                     , LHsQTyVars GhcPs)
cvt_tycl_hdr :: [Type]
-> Name
-> [TyVarBndr ()]
-> CvtM
     (LHsContext (GhcPass 'Parsed), GenLocated SrcSpanAnnN RdrName,
      LHsQTyVars (GhcPass 'Parsed))
cvt_tycl_hdr [Type]
cxt Name
tc [TyVarBndr ()]
tvs
  = do { GenLocated
  SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
cxt' <- PprPrec -> [Type] -> CvtM (LHsContext (GhcPass 'Parsed))
cvtContext PprPrec
funPrec [Type]
cxt
       ; GenLocated SrcSpanAnnN RdrName
tc'  <- Name -> CvtM (GenLocated SrcSpanAnnN RdrName)
tconNameN Name
tc
       ; [GenLocated SrcSpanAnnA (HsTyVarBndr () (GhcPass 'Parsed))]
tvs' <- [TyVarBndr ()] -> CvtM [LHsTyVarBndr () (GhcPass 'Parsed)]
forall flag flag'.
CvtFlag flag flag' =>
[TyVarBndr flag] -> CvtM [LHsTyVarBndr flag' (GhcPass 'Parsed)]
cvtTvs [TyVarBndr ()]
tvs
       ; (GenLocated
   SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))],
 GenLocated SrcSpanAnnN RdrName, LHsQTyVars (GhcPass 'Parsed))
-> CvtM
     (GenLocated
        SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))],
      GenLocated SrcSpanAnnN RdrName, LHsQTyVars (GhcPass 'Parsed))
forall a. a -> CvtM a
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated
  SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
cxt', GenLocated SrcSpanAnnN RdrName
tc', [LHsTyVarBndr () (GhcPass 'Parsed)] -> LHsQTyVars (GhcPass 'Parsed)
mkHsQTvs [LHsTyVarBndr () (GhcPass 'Parsed)]
[GenLocated SrcSpanAnnA (HsTyVarBndr () (GhcPass 'Parsed))]
tvs')
       }

cvt_datainst_hdr :: TH.Cxt -> Maybe [TH.TyVarBndr ()] -> TH.Type
               -> CvtM ( LHsContext GhcPs
                       , LocatedN RdrName
                       , HsOuterFamEqnTyVarBndrs GhcPs
                       , HsTyPats GhcPs)
cvt_datainst_hdr :: [Type]
-> Maybe [TyVarBndr ()]
-> Type
-> CvtM
     (LHsContext (GhcPass 'Parsed), GenLocated SrcSpanAnnN RdrName,
      HsOuterFamEqnTyVarBndrs (GhcPass 'Parsed),
      HsTyPats (GhcPass 'Parsed))
cvt_datainst_hdr [Type]
cxt Maybe [TyVarBndr ()]
bndrs Type
tys
  = do { GenLocated
  SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
cxt' <- PprPrec -> [Type] -> CvtM (LHsContext (GhcPass 'Parsed))
cvtContext PprPrec
funPrec [Type]
cxt
       ; Maybe [GenLocated SrcSpanAnnA (HsTyVarBndr () (GhcPass 'Parsed))]
bndrs' <- ([TyVarBndr ()]
 -> CvtM
      [GenLocated SrcSpanAnnA (HsTyVarBndr () (GhcPass 'Parsed))])
-> Maybe [TyVarBndr ()]
-> CvtM
     (Maybe [GenLocated SrcSpanAnnA (HsTyVarBndr () (GhcPass 'Parsed))])
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse ((TyVarBndr ()
 -> CvtM
      (GenLocated SrcSpanAnnA (HsTyVarBndr () (GhcPass 'Parsed))))
-> [TyVarBndr ()]
-> CvtM [GenLocated SrcSpanAnnA (HsTyVarBndr () (GhcPass 'Parsed))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM TyVarBndr () -> CvtM (LHsTyVarBndr () (GhcPass 'Parsed))
TyVarBndr ()
-> CvtM (GenLocated SrcSpanAnnA (HsTyVarBndr () (GhcPass 'Parsed)))
forall flag flag'.
CvtFlag flag flag' =>
TyVarBndr flag -> CvtM (LHsTyVarBndr flag' (GhcPass 'Parsed))
cvt_tv) Maybe [TyVarBndr ()]
bndrs
       ; let outer_bndrs :: HsOuterFamEqnTyVarBndrs (GhcPass 'Parsed)
outer_bndrs = Maybe [LHsTyVarBndr () (GhcPass 'Parsed)]
-> HsOuterFamEqnTyVarBndrs (GhcPass 'Parsed)
mkHsOuterFamEqnTyVarBndrs Maybe [LHsTyVarBndr () (GhcPass 'Parsed)]
Maybe [GenLocated SrcSpanAnnA (HsTyVarBndr () (GhcPass 'Parsed))]
bndrs'
       ; (Type
head_ty, [HsArg
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))]
args) <- Type -> CvtM (Type, HsTyPats (GhcPass 'Parsed))
split_ty_app Type
tys
       ; case Type
head_ty of
          ConT Name
nm -> do { GenLocated SrcSpanAnnN RdrName
nm' <- Name -> CvtM (GenLocated SrcSpanAnnN RdrName)
tconNameN Name
nm
                        ; let args' :: [HsArg
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))]
args' = (HsArg
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
 -> HsArg
      (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
      (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))))
-> [HsArg
      (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
      (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))]
-> [HsArg
      (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
      (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))]
forall a b. (a -> b) -> [a] -> [b]
map LHsTypeArg (GhcPass 'Parsed) -> LHsTypeArg (GhcPass 'Parsed)
HsArg
  (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
  (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
-> HsArg
     (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
     (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
wrap_tyarg [HsArg
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))]
args
                        ; (GenLocated
   SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))],
 GenLocated SrcSpanAnnN RdrName,
 HsOuterFamEqnTyVarBndrs (GhcPass 'Parsed),
 [HsArg
    (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
    (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))])
-> CvtM
     (GenLocated
        SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))],
      GenLocated SrcSpanAnnN RdrName,
      HsOuterFamEqnTyVarBndrs (GhcPass 'Parsed),
      [HsArg
         (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
         (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))])
forall a. a -> CvtM a
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated
  SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
cxt', GenLocated SrcSpanAnnN RdrName
nm', HsOuterFamEqnTyVarBndrs (GhcPass 'Parsed)
outer_bndrs, [HsArg
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))]
args') }
          InfixT Type
t1 Name
nm Type
t2 -> do { GenLocated SrcSpanAnnN RdrName
nm' <- Name -> CvtM (GenLocated SrcSpanAnnN RdrName)
tconNameN Name
nm
                                ; [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
args' <- (Type -> CvtM (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))))
-> [Type]
-> CvtM [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Type -> CvtM (LHsType (GhcPass 'Parsed))
Type -> CvtM (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
cvtType [Type
t1,Type
t2]
                                ; (GenLocated
   SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))],
 GenLocated SrcSpanAnnN RdrName,
 HsOuterFamEqnTyVarBndrs (GhcPass 'Parsed),
 [HsArg
    (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
    (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))])
-> CvtM
     (GenLocated
        SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))],
      GenLocated SrcSpanAnnN RdrName,
      HsOuterFamEqnTyVarBndrs (GhcPass 'Parsed),
      [HsArg
         (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
         (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))])
forall a. a -> CvtM a
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated
  SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
cxt', GenLocated SrcSpanAnnN RdrName
nm', HsOuterFamEqnTyVarBndrs (GhcPass 'Parsed)
outer_bndrs,
                                         (((GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
 -> HsArg
      (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
      (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))))
-> [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
-> [HsArg
      (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
      (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
-> HsArg
     (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
     (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
forall tm ty. tm -> HsArg tm ty
HsValArg [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
args') [HsArg
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))]
-> [HsArg
      (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
      (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))]
-> [HsArg
      (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
      (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))]
forall a. [a] -> [a] -> [a]
++ [HsArg
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))]
args)) }
          Type
_ -> SDoc
-> CvtM
     (GenLocated
        SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))],
      GenLocated SrcSpanAnnN RdrName,
      HsOuterFamEqnTyVarBndrs (GhcPass 'Parsed),
      [HsArg
         (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
         (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))])
forall a. SDoc -> CvtM a
failWith (SDoc
 -> CvtM
      (GenLocated
         SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))],
       GenLocated SrcSpanAnnN RdrName,
       HsOuterFamEqnTyVarBndrs (GhcPass 'Parsed),
       [HsArg
          (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
          (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))]))
-> SDoc
-> CvtM
     (GenLocated
        SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))],
      GenLocated SrcSpanAnnN RdrName,
      HsOuterFamEqnTyVarBndrs (GhcPass 'Parsed),
      [HsArg
         (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
         (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))])
forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"Invalid type instance header:"
                          SDoc -> SDoc -> SDoc
<+> String -> SDoc
text (Type -> String
forall a. Show a => a -> String
show Type
tys) }

----------------
cvt_tyfam_head :: TypeFamilyHead
               -> CvtM ( LocatedN RdrName
                       , LHsQTyVars GhcPs
                       , Hs.LFamilyResultSig GhcPs
                       , Maybe (Hs.LInjectivityAnn GhcPs))

cvt_tyfam_head :: TypeFamilyHead
-> CvtM
     (GenLocated SrcSpanAnnN RdrName, LHsQTyVars (GhcPass 'Parsed),
      LFamilyResultSig (GhcPass 'Parsed),
      Maybe (LInjectivityAnn (GhcPass 'Parsed)))
cvt_tyfam_head (TypeFamilyHead Name
tc [TyVarBndr ()]
tyvars FamilyResultSig
result Maybe InjectivityAnn
injectivity)
  = do {(GenLocated
  SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
_, GenLocated SrcSpanAnnN RdrName
tc', LHsQTyVars (GhcPass 'Parsed)
tyvars') <- [Type]
-> Name
-> [TyVarBndr ()]
-> CvtM
     (LHsContext (GhcPass 'Parsed), GenLocated SrcSpanAnnN RdrName,
      LHsQTyVars (GhcPass 'Parsed))
cvt_tycl_hdr [] Name
tc [TyVarBndr ()]
tyvars
       ; GenLocated (SrcAnn NoEpAnns) (FamilyResultSig (GhcPass 'Parsed))
result' <- FamilyResultSig -> CvtM (LFamilyResultSig (GhcPass 'Parsed))
cvtFamilyResultSig FamilyResultSig
result
       ; Maybe
  (GenLocated (SrcAnn NoEpAnns) (InjectivityAnn (GhcPass 'Parsed)))
injectivity' <- (InjectivityAnn
 -> CvtM
      (GenLocated (SrcAnn NoEpAnns) (InjectivityAnn (GhcPass 'Parsed))))
-> Maybe InjectivityAnn
-> CvtM
     (Maybe
        (GenLocated (SrcAnn NoEpAnns) (InjectivityAnn (GhcPass 'Parsed))))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse InjectivityAnn -> CvtM (LInjectivityAnn (GhcPass 'Parsed))
InjectivityAnn
-> CvtM
     (GenLocated (SrcAnn NoEpAnns) (InjectivityAnn (GhcPass 'Parsed)))
cvtInjectivityAnnotation Maybe InjectivityAnn
injectivity
       ; (GenLocated SrcSpanAnnN RdrName, LHsQTyVars (GhcPass 'Parsed),
 GenLocated (SrcAnn NoEpAnns) (FamilyResultSig (GhcPass 'Parsed)),
 Maybe
   (GenLocated (SrcAnn NoEpAnns) (InjectivityAnn (GhcPass 'Parsed))))
-> CvtM
     (GenLocated SrcSpanAnnN RdrName, LHsQTyVars (GhcPass 'Parsed),
      GenLocated (SrcAnn NoEpAnns) (FamilyResultSig (GhcPass 'Parsed)),
      Maybe
        (GenLocated (SrcAnn NoEpAnns) (InjectivityAnn (GhcPass 'Parsed))))
forall a. a -> CvtM a
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnN RdrName
tc', LHsQTyVars (GhcPass 'Parsed)
tyvars', GenLocated (SrcAnn NoEpAnns) (FamilyResultSig (GhcPass 'Parsed))
result', Maybe
  (GenLocated (SrcAnn NoEpAnns) (InjectivityAnn (GhcPass 'Parsed)))
injectivity') }

-------------------------------------------------------------------
--              Partitioning declarations
-------------------------------------------------------------------

is_fam_decl :: LHsDecl GhcPs -> Either (LFamilyDecl GhcPs) (LHsDecl GhcPs)
is_fam_decl :: LHsDecl (GhcPass 'Parsed)
-> Either
     (LFamilyDecl (GhcPass 'Parsed)) (LHsDecl (GhcPass 'Parsed))
is_fam_decl (L SrcSpanAnnA
loc (TyClD XTyClD (GhcPass 'Parsed)
_ (FamDecl { tcdFam :: forall pass. TyClDecl pass -> FamilyDecl pass
tcdFam = FamilyDecl (GhcPass 'Parsed)
d }))) = GenLocated SrcSpanAnnA (FamilyDecl (GhcPass 'Parsed))
-> Either
     (GenLocated SrcSpanAnnA (FamilyDecl (GhcPass 'Parsed)))
     (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed)))
forall a b. a -> Either a b
Left (SrcSpanAnnA
-> FamilyDecl (GhcPass 'Parsed)
-> GenLocated SrcSpanAnnA (FamilyDecl (GhcPass 'Parsed))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc FamilyDecl (GhcPass 'Parsed)
d)
is_fam_decl LHsDecl (GhcPass 'Parsed)
decl = GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))
-> Either
     (GenLocated SrcSpanAnnA (FamilyDecl (GhcPass 'Parsed)))
     (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed)))
forall a b. b -> Either a b
Right LHsDecl (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))
decl

is_tyfam_inst :: LHsDecl GhcPs -> Either (LTyFamInstDecl GhcPs) (LHsDecl GhcPs)
is_tyfam_inst :: LHsDecl (GhcPass 'Parsed)
-> Either
     (LTyFamInstDecl (GhcPass 'Parsed)) (LHsDecl (GhcPass 'Parsed))
is_tyfam_inst (L SrcSpanAnnA
loc (Hs.InstD XInstD (GhcPass 'Parsed)
_ (TyFamInstD { tfid_inst :: forall pass. InstDecl pass -> TyFamInstDecl pass
tfid_inst = TyFamInstDecl (GhcPass 'Parsed)
d })))
  = GenLocated SrcSpanAnnA (TyFamInstDecl (GhcPass 'Parsed))
-> Either
     (GenLocated SrcSpanAnnA (TyFamInstDecl (GhcPass 'Parsed)))
     (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed)))
forall a b. a -> Either a b
Left (SrcSpanAnnA
-> TyFamInstDecl (GhcPass 'Parsed)
-> GenLocated SrcSpanAnnA (TyFamInstDecl (GhcPass 'Parsed))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc TyFamInstDecl (GhcPass 'Parsed)
d)
is_tyfam_inst LHsDecl (GhcPass 'Parsed)
decl
  = GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))
-> Either
     (GenLocated SrcSpanAnnA (TyFamInstDecl (GhcPass 'Parsed)))
     (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed)))
forall a b. b -> Either a b
Right LHsDecl (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))
decl

is_datafam_inst :: LHsDecl GhcPs
                -> Either (LDataFamInstDecl GhcPs) (LHsDecl GhcPs)
is_datafam_inst :: LHsDecl (GhcPass 'Parsed)
-> Either
     (LDataFamInstDecl (GhcPass 'Parsed)) (LHsDecl (GhcPass 'Parsed))
is_datafam_inst (L SrcSpanAnnA
loc (Hs.InstD  XInstD (GhcPass 'Parsed)
_ (DataFamInstD { dfid_inst :: forall pass. InstDecl pass -> DataFamInstDecl pass
dfid_inst = DataFamInstDecl (GhcPass 'Parsed)
d })))
  = GenLocated SrcSpanAnnA (DataFamInstDecl (GhcPass 'Parsed))
-> Either
     (GenLocated SrcSpanAnnA (DataFamInstDecl (GhcPass 'Parsed)))
     (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed)))
forall a b. a -> Either a b
Left (SrcSpanAnnA
-> DataFamInstDecl (GhcPass 'Parsed)
-> GenLocated SrcSpanAnnA (DataFamInstDecl (GhcPass 'Parsed))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc DataFamInstDecl (GhcPass 'Parsed)
d)
is_datafam_inst LHsDecl (GhcPass 'Parsed)
decl
  = GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))
-> Either
     (GenLocated SrcSpanAnnA (DataFamInstDecl (GhcPass 'Parsed)))
     (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed)))
forall a b. b -> Either a b
Right LHsDecl (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))
decl

is_sig :: LHsDecl GhcPs -> Either (LSig GhcPs) (LHsDecl GhcPs)
is_sig :: LHsDecl (GhcPass 'Parsed)
-> Either (LSig (GhcPass 'Parsed)) (LHsDecl (GhcPass 'Parsed))
is_sig (L SrcSpanAnnA
loc (Hs.SigD XSigD (GhcPass 'Parsed)
_ Sig (GhcPass 'Parsed)
sig)) = GenLocated SrcSpanAnnA (Sig (GhcPass 'Parsed))
-> Either
     (GenLocated SrcSpanAnnA (Sig (GhcPass 'Parsed)))
     (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed)))
forall a b. a -> Either a b
Left (SrcSpanAnnA
-> Sig (GhcPass 'Parsed)
-> GenLocated SrcSpanAnnA (Sig (GhcPass 'Parsed))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc Sig (GhcPass 'Parsed)
sig)
is_sig LHsDecl (GhcPass 'Parsed)
decl                    = GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))
-> Either
     (GenLocated SrcSpanAnnA (Sig (GhcPass 'Parsed)))
     (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed)))
forall a b. b -> Either a b
Right LHsDecl (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))
decl

is_bind :: LHsDecl GhcPs -> Either (LHsBind GhcPs) (LHsDecl GhcPs)
is_bind :: LHsDecl (GhcPass 'Parsed)
-> Either (LHsBind (GhcPass 'Parsed)) (LHsDecl (GhcPass 'Parsed))
is_bind (L SrcSpanAnnA
loc (Hs.ValD XValD (GhcPass 'Parsed)
_ HsBind (GhcPass 'Parsed)
bind)) = GenLocated SrcSpanAnnA (HsBind (GhcPass 'Parsed))
-> Either
     (GenLocated SrcSpanAnnA (HsBind (GhcPass 'Parsed)))
     (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed)))
forall a b. a -> Either a b
Left (SrcSpanAnnA
-> HsBind (GhcPass 'Parsed)
-> GenLocated SrcSpanAnnA (HsBind (GhcPass 'Parsed))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc HsBind (GhcPass 'Parsed)
bind)
is_bind LHsDecl (GhcPass 'Parsed)
decl                     = GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))
-> Either
     (GenLocated SrcSpanAnnA (HsBind (GhcPass 'Parsed)))
     (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed)))
forall a b. b -> Either a b
Right LHsDecl (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))
decl

is_ip_bind :: TH.Dec -> Either (String, TH.Exp) TH.Dec
is_ip_bind :: Dec -> Either (String, Exp) Dec
is_ip_bind (TH.ImplicitParamBindD String
n Exp
e) = (String, Exp) -> Either (String, Exp) Dec
forall a b. a -> Either a b
Left (String
n, Exp
e)
is_ip_bind Dec
decl             = Dec -> Either (String, Exp) Dec
forall a b. b -> Either a b
Right Dec
decl

mkBadDecMsg :: Outputable a => SDoc -> [a] -> SDoc
mkBadDecMsg :: forall a. Outputable a => SDoc -> [a] -> SDoc
mkBadDecMsg SDoc
doc [a]
bads
  = [SDoc] -> SDoc
sep [ String -> SDoc
text String
"Illegal declaration(s) in" SDoc -> SDoc -> SDoc
<+> SDoc
doc SDoc -> SDoc -> SDoc
<> SDoc
colon
        , Int -> SDoc -> SDoc
nest Int
2 ([SDoc] -> SDoc
vcat ((a -> SDoc) -> [a] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map a -> SDoc
forall a. Outputable a => a -> SDoc
Outputable.ppr [a]
bads)) ]

---------------------------------------------------
--      Data types
---------------------------------------------------

cvtConstr :: TH.Con -> CvtM (LConDecl GhcPs)

cvtConstr :: Con -> CvtM (LConDecl (GhcPass 'Parsed))
cvtConstr (NormalC Name
c [BangType]
strtys)
  = do  { GenLocated SrcSpanAnnN RdrName
c'   <- Name -> CvtM (GenLocated SrcSpanAnnN RdrName)
cNameN Name
c
        ; [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
tys' <- (BangType
 -> CvtM (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))))
-> [BangType]
-> CvtM [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM BangType -> CvtM (LHsType (GhcPass 'Parsed))
BangType
-> CvtM (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
cvt_arg [BangType]
strtys
        ; ConDecl (GhcPass 'Parsed)
-> CvtM (GenLocated SrcSpanAnnA (ConDecl (GhcPass 'Parsed)))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (ConDecl (GhcPass 'Parsed)
 -> CvtM (GenLocated SrcSpanAnnA (ConDecl (GhcPass 'Parsed))))
-> ConDecl (GhcPass 'Parsed)
-> CvtM (GenLocated SrcSpanAnnA (ConDecl (GhcPass 'Parsed)))
forall a b. (a -> b) -> a -> b
$ EpAnn [AddEpAnn]
-> GenLocated SrcSpanAnnN RdrName
-> Maybe [LHsTyVarBndr Specificity (GhcPass 'Parsed)]
-> Maybe (LHsContext (GhcPass 'Parsed))
-> HsConDeclH98Details (GhcPass 'Parsed)
-> ConDecl (GhcPass 'Parsed)
mkConDeclH98 EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn GenLocated SrcSpanAnnN RdrName
c' Maybe [LHsTyVarBndr Specificity (GhcPass 'Parsed)]
Maybe
  [GenLocated
     SrcSpanAnnA (HsTyVarBndr Specificity (GhcPass 'Parsed))]
forall a. Maybe a
Nothing Maybe (LHsContext (GhcPass 'Parsed))
Maybe
  (GenLocated
     SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))])
forall a. Maybe a
Nothing ([Void]
-> [HsScaled
      (GhcPass 'Parsed)
      (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))]
-> HsConDetails
     Void
     (HsScaled
        (GhcPass 'Parsed)
        (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))))
     (GenLocated
        SrcSpanAnnL
        [GenLocated SrcSpanAnnA (ConDeclField (GhcPass 'Parsed))])
forall tyarg arg rec.
[tyarg] -> [arg] -> HsConDetails tyarg arg rec
PrefixCon [Void]
noTypeArgs ((GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
 -> HsScaled
      (GhcPass 'Parsed)
      (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))))
-> [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
-> [HsScaled
      (GhcPass 'Parsed)
      (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
-> HsScaled
     (GhcPass 'Parsed)
     (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
forall a (p :: Pass). a -> HsScaled (GhcPass p) a
hsLinear [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
tys')) }

cvtConstr (RecC Name
c [VarBangType]
varstrtys)
  = do  { GenLocated SrcSpanAnnN RdrName
c'    <- Name -> CvtM (GenLocated SrcSpanAnnN RdrName)
cNameN Name
c
        ; [GenLocated SrcSpanAnnA (ConDeclField (GhcPass 'Parsed))]
args' <- (VarBangType
 -> CvtM (GenLocated SrcSpanAnnA (ConDeclField (GhcPass 'Parsed))))
-> [VarBangType]
-> CvtM [GenLocated SrcSpanAnnA (ConDeclField (GhcPass 'Parsed))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM VarBangType -> CvtM (LConDeclField (GhcPass 'Parsed))
VarBangType
-> CvtM (GenLocated SrcSpanAnnA (ConDeclField (GhcPass 'Parsed)))
cvt_id_arg [VarBangType]
varstrtys
        ; ConDecl (GhcPass 'Parsed)
con_decl <- (GenLocated
   SrcSpanAnnL
   [GenLocated SrcSpanAnnA (ConDeclField (GhcPass 'Parsed))]
 -> ConDecl (GhcPass 'Parsed))
-> [GenLocated SrcSpanAnnA (ConDeclField (GhcPass 'Parsed))]
-> CvtM (ConDecl (GhcPass 'Parsed))
forall ann a b. (LocatedAn ann a -> b) -> a -> CvtM b
wrapParLA (EpAnn [AddEpAnn]
-> GenLocated SrcSpanAnnN RdrName
-> Maybe [LHsTyVarBndr Specificity (GhcPass 'Parsed)]
-> Maybe (LHsContext (GhcPass 'Parsed))
-> HsConDeclH98Details (GhcPass 'Parsed)
-> ConDecl (GhcPass 'Parsed)
mkConDeclH98 EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn GenLocated SrcSpanAnnN RdrName
c' Maybe [LHsTyVarBndr Specificity (GhcPass 'Parsed)]
Maybe
  [GenLocated
     SrcSpanAnnA (HsTyVarBndr Specificity (GhcPass 'Parsed))]
forall a. Maybe a
Nothing Maybe (LHsContext (GhcPass 'Parsed))
Maybe
  (GenLocated
     SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))])
forall a. Maybe a
Nothing (HsConDetails
   Void
   (HsScaled
      (GhcPass 'Parsed)
      (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))))
   (GenLocated
      SrcSpanAnnL
      [GenLocated SrcSpanAnnA (ConDeclField (GhcPass 'Parsed))])
 -> ConDecl (GhcPass 'Parsed))
-> (GenLocated
      SrcSpanAnnL
      [GenLocated SrcSpanAnnA (ConDeclField (GhcPass 'Parsed))]
    -> HsConDetails
         Void
         (HsScaled
            (GhcPass 'Parsed)
            (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))))
         (GenLocated
            SrcSpanAnnL
            [GenLocated SrcSpanAnnA (ConDeclField (GhcPass 'Parsed))]))
-> GenLocated
     SrcSpanAnnL
     [GenLocated SrcSpanAnnA (ConDeclField (GhcPass 'Parsed))]
-> ConDecl (GhcPass 'Parsed)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated
  SrcSpanAnnL
  [GenLocated SrcSpanAnnA (ConDeclField (GhcPass 'Parsed))]
-> HsConDetails
     Void
     (HsScaled
        (GhcPass 'Parsed)
        (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))))
     (GenLocated
        SrcSpanAnnL
        [GenLocated SrcSpanAnnA (ConDeclField (GhcPass 'Parsed))])
forall tyarg arg rec. rec -> HsConDetails tyarg arg rec
RecCon) [GenLocated SrcSpanAnnA (ConDeclField (GhcPass 'Parsed))]
args'
        ; ConDecl (GhcPass 'Parsed)
-> CvtM (GenLocated SrcSpanAnnA (ConDecl (GhcPass 'Parsed)))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA ConDecl (GhcPass 'Parsed)
con_decl }

cvtConstr (InfixC BangType
st1 Name
c BangType
st2)
  = do  { GenLocated SrcSpanAnnN RdrName
c'   <- Name -> CvtM (GenLocated SrcSpanAnnN RdrName)
cNameN Name
c
        ; GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
st1' <- BangType -> CvtM (LHsType (GhcPass 'Parsed))
cvt_arg BangType
st1
        ; GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
st2' <- BangType -> CvtM (LHsType (GhcPass 'Parsed))
cvt_arg BangType
st2
        ; ConDecl (GhcPass 'Parsed)
-> CvtM (GenLocated SrcSpanAnnA (ConDecl (GhcPass 'Parsed)))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (ConDecl (GhcPass 'Parsed)
 -> CvtM (GenLocated SrcSpanAnnA (ConDecl (GhcPass 'Parsed))))
-> ConDecl (GhcPass 'Parsed)
-> CvtM (GenLocated SrcSpanAnnA (ConDecl (GhcPass 'Parsed)))
forall a b. (a -> b) -> a -> b
$ EpAnn [AddEpAnn]
-> GenLocated SrcSpanAnnN RdrName
-> Maybe [LHsTyVarBndr Specificity (GhcPass 'Parsed)]
-> Maybe (LHsContext (GhcPass 'Parsed))
-> HsConDeclH98Details (GhcPass 'Parsed)
-> ConDecl (GhcPass 'Parsed)
mkConDeclH98 EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn GenLocated SrcSpanAnnN RdrName
c' Maybe [LHsTyVarBndr Specificity (GhcPass 'Parsed)]
Maybe
  [GenLocated
     SrcSpanAnnA (HsTyVarBndr Specificity (GhcPass 'Parsed))]
forall a. Maybe a
Nothing Maybe (LHsContext (GhcPass 'Parsed))
Maybe
  (GenLocated
     SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))])
forall a. Maybe a
Nothing
                       (HsScaled
  (GhcPass 'Parsed)
  (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
-> HsScaled
     (GhcPass 'Parsed)
     (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
-> HsConDetails
     Void
     (HsScaled
        (GhcPass 'Parsed)
        (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))))
     (GenLocated
        SrcSpanAnnL
        [GenLocated SrcSpanAnnA (ConDeclField (GhcPass 'Parsed))])
forall tyarg arg rec. arg -> arg -> HsConDetails tyarg arg rec
InfixCon (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
-> HsScaled
     (GhcPass 'Parsed)
     (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
forall a (p :: Pass). a -> HsScaled (GhcPass p) a
hsLinear GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
st1') (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
-> HsScaled
     (GhcPass 'Parsed)
     (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
forall a (p :: Pass). a -> HsScaled (GhcPass p) a
hsLinear GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
st2')) }

cvtConstr (ForallC [TyVarBndr Specificity]
tvs [Type]
ctxt Con
con)
  = do  { [GenLocated
   SrcSpanAnnA (HsTyVarBndr Specificity (GhcPass 'Parsed))]
tvs'      <- [TyVarBndr Specificity]
-> CvtM [LHsTyVarBndr Specificity (GhcPass 'Parsed)]
forall flag flag'.
CvtFlag flag flag' =>
[TyVarBndr flag] -> CvtM [LHsTyVarBndr flag' (GhcPass 'Parsed)]
cvtTvs [TyVarBndr Specificity]
tvs
        ; GenLocated
  SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
ctxt'     <- PprPrec -> [Type] -> CvtM (LHsContext (GhcPass 'Parsed))
cvtContext PprPrec
funPrec [Type]
ctxt
        ; L SrcSpanAnnA
_ ConDecl (GhcPass 'Parsed)
con'  <- Con -> CvtM (LConDecl (GhcPass 'Parsed))
cvtConstr Con
con
        ; ConDecl (GhcPass 'Parsed)
-> CvtM (GenLocated SrcSpanAnnA (ConDecl (GhcPass 'Parsed)))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (ConDecl (GhcPass 'Parsed)
 -> CvtM (GenLocated SrcSpanAnnA (ConDecl (GhcPass 'Parsed))))
-> ConDecl (GhcPass 'Parsed)
-> CvtM (GenLocated SrcSpanAnnA (ConDecl (GhcPass 'Parsed)))
forall a b. (a -> b) -> a -> b
$ [LHsTyVarBndr Specificity (GhcPass 'Parsed)]
-> LHsContext (GhcPass 'Parsed)
-> ConDecl (GhcPass 'Parsed)
-> ConDecl (GhcPass 'Parsed)
add_forall [LHsTyVarBndr Specificity (GhcPass 'Parsed)]
[GenLocated
   SrcSpanAnnA (HsTyVarBndr Specificity (GhcPass 'Parsed))]
tvs' LHsContext (GhcPass 'Parsed)
GenLocated
  SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
ctxt' ConDecl (GhcPass 'Parsed)
con' }
  where
    add_cxt :: GenLocated
  SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
-> Maybe
     (GenLocated l [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))])
-> Maybe (LHsContext (GhcPass 'Parsed))
add_cxt GenLocated
  SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
lcxt         Maybe
  (GenLocated l [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))])
Nothing           = LHsContext (GhcPass 'Parsed)
-> Maybe (LHsContext (GhcPass 'Parsed))
mkHsContextMaybe LHsContext (GhcPass 'Parsed)
GenLocated
  SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
lcxt
    add_cxt (L SrcSpanAnnC
loc [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
cxt1) (Just (L l
_ [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
cxt2))
      = GenLocated
  SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
-> Maybe
     (GenLocated
        SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))])
forall a. a -> Maybe a
Just (SrcSpanAnnC
-> [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
-> GenLocated
     SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnC
loc ([GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
cxt1 [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
-> [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
-> [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
forall a. [a] -> [a] -> [a]
++ [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
cxt2))

    add_forall :: [LHsTyVarBndr Hs.Specificity GhcPs] -> LHsContext GhcPs
               -> ConDecl GhcPs -> ConDecl GhcPs
    add_forall :: [LHsTyVarBndr Specificity (GhcPass 'Parsed)]
-> LHsContext (GhcPass 'Parsed)
-> ConDecl (GhcPass 'Parsed)
-> ConDecl (GhcPass 'Parsed)
add_forall [LHsTyVarBndr Specificity (GhcPass 'Parsed)]
tvs' LHsContext (GhcPass 'Parsed)
cxt' con :: ConDecl (GhcPass 'Parsed)
con@(ConDeclGADT { con_bndrs :: forall pass. ConDecl pass -> XRec pass (HsOuterSigTyVarBndrs pass)
con_bndrs = L SrcSpanAnnA
l HsOuterSigTyVarBndrs (GhcPass 'Parsed)
outer_bndrs, con_mb_cxt :: forall pass. ConDecl pass -> Maybe (LHsContext pass)
con_mb_cxt = Maybe (LHsContext (GhcPass 'Parsed))
cxt })
      = ConDecl (GhcPass 'Parsed)
con { con_bndrs :: XRec (GhcPass 'Parsed) (HsOuterSigTyVarBndrs (GhcPass 'Parsed))
con_bndrs  = SrcSpanAnnA
-> HsOuterSigTyVarBndrs (GhcPass 'Parsed)
-> GenLocated SrcSpanAnnA (HsOuterSigTyVarBndrs (GhcPass 'Parsed))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l HsOuterSigTyVarBndrs (GhcPass 'Parsed)
outer_bndrs'
            , con_mb_cxt :: Maybe (LHsContext (GhcPass 'Parsed))
con_mb_cxt = GenLocated
  SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
-> Maybe
     (GenLocated
        SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))])
-> Maybe
     (GenLocated
        SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))])
forall {l}.
GenLocated
  SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
-> Maybe
     (GenLocated l [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))])
-> Maybe
     (GenLocated
        SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))])
add_cxt LHsContext (GhcPass 'Parsed)
GenLocated
  SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
cxt' Maybe (LHsContext (GhcPass 'Parsed))
Maybe
  (GenLocated
     SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))])
cxt }
      where
        outer_bndrs' :: HsOuterSigTyVarBndrs (GhcPass 'Parsed)
outer_bndrs'
          | [GenLocated
   SrcSpanAnnA (HsTyVarBndr Specificity (GhcPass 'Parsed))]
-> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GenLocated
   SrcSpanAnnA (HsTyVarBndr Specificity (GhcPass 'Parsed))]
all_tvs = HsOuterSigTyVarBndrs (GhcPass 'Parsed)
forall flag. HsOuterTyVarBndrs flag (GhcPass 'Parsed)
mkHsOuterImplicit
          | Bool
otherwise    = EpAnnForallTy
-> [LHsTyVarBndr Specificity (GhcPass 'Parsed)]
-> HsOuterSigTyVarBndrs (GhcPass 'Parsed)
forall flag.
EpAnnForallTy
-> [LHsTyVarBndr flag (GhcPass 'Parsed)]
-> HsOuterTyVarBndrs flag (GhcPass 'Parsed)
mkHsOuterExplicit EpAnnForallTy
forall a. EpAnn a
noAnn [LHsTyVarBndr Specificity (GhcPass 'Parsed)]
[GenLocated
   SrcSpanAnnA (HsTyVarBndr Specificity (GhcPass 'Parsed))]
all_tvs

        all_tvs :: [GenLocated
   SrcSpanAnnA (HsTyVarBndr Specificity (GhcPass 'Parsed))]
all_tvs = [LHsTyVarBndr Specificity (GhcPass 'Parsed)]
[GenLocated
   SrcSpanAnnA (HsTyVarBndr Specificity (GhcPass 'Parsed))]
tvs' [GenLocated
   SrcSpanAnnA (HsTyVarBndr Specificity (GhcPass 'Parsed))]
-> [GenLocated
      SrcSpanAnnA (HsTyVarBndr Specificity (GhcPass 'Parsed))]
-> [GenLocated
      SrcSpanAnnA (HsTyVarBndr Specificity (GhcPass 'Parsed))]
forall a. [a] -> [a] -> [a]
++ [LHsTyVarBndr Specificity (NoGhcTc (GhcPass 'Parsed))]
[GenLocated
   SrcSpanAnnA (HsTyVarBndr Specificity (GhcPass 'Parsed))]
outer_exp_tvs

        outer_exp_tvs :: [LHsTyVarBndr Specificity (NoGhcTc (GhcPass 'Parsed))]
outer_exp_tvs = HsOuterSigTyVarBndrs (GhcPass 'Parsed)
-> [LHsTyVarBndr Specificity (NoGhcTc (GhcPass 'Parsed))]
forall flag (p :: Pass).
HsOuterTyVarBndrs flag (GhcPass p)
-> [LHsTyVarBndr flag (NoGhcTc (GhcPass p))]
hsOuterExplicitBndrs HsOuterSigTyVarBndrs (GhcPass 'Parsed)
outer_bndrs

    add_forall [LHsTyVarBndr Specificity (GhcPass 'Parsed)]
tvs' LHsContext (GhcPass 'Parsed)
cxt' con :: ConDecl (GhcPass 'Parsed)
con@(ConDeclH98 { con_ex_tvs :: forall pass. ConDecl pass -> [LHsTyVarBndr Specificity pass]
con_ex_tvs = [LHsTyVarBndr Specificity (GhcPass 'Parsed)]
ex_tvs, con_mb_cxt :: forall pass. ConDecl pass -> Maybe (LHsContext pass)
con_mb_cxt = Maybe (LHsContext (GhcPass 'Parsed))
cxt })
      = ConDecl (GhcPass 'Parsed)
con { con_forall :: Bool
con_forall = Bool -> Bool
not ([GenLocated
   SrcSpanAnnA (HsTyVarBndr Specificity (GhcPass 'Parsed))]
-> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GenLocated
   SrcSpanAnnA (HsTyVarBndr Specificity (GhcPass 'Parsed))]
all_tvs)
            , con_ex_tvs :: [LHsTyVarBndr Specificity (GhcPass 'Parsed)]
con_ex_tvs = [LHsTyVarBndr Specificity (GhcPass 'Parsed)]
[GenLocated
   SrcSpanAnnA (HsTyVarBndr Specificity (GhcPass 'Parsed))]
all_tvs
            , con_mb_cxt :: Maybe (LHsContext (GhcPass 'Parsed))
con_mb_cxt = GenLocated
  SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
-> Maybe
     (GenLocated
        SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))])
-> Maybe
     (GenLocated
        SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))])
forall {l}.
GenLocated
  SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
-> Maybe
     (GenLocated l [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))])
-> Maybe
     (GenLocated
        SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))])
add_cxt LHsContext (GhcPass 'Parsed)
GenLocated
  SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
cxt' Maybe (LHsContext (GhcPass 'Parsed))
Maybe
  (GenLocated
     SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))])
cxt }
      where
        all_tvs :: [GenLocated
   SrcSpanAnnA (HsTyVarBndr Specificity (GhcPass 'Parsed))]
all_tvs = [LHsTyVarBndr Specificity (GhcPass 'Parsed)]
[GenLocated
   SrcSpanAnnA (HsTyVarBndr Specificity (GhcPass 'Parsed))]
tvs' [GenLocated
   SrcSpanAnnA (HsTyVarBndr Specificity (GhcPass 'Parsed))]
-> [GenLocated
      SrcSpanAnnA (HsTyVarBndr Specificity (GhcPass 'Parsed))]
-> [GenLocated
      SrcSpanAnnA (HsTyVarBndr Specificity (GhcPass 'Parsed))]
forall a. [a] -> [a] -> [a]
++ [LHsTyVarBndr Specificity (GhcPass 'Parsed)]
[GenLocated
   SrcSpanAnnA (HsTyVarBndr Specificity (GhcPass 'Parsed))]
ex_tvs

cvtConstr (GadtC [] [BangType]
_strtys Type
_ty)
  = SDoc -> CvtM (GenLocated SrcSpanAnnA (ConDecl (GhcPass 'Parsed)))
forall a. SDoc -> CvtM a
failWith (String -> SDoc
text String
"GadtC must have at least one constructor name")

cvtConstr (GadtC [Name]
c [BangType]
strtys Type
ty)
  = do  { [GenLocated SrcSpanAnnN RdrName]
c'      <- (Name -> CvtM (GenLocated SrcSpanAnnN RdrName))
-> [Name] -> CvtM [GenLocated SrcSpanAnnN RdrName]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Name -> CvtM (GenLocated SrcSpanAnnN RdrName)
cNameN [Name]
c
        ; [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
args    <- (BangType
 -> CvtM (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))))
-> [BangType]
-> CvtM [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM BangType -> CvtM (LHsType (GhcPass 'Parsed))
BangType
-> CvtM (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
cvt_arg [BangType]
strtys
        ; GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
ty'     <- Type -> CvtM (LHsType (GhcPass 'Parsed))
cvtType Type
ty
        ; [GenLocated SrcSpanAnnN RdrName]
-> HsConDeclGADTDetails (GhcPass 'Parsed)
-> LHsType (GhcPass 'Parsed)
-> CvtM (LConDecl (GhcPass 'Parsed))
mk_gadt_decl [GenLocated SrcSpanAnnN RdrName]
c' ([HsScaled (GhcPass 'Parsed) (LHsType (GhcPass 'Parsed))]
-> HsConDeclGADTDetails (GhcPass 'Parsed)
forall pass.
[HsScaled pass (LBangType pass)] -> HsConDeclGADTDetails pass
PrefixConGADT ([HsScaled (GhcPass 'Parsed) (LHsType (GhcPass 'Parsed))]
 -> HsConDeclGADTDetails (GhcPass 'Parsed))
-> [HsScaled (GhcPass 'Parsed) (LHsType (GhcPass 'Parsed))]
-> HsConDeclGADTDetails (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
 -> HsScaled
      (GhcPass 'Parsed)
      (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))))
-> [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
-> [HsScaled
      (GhcPass 'Parsed)
      (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
-> HsScaled
     (GhcPass 'Parsed)
     (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
forall a (p :: Pass). a -> HsScaled (GhcPass p) a
hsLinear [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
args) LHsType (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
ty'}

cvtConstr (RecGadtC [] [VarBangType]
_varstrtys Type
_ty)
  = SDoc -> CvtM (GenLocated SrcSpanAnnA (ConDecl (GhcPass 'Parsed)))
forall a. SDoc -> CvtM a
failWith (String -> SDoc
text String
"RecGadtC must have at least one constructor name")

cvtConstr (RecGadtC [Name]
c [VarBangType]
varstrtys Type
ty)
  = do  { [GenLocated SrcSpanAnnN RdrName]
c'       <- (Name -> CvtM (GenLocated SrcSpanAnnN RdrName))
-> [Name] -> CvtM [GenLocated SrcSpanAnnN RdrName]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Name -> CvtM (GenLocated SrcSpanAnnN RdrName)
cNameN [Name]
c
        ; GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
ty'      <- Type -> CvtM (LHsType (GhcPass 'Parsed))
cvtType Type
ty
        ; [GenLocated SrcSpanAnnA (ConDeclField (GhcPass 'Parsed))]
rec_flds <- (VarBangType
 -> CvtM (GenLocated SrcSpanAnnA (ConDeclField (GhcPass 'Parsed))))
-> [VarBangType]
-> CvtM [GenLocated SrcSpanAnnA (ConDeclField (GhcPass 'Parsed))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM VarBangType -> CvtM (LConDeclField (GhcPass 'Parsed))
VarBangType
-> CvtM (GenLocated SrcSpanAnnA (ConDeclField (GhcPass 'Parsed)))
cvt_id_arg [VarBangType]
varstrtys
        ; GenLocated
  SrcSpanAnnL
  [GenLocated SrcSpanAnnA (ConDeclField (GhcPass 'Parsed))]
lrec_flds <- [GenLocated SrcSpanAnnA (ConDeclField (GhcPass 'Parsed))]
-> CvtM
     (GenLocated
        SrcSpanAnnL
        [GenLocated SrcSpanAnnA (ConDeclField (GhcPass 'Parsed))])
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA [GenLocated SrcSpanAnnA (ConDeclField (GhcPass 'Parsed))]
rec_flds
        ; [GenLocated SrcSpanAnnN RdrName]
-> HsConDeclGADTDetails (GhcPass 'Parsed)
-> LHsType (GhcPass 'Parsed)
-> CvtM (LConDecl (GhcPass 'Parsed))
mk_gadt_decl [GenLocated SrcSpanAnnN RdrName]
c' (XRec (GhcPass 'Parsed) [LConDeclField (GhcPass 'Parsed)]
-> LHsUniToken "->" "\8594" (GhcPass 'Parsed)
-> HsConDeclGADTDetails (GhcPass 'Parsed)
forall pass.
XRec pass [LConDeclField pass]
-> LHsUniToken "->" "\8594" pass -> HsConDeclGADTDetails pass
RecConGADT XRec (GhcPass 'Parsed) [LConDeclField (GhcPass 'Parsed)]
GenLocated
  SrcSpanAnnL
  [GenLocated SrcSpanAnnA (ConDeclField (GhcPass 'Parsed))]
lrec_flds LHsUniToken "->" "\8594" (GhcPass 'Parsed)
GenLocated TokenLocation (HsUniToken "->" "\8594")
forall (tok :: Symbol) (utok :: Symbol).
GenLocated TokenLocation (HsUniToken tok utok)
noHsUniTok) LHsType (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
ty' }

mk_gadt_decl :: [LocatedN RdrName] -> HsConDeclGADTDetails GhcPs -> LHsType GhcPs
             -> CvtM (LConDecl GhcPs)
mk_gadt_decl :: [GenLocated SrcSpanAnnN RdrName]
-> HsConDeclGADTDetails (GhcPass 'Parsed)
-> LHsType (GhcPass 'Parsed)
-> CvtM (LConDecl (GhcPass 'Parsed))
mk_gadt_decl [GenLocated SrcSpanAnnN RdrName]
names HsConDeclGADTDetails (GhcPass 'Parsed)
args LHsType (GhcPass 'Parsed)
res_ty
  = do GenLocated SrcSpanAnnA (HsOuterSigTyVarBndrs (GhcPass 'Parsed))
bndrs <- HsOuterSigTyVarBndrs (GhcPass 'Parsed)
-> CvtM
     (GenLocated SrcSpanAnnA (HsOuterSigTyVarBndrs (GhcPass 'Parsed)))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA HsOuterSigTyVarBndrs (GhcPass 'Parsed)
forall flag. HsOuterTyVarBndrs flag (GhcPass 'Parsed)
mkHsOuterImplicit
       ConDecl (GhcPass 'Parsed)
-> CvtM (GenLocated SrcSpanAnnA (ConDecl (GhcPass 'Parsed)))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (ConDecl (GhcPass 'Parsed)
 -> CvtM (GenLocated SrcSpanAnnA (ConDecl (GhcPass 'Parsed))))
-> ConDecl (GhcPass 'Parsed)
-> CvtM (GenLocated SrcSpanAnnA (ConDecl (GhcPass 'Parsed)))
forall a b. (a -> b) -> a -> b
$ ConDeclGADT
                   { con_g_ext :: XConDeclGADT (GhcPass 'Parsed)
con_g_ext  = XConDeclGADT (GhcPass 'Parsed)
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn
                   , con_names :: [LIdP (GhcPass 'Parsed)]
con_names  = [LIdP (GhcPass 'Parsed)]
[GenLocated SrcSpanAnnN RdrName]
names
                   , con_bndrs :: XRec (GhcPass 'Parsed) (HsOuterSigTyVarBndrs (GhcPass 'Parsed))
con_bndrs  = XRec (GhcPass 'Parsed) (HsOuterSigTyVarBndrs (GhcPass 'Parsed))
GenLocated SrcSpanAnnA (HsOuterSigTyVarBndrs (GhcPass 'Parsed))
bndrs
                   , con_mb_cxt :: Maybe (LHsContext (GhcPass 'Parsed))
con_mb_cxt = Maybe (LHsContext (GhcPass 'Parsed))
Maybe
  (GenLocated
     SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))])
forall a. Maybe a
Nothing
                   , con_g_args :: HsConDeclGADTDetails (GhcPass 'Parsed)
con_g_args = HsConDeclGADTDetails (GhcPass 'Parsed)
args
                   , con_res_ty :: LHsType (GhcPass 'Parsed)
con_res_ty = LHsType (GhcPass 'Parsed)
res_ty
                   , con_doc :: Maybe (LHsDoc (GhcPass 'Parsed))
con_doc    = Maybe (LHsDoc (GhcPass 'Parsed))
forall a. Maybe a
Nothing }

cvtSrcUnpackedness :: TH.SourceUnpackedness -> SrcUnpackedness
cvtSrcUnpackedness :: SourceUnpackedness -> SrcUnpackedness
cvtSrcUnpackedness SourceUnpackedness
NoSourceUnpackedness = SrcUnpackedness
NoSrcUnpack
cvtSrcUnpackedness SourceUnpackedness
SourceNoUnpack       = SrcUnpackedness
SrcNoUnpack
cvtSrcUnpackedness SourceUnpackedness
SourceUnpack         = SrcUnpackedness
SrcUnpack

cvtSrcStrictness :: TH.SourceStrictness -> SrcStrictness
cvtSrcStrictness :: SourceStrictness -> SrcStrictness
cvtSrcStrictness SourceStrictness
NoSourceStrictness = SrcStrictness
NoSrcStrict
cvtSrcStrictness SourceStrictness
SourceLazy         = SrcStrictness
SrcLazy
cvtSrcStrictness SourceStrictness
SourceStrict       = SrcStrictness
SrcStrict

cvt_arg :: (TH.Bang, TH.Type) -> CvtM (LHsType GhcPs)
cvt_arg :: BangType -> CvtM (LHsType (GhcPass 'Parsed))
cvt_arg (Bang SourceUnpackedness
su SourceStrictness
ss, Type
ty)
  = do { GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
ty'' <- Type -> CvtM (LHsType (GhcPass 'Parsed))
cvtType Type
ty
       ; let ty' :: LHsType (GhcPass 'Parsed)
ty' = PprPrec -> LHsType (GhcPass 'Parsed) -> LHsType (GhcPass 'Parsed)
forall (p :: Pass).
PprPrec -> LHsType (GhcPass p) -> LHsType (GhcPass p)
parenthesizeHsType PprPrec
appPrec LHsType (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
ty''
             su' :: SrcUnpackedness
su' = SourceUnpackedness -> SrcUnpackedness
cvtSrcUnpackedness SourceUnpackedness
su
             ss' :: SrcStrictness
ss' = SourceStrictness -> SrcStrictness
cvtSrcStrictness SourceStrictness
ss
       ; HsType (GhcPass 'Parsed)
-> CvtM (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (HsType (GhcPass 'Parsed)
 -> CvtM (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))))
-> HsType (GhcPass 'Parsed)
-> CvtM (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
forall a b. (a -> b) -> a -> b
$ XBangTy (GhcPass 'Parsed)
-> HsSrcBang
-> LHsType (GhcPass 'Parsed)
-> HsType (GhcPass 'Parsed)
forall pass.
XBangTy pass -> HsSrcBang -> LHsType pass -> HsType pass
HsBangTy XBangTy (GhcPass 'Parsed)
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn (SourceText -> SrcUnpackedness -> SrcStrictness -> HsSrcBang
HsSrcBang SourceText
NoSourceText SrcUnpackedness
su' SrcStrictness
ss') LHsType (GhcPass 'Parsed)
ty' }

cvt_id_arg :: (TH.Name, TH.Bang, TH.Type) -> CvtM (LConDeclField GhcPs)
cvt_id_arg :: VarBangType -> CvtM (LConDeclField (GhcPass 'Parsed))
cvt_id_arg (Name
i, Bang
str, Type
ty)
  = do  { L SrcSpanAnnN
li RdrName
i' <- Name -> CvtM (GenLocated SrcSpanAnnN RdrName)
vNameN Name
i
        ; GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
ty' <- BangType -> CvtM (LHsType (GhcPass 'Parsed))
cvt_arg (Bang
str,Type
ty)
        ; ConDeclField (GhcPass 'Parsed)
-> CvtM (GenLocated SrcSpanAnnA (ConDeclField (GhcPass 'Parsed)))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (ConDeclField (GhcPass 'Parsed)
 -> CvtM (GenLocated SrcSpanAnnA (ConDeclField (GhcPass 'Parsed))))
-> ConDeclField (GhcPass 'Parsed)
-> CvtM (GenLocated SrcSpanAnnA (ConDeclField (GhcPass 'Parsed)))
forall a b. (a -> b) -> a -> b
$ ConDeclField
                          { cd_fld_ext :: XConDeclField (GhcPass 'Parsed)
cd_fld_ext = XConDeclField (GhcPass 'Parsed)
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn
                          , cd_fld_names :: [LFieldOcc (GhcPass 'Parsed)]
cd_fld_names
                              = [SrcAnn NoEpAnns
-> FieldOcc (GhcPass 'Parsed)
-> GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass 'Parsed))
forall l e. l -> e -> GenLocated l e
L (SrcSpanAnnN -> SrcAnn NoEpAnns
forall a ann. SrcSpanAnn' a -> SrcAnn ann
l2l SrcSpanAnnN
li) (FieldOcc (GhcPass 'Parsed)
 -> GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass 'Parsed)))
-> FieldOcc (GhcPass 'Parsed)
-> GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ XCFieldOcc (GhcPass 'Parsed)
-> XRec (GhcPass 'Parsed) RdrName -> FieldOcc (GhcPass 'Parsed)
forall pass. XCFieldOcc pass -> XRec pass RdrName -> FieldOcc pass
FieldOcc XCFieldOcc (GhcPass 'Parsed)
NoExtField
noExtField (SrcSpanAnnN -> RdrName -> GenLocated SrcSpanAnnN RdrName
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnN
li RdrName
i')]
                          , cd_fld_type :: LHsType (GhcPass 'Parsed)
cd_fld_type =  LHsType (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
ty'
                          , cd_fld_doc :: Maybe (LHsDoc (GhcPass 'Parsed))
cd_fld_doc = Maybe (LHsDoc (GhcPass 'Parsed))
forall a. Maybe a
Nothing} }

cvtDerivs :: [TH.DerivClause] -> CvtM (HsDeriving GhcPs)
cvtDerivs :: [DerivClause] -> CvtM (HsDeriving (GhcPass 'Parsed))
cvtDerivs [DerivClause]
cs = do { (DerivClause
 -> CvtM
      (GenLocated
         (SrcAnn NoEpAnns) (HsDerivingClause (GhcPass 'Parsed))))
-> [DerivClause]
-> CvtM
     [GenLocated (SrcAnn NoEpAnns) (HsDerivingClause (GhcPass 'Parsed))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM DerivClause -> CvtM (LHsDerivingClause (GhcPass 'Parsed))
DerivClause
-> CvtM
     (GenLocated (SrcAnn NoEpAnns) (HsDerivingClause (GhcPass 'Parsed)))
cvtDerivClause [DerivClause]
cs }

cvt_fundep :: TH.FunDep -> CvtM (LHsFunDep GhcPs)
cvt_fundep :: FunDep -> CvtM (LHsFunDep (GhcPass 'Parsed))
cvt_fundep (TH.FunDep [Name]
xs [Name]
ys) = do { [GenLocated SrcSpanAnnN RdrName]
xs' <- (Name -> CvtM (GenLocated SrcSpanAnnN RdrName))
-> [Name] -> CvtM [GenLocated SrcSpanAnnN RdrName]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Name -> CvtM (GenLocated SrcSpanAnnN RdrName)
tNameN [Name]
xs
                                  ; [GenLocated SrcSpanAnnN RdrName]
ys' <- (Name -> CvtM (GenLocated SrcSpanAnnN RdrName))
-> [Name] -> CvtM [GenLocated SrcSpanAnnN RdrName]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Name -> CvtM (GenLocated SrcSpanAnnN RdrName)
tNameN [Name]
ys
                                  ; FunDep (GhcPass 'Parsed)
-> CvtM (GenLocated SrcSpanAnnA (FunDep (GhcPass 'Parsed)))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (XCFunDep (GhcPass 'Parsed)
-> [LIdP (GhcPass 'Parsed)]
-> [LIdP (GhcPass 'Parsed)]
-> FunDep (GhcPass 'Parsed)
forall pass.
XCFunDep pass -> [LIdP pass] -> [LIdP pass] -> FunDep pass
Hs.FunDep XCFunDep (GhcPass 'Parsed)
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn [LIdP (GhcPass 'Parsed)]
[GenLocated SrcSpanAnnN RdrName]
xs' [LIdP (GhcPass 'Parsed)]
[GenLocated SrcSpanAnnN RdrName]
ys') }


------------------------------------------
--      Foreign declarations
------------------------------------------

cvtForD :: Foreign -> CvtM (ForeignDecl GhcPs)
cvtForD :: Foreign -> CvtM (ForeignDecl (GhcPass 'Parsed))
cvtForD (ImportF Callconv
callconv Safety
safety String
from Name
nm Type
ty) =
  do { SrcSpan
l <- CvtM SrcSpan
getL
     ; if -- the prim and javascript calling conventions do not support headers
          -- and are inserted verbatim, analogous to mkImport in GHC.Parser.PostProcess
          |  Callconv
callconv Callconv -> Callconv -> Bool
forall a. Eq a => a -> a -> Bool
== Callconv
TH.Prim Bool -> Bool -> Bool
|| Callconv
callconv Callconv -> Callconv -> Bool
forall a. Eq a => a -> a -> Bool
== Callconv
TH.JavaScript
          -> ForeignImport -> CvtM (ForeignDecl (GhcPass 'Parsed))
mk_imp (Located CCallConv
-> Located Safety
-> Maybe Header
-> CImportSpec
-> Located SourceText
-> ForeignImport
CImport (SrcSpan -> CCallConv -> Located CCallConv
forall l e. l -> e -> GenLocated l e
L SrcSpan
l (Callconv -> CCallConv
cvt_conv Callconv
callconv)) (SrcSpan -> Safety -> Located Safety
forall l e. l -> e -> GenLocated l e
L SrcSpan
l Safety
safety') Maybe Header
forall a. Maybe a
Nothing
                             (CCallTarget -> CImportSpec
CFunction (SourceText -> CLabelString -> Maybe Unit -> Bool -> CCallTarget
StaticTarget (String -> SourceText
SourceText String
from)
                                                      (String -> CLabelString
mkFastString String
from) Maybe Unit
forall a. Maybe a
Nothing
                                                      Bool
True))
                             (SrcSpan -> SourceText -> Located SourceText
forall l e. l -> e -> GenLocated l e
L SrcSpan
l (SourceText -> Located SourceText)
-> SourceText -> Located SourceText
forall a b. (a -> b) -> a -> b
$ String -> SourceText
quotedSourceText String
from))
          |  Just ForeignImport
impspec <- Located CCallConv
-> Located Safety
-> CLabelString
-> String
-> Located SourceText
-> Maybe ForeignImport
parseCImport (SrcSpan -> CCallConv -> Located CCallConv
forall l e. l -> e -> GenLocated l e
L SrcSpan
l (Callconv -> CCallConv
cvt_conv Callconv
callconv)) (SrcSpan -> Safety -> Located Safety
forall l e. l -> e -> GenLocated l e
L SrcSpan
l Safety
safety')
                                          (String -> CLabelString
mkFastString (Name -> String
TH.nameBase Name
nm))
                                          String
from (SrcSpan -> SourceText -> Located SourceText
forall l e. l -> e -> GenLocated l e
L SrcSpan
l (SourceText -> Located SourceText)
-> SourceText -> Located SourceText
forall a b. (a -> b) -> a -> b
$ String -> SourceText
quotedSourceText String
from)
          -> ForeignImport -> CvtM (ForeignDecl (GhcPass 'Parsed))
mk_imp ForeignImport
impspec
          |  Bool
otherwise
          -> SDoc -> CvtM (ForeignDecl (GhcPass 'Parsed))
forall a. SDoc -> CvtM a
failWith (SDoc -> CvtM (ForeignDecl (GhcPass 'Parsed)))
-> SDoc -> CvtM (ForeignDecl (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ String -> SDoc
text (String -> String
forall a. Show a => a -> String
show String
from) SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"is not a valid ccall impent" }
  where
    mk_imp :: ForeignImport -> CvtM (ForeignDecl (GhcPass 'Parsed))
mk_imp ForeignImport
impspec
      = do { GenLocated SrcSpanAnnN RdrName
nm' <- Name -> CvtM (GenLocated SrcSpanAnnN RdrName)
vNameN Name
nm
           ; GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Parsed))
ty' <- Type -> CvtM (LHsSigType (GhcPass 'Parsed))
cvtSigType Type
ty
           ; ForeignDecl (GhcPass 'Parsed)
-> CvtM (ForeignDecl (GhcPass 'Parsed))
forall a. a -> CvtM a
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignImport { fd_i_ext :: XForeignImport (GhcPass 'Parsed)
fd_i_ext = XForeignImport (GhcPass 'Parsed)
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn
                                   , fd_name :: LIdP (GhcPass 'Parsed)
fd_name = LIdP (GhcPass 'Parsed)
GenLocated SrcSpanAnnN RdrName
nm'
                                   , fd_sig_ty :: LHsSigType (GhcPass 'Parsed)
fd_sig_ty = LHsSigType (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Parsed))
ty'
                                   , fd_fi :: ForeignImport
fd_fi = ForeignImport
impspec })
           }
    safety' :: Safety
safety' = case Safety
safety of
                     Safety
Unsafe     -> Safety
PlayRisky
                     Safety
Safe       -> Safety
PlaySafe
                     Safety
Interruptible -> Safety
PlayInterruptible

cvtForD (ExportF Callconv
callconv String
as Name
nm Type
ty)
  = do  { GenLocated SrcSpanAnnN RdrName
nm' <- Name -> CvtM (GenLocated SrcSpanAnnN RdrName)
vNameN Name
nm
        ; GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Parsed))
ty' <- Type -> CvtM (LHsSigType (GhcPass 'Parsed))
cvtSigType Type
ty
        ; SrcSpan
l <- CvtM SrcSpan
getL
        ; let e :: ForeignExport
e = Located CExportSpec -> Located SourceText -> ForeignExport
CExport (SrcSpan -> CExportSpec -> Located CExportSpec
forall l e. l -> e -> GenLocated l e
L SrcSpan
l (SourceText -> CLabelString -> CCallConv -> CExportSpec
CExportStatic (String -> SourceText
SourceText String
as)
                                              (String -> CLabelString
mkFastString String
as)
                                              (Callconv -> CCallConv
cvt_conv Callconv
callconv)))
                                              (SrcSpan -> SourceText -> Located SourceText
forall l e. l -> e -> GenLocated l e
L SrcSpan
l (String -> SourceText
SourceText String
as))
        ; ForeignDecl (GhcPass 'Parsed)
-> CvtM (ForeignDecl (GhcPass 'Parsed))
forall a. a -> CvtM a
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignDecl (GhcPass 'Parsed)
 -> CvtM (ForeignDecl (GhcPass 'Parsed)))
-> ForeignDecl (GhcPass 'Parsed)
-> CvtM (ForeignDecl (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ ForeignExport { fd_e_ext :: XForeignExport (GhcPass 'Parsed)
fd_e_ext = XForeignExport (GhcPass 'Parsed)
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn
                                 , fd_name :: LIdP (GhcPass 'Parsed)
fd_name = LIdP (GhcPass 'Parsed)
GenLocated SrcSpanAnnN RdrName
nm'
                                 , fd_sig_ty :: LHsSigType (GhcPass 'Parsed)
fd_sig_ty = LHsSigType (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Parsed))
ty'
                                 , fd_fe :: ForeignExport
fd_fe = ForeignExport
e } }

cvt_conv :: TH.Callconv -> CCallConv
cvt_conv :: Callconv -> CCallConv
cvt_conv Callconv
TH.CCall      = CCallConv
CCallConv
cvt_conv Callconv
TH.StdCall    = CCallConv
StdCallConv
cvt_conv Callconv
TH.CApi       = CCallConv
CApiConv
cvt_conv Callconv
TH.Prim       = CCallConv
PrimCallConv
cvt_conv Callconv
TH.JavaScript = CCallConv
JavaScriptCallConv

------------------------------------------
--              Pragmas
------------------------------------------

cvtPragmaD :: Pragma -> CvtM (Maybe (LHsDecl GhcPs))
cvtPragmaD :: Pragma -> CvtM (Maybe (LHsDecl (GhcPass 'Parsed)))
cvtPragmaD (InlineP Name
nm Inline
inline RuleMatch
rm Phases
phases)
  = do { GenLocated SrcSpanAnnN RdrName
nm' <- Name -> CvtM (GenLocated SrcSpanAnnN RdrName)
vNameN Name
nm
       ; let dflt :: Activation
dflt = Inline -> Activation
dfltActivation Inline
inline
       ; let src :: Inline -> String
src Inline
TH.NoInline  = String
"{-# NOINLINE"
             src Inline
TH.Inline    = String
"{-# INLINE"
             src Inline
TH.Inlinable = String
"{-# INLINABLE"
       ; let ip :: InlinePragma
ip   = InlinePragma { inl_src :: SourceText
inl_src    = Inline -> SourceText
toSrcTxt Inline
inline
                                 , inl_inline :: InlineSpec
inl_inline = Inline -> SourceText -> InlineSpec
cvtInline Inline
inline (Inline -> SourceText
toSrcTxt Inline
inline)
                                 , inl_rule :: RuleMatchInfo
inl_rule   = RuleMatch -> RuleMatchInfo
cvtRuleMatch RuleMatch
rm
                                 , inl_act :: Activation
inl_act    = Phases -> Activation -> Activation
cvtPhases Phases
phases Activation
dflt
                                 , inl_sat :: Maybe Int
inl_sat    = Maybe Int
forall a. Maybe a
Nothing }
                    where
                     toSrcTxt :: Inline -> SourceText
toSrcTxt Inline
a = String -> SourceText
SourceText (String -> SourceText) -> String -> SourceText
forall a b. (a -> b) -> a -> b
$ Inline -> String
src Inline
a
       ; HsDecl (GhcPass 'Parsed)
-> CvtM (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))))
forall a. a -> CvtM (Maybe (LocatedA a))
returnJustLA (HsDecl (GhcPass 'Parsed)
 -> CvtM
      (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed)))))
-> HsDecl (GhcPass 'Parsed)
-> CvtM (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))))
forall a b. (a -> b) -> a -> b
$ XSigD (GhcPass 'Parsed)
-> Sig (GhcPass 'Parsed) -> HsDecl (GhcPass 'Parsed)
forall p. XSigD p -> Sig p -> HsDecl p
Hs.SigD XSigD (GhcPass 'Parsed)
NoExtField
noExtField (Sig (GhcPass 'Parsed) -> HsDecl (GhcPass 'Parsed))
-> Sig (GhcPass 'Parsed) -> HsDecl (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$ XInlineSig (GhcPass 'Parsed)
-> LIdP (GhcPass 'Parsed) -> InlinePragma -> Sig (GhcPass 'Parsed)
forall pass.
XInlineSig pass -> LIdP pass -> InlinePragma -> Sig pass
InlineSig XInlineSig (GhcPass 'Parsed)
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn LIdP (GhcPass 'Parsed)
GenLocated SrcSpanAnnN RdrName
nm' InlinePragma
ip }

cvtPragmaD (OpaqueP Name
nm)
  = do { GenLocated SrcSpanAnnN RdrName
nm' <- Name -> CvtM (GenLocated SrcSpanAnnN RdrName)
vNameN Name
nm
       ; let ip :: InlinePragma
ip = InlinePragma { inl_src :: SourceText
inl_src    = SourceText
srcTxt
                               , inl_inline :: InlineSpec
inl_inline = SourceText -> InlineSpec
Opaque SourceText
srcTxt
                               , inl_rule :: RuleMatchInfo
inl_rule   = RuleMatchInfo
Hs.FunLike
                               , inl_act :: Activation
inl_act    = Activation
NeverActive
                               , inl_sat :: Maybe Int
inl_sat    = Maybe Int
forall a. Maybe a
Nothing }
                  where
                    srcTxt :: SourceText
srcTxt = String -> SourceText
SourceText String
"{-# OPAQUE"
       ; HsDecl (GhcPass 'Parsed)
-> CvtM (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))))
forall a. a -> CvtM (Maybe (LocatedA a))
returnJustLA (HsDecl (GhcPass 'Parsed)
 -> CvtM
      (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed)))))
-> HsDecl (GhcPass 'Parsed)
-> CvtM (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))))
forall a b. (a -> b) -> a -> b
$ XSigD (GhcPass 'Parsed)
-> Sig (GhcPass 'Parsed) -> HsDecl (GhcPass 'Parsed)
forall p. XSigD p -> Sig p -> HsDecl p
Hs.SigD XSigD (GhcPass 'Parsed)
NoExtField
noExtField (Sig (GhcPass 'Parsed) -> HsDecl (GhcPass 'Parsed))
-> Sig (GhcPass 'Parsed) -> HsDecl (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$ XInlineSig (GhcPass 'Parsed)
-> LIdP (GhcPass 'Parsed) -> InlinePragma -> Sig (GhcPass 'Parsed)
forall pass.
XInlineSig pass -> LIdP pass -> InlinePragma -> Sig pass
InlineSig XInlineSig (GhcPass 'Parsed)
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn LIdP (GhcPass 'Parsed)
GenLocated SrcSpanAnnN RdrName
nm' InlinePragma
ip }

cvtPragmaD (SpecialiseP Name
nm Type
ty Maybe Inline
inline Phases
phases)
  = do { GenLocated SrcSpanAnnN RdrName
nm' <- Name -> CvtM (GenLocated SrcSpanAnnN RdrName)
vNameN Name
nm
       ; GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Parsed))
ty' <- Type -> CvtM (LHsSigType (GhcPass 'Parsed))
cvtSigType Type
ty
       ; let src :: Inline -> String
src Inline
TH.NoInline  = String
"{-# SPECIALISE NOINLINE"
             src Inline
TH.Inline    = String
"{-# SPECIALISE INLINE"
             src Inline
TH.Inlinable = String
"{-# SPECIALISE INLINE"
       ; let (InlineSpec
inline', Activation
dflt, SourceText
srcText) = case Maybe Inline
inline of
               Just Inline
inline1 -> (Inline -> SourceText -> InlineSpec
cvtInline Inline
inline1 (Inline -> SourceText
toSrcTxt Inline
inline1), Inline -> Activation
dfltActivation Inline
inline1,
                                Inline -> SourceText
toSrcTxt Inline
inline1)
               Maybe Inline
Nothing      -> (InlineSpec
NoUserInlinePrag,   Activation
AlwaysActive,
                                String -> SourceText
SourceText String
"{-# SPECIALISE")
               where
                toSrcTxt :: Inline -> SourceText
toSrcTxt Inline
a = String -> SourceText
SourceText (String -> SourceText) -> String -> SourceText
forall a b. (a -> b) -> a -> b
$ Inline -> String
src Inline
a
       ; let ip :: InlinePragma
ip = InlinePragma { inl_src :: SourceText
inl_src    = SourceText
srcText
                               , inl_inline :: InlineSpec
inl_inline = InlineSpec
inline'
                               , inl_rule :: RuleMatchInfo
inl_rule   = RuleMatchInfo
Hs.FunLike
                               , inl_act :: Activation
inl_act    = Phases -> Activation -> Activation
cvtPhases Phases
phases Activation
dflt
                               , inl_sat :: Maybe Int
inl_sat    = Maybe Int
forall a. Maybe a
Nothing }
       ; HsDecl (GhcPass 'Parsed)
-> CvtM (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))))
forall a. a -> CvtM (Maybe (LocatedA a))
returnJustLA (HsDecl (GhcPass 'Parsed)
 -> CvtM
      (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed)))))
-> HsDecl (GhcPass 'Parsed)
-> CvtM (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))))
forall a b. (a -> b) -> a -> b
$ XSigD (GhcPass 'Parsed)
-> Sig (GhcPass 'Parsed) -> HsDecl (GhcPass 'Parsed)
forall p. XSigD p -> Sig p -> HsDecl p
Hs.SigD XSigD (GhcPass 'Parsed)
NoExtField
noExtField (Sig (GhcPass 'Parsed) -> HsDecl (GhcPass 'Parsed))
-> Sig (GhcPass 'Parsed) -> HsDecl (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$ XSpecSig (GhcPass 'Parsed)
-> LIdP (GhcPass 'Parsed)
-> [LHsSigType (GhcPass 'Parsed)]
-> InlinePragma
-> Sig (GhcPass 'Parsed)
forall pass.
XSpecSig pass
-> LIdP pass -> [LHsSigType pass] -> InlinePragma -> Sig pass
SpecSig XSpecSig (GhcPass 'Parsed)
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn LIdP (GhcPass 'Parsed)
GenLocated SrcSpanAnnN RdrName
nm' [LHsSigType (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Parsed))
ty'] InlinePragma
ip }

cvtPragmaD (SpecialiseInstP Type
ty)
  = do { GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Parsed))
ty' <- Type -> CvtM (LHsSigType (GhcPass 'Parsed))
cvtSigType Type
ty
       ; HsDecl (GhcPass 'Parsed)
-> CvtM (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))))
forall a. a -> CvtM (Maybe (LocatedA a))
returnJustLA (HsDecl (GhcPass 'Parsed)
 -> CvtM
      (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed)))))
-> HsDecl (GhcPass 'Parsed)
-> CvtM (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))))
forall a b. (a -> b) -> a -> b
$ XSigD (GhcPass 'Parsed)
-> Sig (GhcPass 'Parsed) -> HsDecl (GhcPass 'Parsed)
forall p. XSigD p -> Sig p -> HsDecl p
Hs.SigD XSigD (GhcPass 'Parsed)
NoExtField
noExtField (Sig (GhcPass 'Parsed) -> HsDecl (GhcPass 'Parsed))
-> Sig (GhcPass 'Parsed) -> HsDecl (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$
         XSpecInstSig (GhcPass 'Parsed)
-> SourceText
-> LHsSigType (GhcPass 'Parsed)
-> Sig (GhcPass 'Parsed)
forall pass.
XSpecInstSig pass -> SourceText -> LHsSigType pass -> Sig pass
SpecInstSig XSpecInstSig (GhcPass 'Parsed)
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn (String -> SourceText
SourceText String
"{-# SPECIALISE") LHsSigType (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Parsed))
ty' }

cvtPragmaD (RuleP String
nm Maybe [TyVarBndr ()]
ty_bndrs [RuleBndr]
tm_bndrs Exp
lhs Exp
rhs Phases
phases)
  = do { let nm' :: CLabelString
nm' = String -> CLabelString
mkFastString String
nm
       ; LocatedAn NoEpAnns (SourceText, CLabelString)
rd_name' <- (SourceText, CLabelString)
-> CvtM (LocatedAn NoEpAnns (SourceText, CLabelString))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (String -> SourceText
quotedSourceText String
nm,CLabelString
nm')
       ; let act :: Activation
act = Phases -> Activation -> Activation
cvtPhases Phases
phases Activation
AlwaysActive
       ; Maybe [GenLocated SrcSpanAnnA (HsTyVarBndr () (GhcPass 'Parsed))]
ty_bndrs' <- ([TyVarBndr ()]
 -> CvtM
      [GenLocated SrcSpanAnnA (HsTyVarBndr () (GhcPass 'Parsed))])
-> Maybe [TyVarBndr ()]
-> CvtM
     (Maybe [GenLocated SrcSpanAnnA (HsTyVarBndr () (GhcPass 'Parsed))])
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse [TyVarBndr ()] -> CvtM [LHsTyVarBndr () (GhcPass 'Parsed)]
[TyVarBndr ()]
-> CvtM [GenLocated SrcSpanAnnA (HsTyVarBndr () (GhcPass 'Parsed))]
forall flag flag'.
CvtFlag flag flag' =>
[TyVarBndr flag] -> CvtM [LHsTyVarBndr flag' (GhcPass 'Parsed)]
cvtTvs Maybe [TyVarBndr ()]
ty_bndrs
       ; [GenLocated (SrcAnn NoEpAnns) (RuleBndr (GhcPass 'Parsed))]
tm_bndrs' <- (RuleBndr
 -> CvtM
      (GenLocated (SrcAnn NoEpAnns) (RuleBndr (GhcPass 'Parsed))))
-> [RuleBndr]
-> CvtM [GenLocated (SrcAnn NoEpAnns) (RuleBndr (GhcPass 'Parsed))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM RuleBndr -> CvtM (LRuleBndr (GhcPass 'Parsed))
RuleBndr
-> CvtM (GenLocated (SrcAnn NoEpAnns) (RuleBndr (GhcPass 'Parsed)))
cvtRuleBndr [RuleBndr]
tm_bndrs
       ; LocatedA (HsExpr (GhcPass 'Parsed))
lhs'   <- Exp -> CvtM (LHsExpr (GhcPass 'Parsed))
cvtl Exp
lhs
       ; LocatedA (HsExpr (GhcPass 'Parsed))
rhs'   <- Exp -> CvtM (LHsExpr (GhcPass 'Parsed))
cvtl Exp
rhs
       ; LocatedAn AnnListItem (RuleDecl (GhcPass 'Parsed))
rule <- RuleDecl (GhcPass 'Parsed)
-> CvtM (LocatedAn AnnListItem (RuleDecl (GhcPass 'Parsed)))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (RuleDecl (GhcPass 'Parsed)
 -> CvtM (LocatedAn AnnListItem (RuleDecl (GhcPass 'Parsed))))
-> RuleDecl (GhcPass 'Parsed)
-> CvtM (LocatedAn AnnListItem (RuleDecl (GhcPass 'Parsed)))
forall a b. (a -> b) -> a -> b
$
                   HsRule { rd_ext :: XHsRule (GhcPass 'Parsed)
rd_ext  = XHsRule (GhcPass 'Parsed)
EpAnn HsRuleAnn
forall a. EpAnn a
noAnn
                          , rd_name :: XRec (GhcPass 'Parsed) (SourceText, CLabelString)
rd_name = XRec (GhcPass 'Parsed) (SourceText, CLabelString)
LocatedAn NoEpAnns (SourceText, CLabelString)
rd_name'
                          , rd_act :: Activation
rd_act  = Activation
act
                          , rd_tyvs :: Maybe [LHsTyVarBndr () (NoGhcTc (GhcPass 'Parsed))]
rd_tyvs = Maybe [LHsTyVarBndr () (NoGhcTc (GhcPass 'Parsed))]
Maybe [GenLocated SrcSpanAnnA (HsTyVarBndr () (GhcPass 'Parsed))]
ty_bndrs'
                          , rd_tmvs :: [LRuleBndr (GhcPass 'Parsed)]
rd_tmvs = [LRuleBndr (GhcPass 'Parsed)]
[GenLocated (SrcAnn NoEpAnns) (RuleBndr (GhcPass 'Parsed))]
tm_bndrs'
                          , rd_lhs :: LHsExpr (GhcPass 'Parsed)
rd_lhs  = LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
lhs'
                          , rd_rhs :: LHsExpr (GhcPass 'Parsed)
rd_rhs  = LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
rhs' }
       ; HsDecl (GhcPass 'Parsed)
-> CvtM (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))))
forall a. a -> CvtM (Maybe (LocatedA a))
returnJustLA (HsDecl (GhcPass 'Parsed)
 -> CvtM
      (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed)))))
-> HsDecl (GhcPass 'Parsed)
-> CvtM (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))))
forall a b. (a -> b) -> a -> b
$ XRuleD (GhcPass 'Parsed)
-> RuleDecls (GhcPass 'Parsed) -> HsDecl (GhcPass 'Parsed)
forall p. XRuleD p -> RuleDecls p -> HsDecl p
Hs.RuleD XRuleD (GhcPass 'Parsed)
NoExtField
noExtField
            (RuleDecls (GhcPass 'Parsed) -> HsDecl (GhcPass 'Parsed))
-> RuleDecls (GhcPass 'Parsed) -> HsDecl (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$ HsRules { rds_ext :: XCRuleDecls (GhcPass 'Parsed)
rds_ext = XCRuleDecls (GhcPass 'Parsed)
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn
                      , rds_src :: SourceText
rds_src = String -> SourceText
SourceText String
"{-# RULES"
                      , rds_rules :: [LRuleDecl (GhcPass 'Parsed)]
rds_rules = [LRuleDecl (GhcPass 'Parsed)
LocatedAn AnnListItem (RuleDecl (GhcPass 'Parsed))
rule] }

          }

cvtPragmaD (AnnP AnnTarget
target Exp
exp)
  = do { LocatedA (HsExpr (GhcPass 'Parsed))
exp' <- Exp -> CvtM (LHsExpr (GhcPass 'Parsed))
cvtl Exp
exp
       ; AnnProvenance (GhcPass 'Parsed)
target' <- case AnnTarget
target of
         AnnTarget
ModuleAnnotation  -> AnnProvenance (GhcPass 'Parsed)
-> CvtM (AnnProvenance (GhcPass 'Parsed))
forall a. a -> CvtM a
forall (m :: * -> *) a. Monad m => a -> m a
return AnnProvenance (GhcPass 'Parsed)
forall pass. AnnProvenance pass
ModuleAnnProvenance
         TypeAnnotation Name
n  -> do
           RdrName
n' <- Name -> CvtM RdrName
tconName Name
n
           (GenLocated SrcSpanAnnN RdrName -> AnnProvenance (GhcPass 'Parsed))
-> RdrName -> CvtM (AnnProvenance (GhcPass 'Parsed))
forall ann a b. (LocatedAn ann a -> b) -> a -> CvtM b
wrapParLA LIdP (GhcPass 'Parsed) -> AnnProvenance (GhcPass 'Parsed)
GenLocated SrcSpanAnnN RdrName -> AnnProvenance (GhcPass 'Parsed)
forall pass. LIdP pass -> AnnProvenance pass
TypeAnnProvenance RdrName
n'
         ValueAnnotation Name
n -> do
           RdrName
n' <- Name -> CvtM RdrName
vcName Name
n
           (GenLocated SrcSpanAnnN RdrName -> AnnProvenance (GhcPass 'Parsed))
-> RdrName -> CvtM (AnnProvenance (GhcPass 'Parsed))
forall ann a b. (LocatedAn ann a -> b) -> a -> CvtM b
wrapParLA LIdP (GhcPass 'Parsed) -> AnnProvenance (GhcPass 'Parsed)
GenLocated SrcSpanAnnN RdrName -> AnnProvenance (GhcPass 'Parsed)
forall pass. LIdP pass -> AnnProvenance pass
ValueAnnProvenance RdrName
n'
       ; HsDecl (GhcPass 'Parsed)
-> CvtM (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))))
forall a. a -> CvtM (Maybe (LocatedA a))
returnJustLA (HsDecl (GhcPass 'Parsed)
 -> CvtM
      (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed)))))
-> HsDecl (GhcPass 'Parsed)
-> CvtM (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))))
forall a b. (a -> b) -> a -> b
$ XAnnD (GhcPass 'Parsed)
-> AnnDecl (GhcPass 'Parsed) -> HsDecl (GhcPass 'Parsed)
forall p. XAnnD p -> AnnDecl p -> HsDecl p
Hs.AnnD XAnnD (GhcPass 'Parsed)
NoExtField
noExtField
                     (AnnDecl (GhcPass 'Parsed) -> HsDecl (GhcPass 'Parsed))
-> AnnDecl (GhcPass 'Parsed) -> HsDecl (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$ XHsAnnotation (GhcPass 'Parsed)
-> SourceText
-> AnnProvenance (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> AnnDecl (GhcPass 'Parsed)
forall pass.
XHsAnnotation pass
-> SourceText
-> AnnProvenance pass
-> XRec pass (HsExpr pass)
-> AnnDecl pass
HsAnnotation XHsAnnotation (GhcPass 'Parsed)
EpAnn AnnPragma
forall a. EpAnn a
noAnn (String -> SourceText
SourceText String
"{-# ANN") AnnProvenance (GhcPass 'Parsed)
target' LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
exp'
       }

-- NB: This is the only place in GHC.ThToHs that makes use of the `setL`
-- function. See Note [Source locations within TH splices].
cvtPragmaD (LineP Int
line String
file)
  = do { SrcSpan -> CvtM ()
setL (SrcLoc -> SrcSpan
srcLocSpan (CLabelString -> Int -> Int -> SrcLoc
mkSrcLoc (String -> CLabelString
fsLit String
file) Int
line Int
1))
       ; Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed)))
-> CvtM (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))))
forall a. a -> CvtM a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed)))
forall a. Maybe a
Nothing
       }
cvtPragmaD (CompleteP [Name]
cls Maybe Name
mty)
  = do { Located [GenLocated SrcSpanAnnN RdrName]
cls'  <- CvtM [GenLocated SrcSpanAnnN RdrName]
-> CvtM (Located [GenLocated SrcSpanAnnN RdrName])
forall a. CvtM a -> CvtM (Located a)
wrapL (CvtM [GenLocated SrcSpanAnnN RdrName]
 -> CvtM (Located [GenLocated SrcSpanAnnN RdrName]))
-> CvtM [GenLocated SrcSpanAnnN RdrName]
-> CvtM (Located [GenLocated SrcSpanAnnN RdrName])
forall a b. (a -> b) -> a -> b
$ (Name -> CvtM (GenLocated SrcSpanAnnN RdrName))
-> [Name] -> CvtM [GenLocated SrcSpanAnnN RdrName]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Name -> CvtM (GenLocated SrcSpanAnnN RdrName)
cNameN [Name]
cls
       ; Maybe (GenLocated SrcSpanAnnN RdrName)
mty'  <- (Name -> CvtM (GenLocated SrcSpanAnnN RdrName))
-> Maybe Name -> CvtM (Maybe (GenLocated SrcSpanAnnN RdrName))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse Name -> CvtM (GenLocated SrcSpanAnnN RdrName)
tconNameN Maybe Name
mty
       ; HsDecl (GhcPass 'Parsed)
-> CvtM (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))))
forall a. a -> CvtM (Maybe (LocatedA a))
returnJustLA (HsDecl (GhcPass 'Parsed)
 -> CvtM
      (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed)))))
-> HsDecl (GhcPass 'Parsed)
-> CvtM (Maybe (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))))
forall a b. (a -> b) -> a -> b
$ XSigD (GhcPass 'Parsed)
-> Sig (GhcPass 'Parsed) -> HsDecl (GhcPass 'Parsed)
forall p. XSigD p -> Sig p -> HsDecl p
Hs.SigD XSigD (GhcPass 'Parsed)
NoExtField
noExtField
                   (Sig (GhcPass 'Parsed) -> HsDecl (GhcPass 'Parsed))
-> Sig (GhcPass 'Parsed) -> HsDecl (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$ XCompleteMatchSig (GhcPass 'Parsed)
-> SourceText
-> XRec (GhcPass 'Parsed) [LIdP (GhcPass 'Parsed)]
-> Maybe (LIdP (GhcPass 'Parsed))
-> Sig (GhcPass 'Parsed)
forall pass.
XCompleteMatchSig pass
-> SourceText
-> XRec pass [LIdP pass]
-> Maybe (LIdP pass)
-> Sig pass
CompleteMatchSig XCompleteMatchSig (GhcPass 'Parsed)
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn SourceText
NoSourceText XRec (GhcPass 'Parsed) [LIdP (GhcPass 'Parsed)]
Located [GenLocated SrcSpanAnnN RdrName]
cls' Maybe (LIdP (GhcPass 'Parsed))
Maybe (GenLocated SrcSpanAnnN RdrName)
mty' }

dfltActivation :: TH.Inline -> Activation
dfltActivation :: Inline -> Activation
dfltActivation Inline
TH.NoInline = Activation
NeverActive
dfltActivation Inline
_           = Activation
AlwaysActive

cvtInline :: TH.Inline  -> SourceText -> Hs.InlineSpec
cvtInline :: Inline -> SourceText -> InlineSpec
cvtInline Inline
TH.NoInline   SourceText
srcText  = SourceText -> InlineSpec
Hs.NoInline  SourceText
srcText
cvtInline Inline
TH.Inline     SourceText
srcText  = SourceText -> InlineSpec
Hs.Inline    SourceText
srcText
cvtInline Inline
TH.Inlinable  SourceText
srcText  = SourceText -> InlineSpec
Hs.Inlinable SourceText
srcText

cvtRuleMatch :: TH.RuleMatch -> RuleMatchInfo
cvtRuleMatch :: RuleMatch -> RuleMatchInfo
cvtRuleMatch RuleMatch
TH.ConLike = RuleMatchInfo
Hs.ConLike
cvtRuleMatch RuleMatch
TH.FunLike = RuleMatchInfo
Hs.FunLike

cvtPhases :: TH.Phases -> Activation -> Activation
cvtPhases :: Phases -> Activation -> Activation
cvtPhases Phases
AllPhases       Activation
dflt = Activation
dflt
cvtPhases (FromPhase Int
i)   Activation
_    = SourceText -> Int -> Activation
ActiveAfter SourceText
NoSourceText Int
i
cvtPhases (BeforePhase Int
i) Activation
_    = SourceText -> Int -> Activation
ActiveBefore SourceText
NoSourceText Int
i

cvtRuleBndr :: TH.RuleBndr -> CvtM (Hs.LRuleBndr GhcPs)
cvtRuleBndr :: RuleBndr -> CvtM (LRuleBndr (GhcPass 'Parsed))
cvtRuleBndr (RuleVar Name
n)
  = do { GenLocated SrcSpanAnnN RdrName
n' <- Name -> CvtM (GenLocated SrcSpanAnnN RdrName)
vNameN Name
n
       ; RuleBndr (GhcPass 'Parsed)
-> CvtM (GenLocated (SrcAnn NoEpAnns) (RuleBndr (GhcPass 'Parsed)))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (RuleBndr (GhcPass 'Parsed)
 -> CvtM
      (GenLocated (SrcAnn NoEpAnns) (RuleBndr (GhcPass 'Parsed))))
-> RuleBndr (GhcPass 'Parsed)
-> CvtM (GenLocated (SrcAnn NoEpAnns) (RuleBndr (GhcPass 'Parsed)))
forall a b. (a -> b) -> a -> b
$ XCRuleBndr (GhcPass 'Parsed)
-> LIdP (GhcPass 'Parsed) -> RuleBndr (GhcPass 'Parsed)
forall pass. XCRuleBndr pass -> LIdP pass -> RuleBndr pass
Hs.RuleBndr XCRuleBndr (GhcPass 'Parsed)
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn LIdP (GhcPass 'Parsed)
GenLocated SrcSpanAnnN RdrName
n' }
cvtRuleBndr (TypedRuleVar Name
n Type
ty)
  = do { GenLocated SrcSpanAnnN RdrName
n'  <- Name -> CvtM (GenLocated SrcSpanAnnN RdrName)
vNameN Name
n
       ; GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
ty' <- Type -> CvtM (LHsType (GhcPass 'Parsed))
cvtType Type
ty
       ; RuleBndr (GhcPass 'Parsed)
-> CvtM (GenLocated (SrcAnn NoEpAnns) (RuleBndr (GhcPass 'Parsed)))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (RuleBndr (GhcPass 'Parsed)
 -> CvtM
      (GenLocated (SrcAnn NoEpAnns) (RuleBndr (GhcPass 'Parsed))))
-> RuleBndr (GhcPass 'Parsed)
-> CvtM (GenLocated (SrcAnn NoEpAnns) (RuleBndr (GhcPass 'Parsed)))
forall a b. (a -> b) -> a -> b
$ XRuleBndrSig (GhcPass 'Parsed)
-> LIdP (GhcPass 'Parsed)
-> HsPatSigType (GhcPass 'Parsed)
-> RuleBndr (GhcPass 'Parsed)
forall pass.
XRuleBndrSig pass
-> LIdP pass -> HsPatSigType pass -> RuleBndr pass
Hs.RuleBndrSig XRuleBndrSig (GhcPass 'Parsed)
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn LIdP (GhcPass 'Parsed)
GenLocated SrcSpanAnnN RdrName
n' (HsPatSigType (GhcPass 'Parsed) -> RuleBndr (GhcPass 'Parsed))
-> HsPatSigType (GhcPass 'Parsed) -> RuleBndr (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$ EpAnn EpaLocation
-> LHsType (GhcPass 'Parsed) -> HsPatSigType (GhcPass 'Parsed)
mkHsPatSigType EpAnn EpaLocation
forall a. EpAnn a
noAnn LHsType (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
ty' }

---------------------------------------------------
--              Declarations
---------------------------------------------------

cvtLocalDecs :: SDoc -> [TH.Dec] -> CvtM (HsLocalBinds GhcPs)
cvtLocalDecs :: SDoc -> [Dec] -> CvtM (HsLocalBinds (GhcPass 'Parsed))
cvtLocalDecs SDoc
doc [Dec]
ds
  = case (Dec -> Either (String, Exp) Dec)
-> [Dec] -> ([(String, Exp)], [Dec])
forall a b c. (a -> Either b c) -> [a] -> ([b], [c])
partitionWith Dec -> Either (String, Exp) Dec
is_ip_bind [Dec]
ds of
      ([], []) -> HsLocalBinds (GhcPass 'Parsed)
-> CvtM (HsLocalBinds (GhcPass 'Parsed))
forall a. a -> CvtM a
forall (m :: * -> *) a. Monad m => a -> m a
return (XEmptyLocalBinds (GhcPass 'Parsed) (GhcPass 'Parsed)
-> HsLocalBinds (GhcPass 'Parsed)
forall idL idR. XEmptyLocalBinds idL idR -> HsLocalBindsLR idL idR
EmptyLocalBinds XEmptyLocalBinds (GhcPass 'Parsed) (GhcPass 'Parsed)
NoExtField
noExtField)
      ([], [Dec]
_) -> do
        [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))]
ds' <- [Dec] -> CvtM [LHsDecl (GhcPass 'Parsed)]
cvtDecs [Dec]
ds
        let ([GenLocated SrcSpanAnnA (HsBind (GhcPass 'Parsed))]
binds, [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))]
prob_sigs) = (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))
 -> Either
      (GenLocated SrcSpanAnnA (HsBind (GhcPass 'Parsed)))
      (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))))
-> [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))]
-> ([GenLocated SrcSpanAnnA (HsBind (GhcPass 'Parsed))],
    [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))])
forall a b c. (a -> Either b c) -> [a] -> ([b], [c])
partitionWith LHsDecl (GhcPass 'Parsed)
-> Either (LHsBind (GhcPass 'Parsed)) (LHsDecl (GhcPass 'Parsed))
GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))
-> Either
     (GenLocated SrcSpanAnnA (HsBind (GhcPass 'Parsed)))
     (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed)))
is_bind [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))]
ds'
        let ([GenLocated SrcSpanAnnA (Sig (GhcPass 'Parsed))]
sigs, [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))]
bads) = (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))
 -> Either
      (GenLocated SrcSpanAnnA (Sig (GhcPass 'Parsed)))
      (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))))
-> [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))]
-> ([GenLocated SrcSpanAnnA (Sig (GhcPass 'Parsed))],
    [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))])
forall a b c. (a -> Either b c) -> [a] -> ([b], [c])
partitionWith LHsDecl (GhcPass 'Parsed)
-> Either (LSig (GhcPass 'Parsed)) (LHsDecl (GhcPass 'Parsed))
GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))
-> Either
     (GenLocated SrcSpanAnnA (Sig (GhcPass 'Parsed)))
     (GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed)))
is_sig [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))]
prob_sigs
        Bool -> CvtM () -> CvtM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))]
bads) (SDoc -> CvtM ()
forall a. SDoc -> CvtM a
failWith (SDoc -> [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))] -> SDoc
forall a. Outputable a => SDoc -> [a] -> SDoc
mkBadDecMsg SDoc
doc [GenLocated SrcSpanAnnA (HsDecl (GhcPass 'Parsed))]
bads))
        HsLocalBinds (GhcPass 'Parsed)
-> CvtM (HsLocalBinds (GhcPass 'Parsed))
forall a. a -> CvtM a
forall (m :: * -> *) a. Monad m => a -> m a
return (XHsValBinds (GhcPass 'Parsed) (GhcPass 'Parsed)
-> HsValBindsLR (GhcPass 'Parsed) (GhcPass 'Parsed)
-> HsLocalBinds (GhcPass 'Parsed)
forall idL idR.
XHsValBinds idL idR
-> HsValBindsLR idL idR -> HsLocalBindsLR idL idR
HsValBinds XHsValBinds (GhcPass 'Parsed) (GhcPass 'Parsed)
EpAnn AnnList
forall a. EpAnn a
noAnn (XValBinds (GhcPass 'Parsed) (GhcPass 'Parsed)
-> LHsBinds (GhcPass 'Parsed)
-> [LSig (GhcPass 'Parsed)]
-> HsValBindsLR (GhcPass 'Parsed) (GhcPass 'Parsed)
forall idL idR.
XValBinds idL idR
-> LHsBindsLR idL idR -> [LSig idR] -> HsValBindsLR idL idR
ValBinds XValBinds (GhcPass 'Parsed) (GhcPass 'Parsed)
AnnSortKey
NoAnnSortKey ([GenLocated SrcSpanAnnA (HsBind (GhcPass 'Parsed))]
-> Bag (GenLocated SrcSpanAnnA (HsBind (GhcPass 'Parsed)))
forall a. [a] -> Bag a
listToBag [GenLocated SrcSpanAnnA (HsBind (GhcPass 'Parsed))]
binds) [LSig (GhcPass 'Parsed)]
[GenLocated SrcSpanAnnA (Sig (GhcPass 'Parsed))]
sigs))
      ([(String, Exp)]
ip_binds, []) -> do
        [GenLocated SrcSpanAnnA (IPBind (GhcPass 'Parsed))]
binds <- ((String, Exp)
 -> CvtM (GenLocated SrcSpanAnnA (IPBind (GhcPass 'Parsed))))
-> [(String, Exp)]
-> CvtM [GenLocated SrcSpanAnnA (IPBind (GhcPass 'Parsed))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((String
 -> Exp -> CvtM (GenLocated SrcSpanAnnA (IPBind (GhcPass 'Parsed))))
-> (String, Exp)
-> CvtM (GenLocated SrcSpanAnnA (IPBind (GhcPass 'Parsed)))
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> Exp -> CvtM (LIPBind (GhcPass 'Parsed))
String
-> Exp -> CvtM (GenLocated SrcSpanAnnA (IPBind (GhcPass 'Parsed)))
cvtImplicitParamBind) [(String, Exp)]
ip_binds
        HsLocalBinds (GhcPass 'Parsed)
-> CvtM (HsLocalBinds (GhcPass 'Parsed))
forall a. a -> CvtM a
forall (m :: * -> *) a. Monad m => a -> m a
return (XHsIPBinds (GhcPass 'Parsed) (GhcPass 'Parsed)
-> HsIPBinds (GhcPass 'Parsed) -> HsLocalBinds (GhcPass 'Parsed)
forall idL idR.
XHsIPBinds idL idR -> HsIPBinds idR -> HsLocalBindsLR idL idR
HsIPBinds XHsIPBinds (GhcPass 'Parsed) (GhcPass 'Parsed)
EpAnn AnnList
forall a. EpAnn a
noAnn (XIPBinds (GhcPass 'Parsed)
-> [LIPBind (GhcPass 'Parsed)] -> HsIPBinds (GhcPass 'Parsed)
forall id. XIPBinds id -> [LIPBind id] -> HsIPBinds id
IPBinds XIPBinds (GhcPass 'Parsed)
NoExtField
noExtField [LIPBind (GhcPass 'Parsed)]
[GenLocated SrcSpanAnnA (IPBind (GhcPass 'Parsed))]
binds))
      (((String, Exp)
_:[(String, Exp)]
_), (Dec
_:[Dec]
_)) ->
        SDoc -> CvtM (HsLocalBinds (GhcPass 'Parsed))
forall a. SDoc -> CvtM a
failWith (String -> SDoc
text String
"Implicit parameters mixed with other bindings")

cvtClause :: HsMatchContext GhcPs
          -> TH.Clause -> CvtM (Hs.LMatch GhcPs (LHsExpr GhcPs))
cvtClause :: HsMatchContext (GhcPass 'Parsed)
-> Clause
-> CvtM (LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)))
cvtClause HsMatchContext (GhcPass 'Parsed)
ctxt (Clause [Pat]
ps Body
body [Dec]
wheres)
  = do  { [GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))]
ps' <- [Pat] -> CvtM [LPat (GhcPass 'Parsed)]
cvtPats [Pat]
ps
        ; let pps :: [GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))]
pps = (GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
 -> GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed)))
-> [GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))]
-> [GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))]
forall a b. (a -> b) -> [a] -> [b]
map (PprPrec -> LPat (GhcPass 'Parsed) -> LPat (GhcPass 'Parsed)
forall (p :: Pass).
IsPass p =>
PprPrec -> LPat (GhcPass p) -> LPat (GhcPass p)
parenthesizePat PprPrec
appPrec) [GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))]
ps'
        ; [GenLocated
   (SrcAnn NoEpAnns)
   (GRHS (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
g'  <- Body -> CvtM [LGRHS (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
cvtGuard Body
body
        ; HsLocalBinds (GhcPass 'Parsed)
ds' <- SDoc -> [Dec] -> CvtM (HsLocalBinds (GhcPass 'Parsed))
cvtLocalDecs (String -> SDoc
text String
"a where clause") [Dec]
wheres
        ; Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
-> CvtM
     (GenLocated
        SrcSpanAnnA
        (Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
 -> CvtM
      (GenLocated
         SrcSpanAnnA
         (Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))))
-> Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
-> CvtM
     (GenLocated
        SrcSpanAnnA
        (Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))))
forall a b. (a -> b) -> a -> b
$ XCMatch (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
-> HsMatchContext (GhcPass 'Parsed)
-> [LPat (GhcPass 'Parsed)]
-> GRHSs (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
-> Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
forall p body.
XCMatch p body
-> HsMatchContext p -> [LPat p] -> GRHSs p body -> Match p body
Hs.Match XCMatch (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn HsMatchContext (GhcPass 'Parsed)
ctxt [LPat (GhcPass 'Parsed)]
[GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))]
pps (XCGRHSs (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
-> [LGRHS (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))]
-> HsLocalBinds (GhcPass 'Parsed)
-> GRHSs (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
forall p body.
XCGRHSs p body -> [LGRHS p body] -> HsLocalBinds p -> GRHSs p body
GRHSs XCGRHSs (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
EpAnnComments
emptyComments [LGRHS (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))]
[GenLocated
   (SrcAnn NoEpAnns)
   (GRHS (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
g' HsLocalBinds (GhcPass 'Parsed)
ds') }

cvtImplicitParamBind :: String -> TH.Exp -> CvtM (LIPBind GhcPs)
cvtImplicitParamBind :: String -> Exp -> CvtM (LIPBind (GhcPass 'Parsed))
cvtImplicitParamBind String
n Exp
e = do
    Located HsIPName
n' <- CvtM HsIPName -> CvtM (Located HsIPName)
forall a. CvtM a -> CvtM (Located a)
wrapL (String -> CvtM HsIPName
ipName String
n)
    LocatedA (HsExpr (GhcPass 'Parsed))
e' <- Exp -> CvtM (LHsExpr (GhcPass 'Parsed))
cvtl Exp
e
    IPBind (GhcPass 'Parsed)
-> CvtM (GenLocated SrcSpanAnnA (IPBind (GhcPass 'Parsed)))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (XCIPBind (GhcPass 'Parsed)
-> XRec (GhcPass 'Parsed) HsIPName
-> LHsExpr (GhcPass 'Parsed)
-> IPBind (GhcPass 'Parsed)
forall id.
XCIPBind id -> XRec id HsIPName -> LHsExpr id -> IPBind id
IPBind XCIPBind (GhcPass 'Parsed)
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn (Located HsIPName -> LocatedAn NoEpAnns HsIPName
forall e ann. Located e -> LocatedAn ann e
reLocA Located HsIPName
n') LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
e')

-------------------------------------------------------------------
--              Expressions
-------------------------------------------------------------------

cvtl :: TH.Exp -> CvtM (LHsExpr GhcPs)
cvtl :: Exp -> CvtM (LHsExpr (GhcPass 'Parsed))
cvtl Exp
e = CvtM (HsExpr (GhcPass 'Parsed))
-> CvtM (LocatedA (HsExpr (GhcPass 'Parsed)))
forall a. CvtM a -> CvtM (LocatedA a)
wrapLA (Exp -> CvtM (HsExpr (GhcPass 'Parsed))
cvt Exp
e)
  where
    cvt :: Exp -> CvtM (HsExpr (GhcPass 'Parsed))
cvt (VarE Name
s)   = do { RdrName
s' <- Name -> CvtM RdrName
vName Name
s; (GenLocated SrcSpanAnnN RdrName -> HsExpr (GhcPass 'Parsed))
-> RdrName -> CvtM (HsExpr (GhcPass 'Parsed))
forall ann a b. (LocatedAn ann a -> b) -> a -> CvtM b
wrapParLA (XVar (GhcPass 'Parsed)
-> LIdP (GhcPass 'Parsed) -> HsExpr (GhcPass 'Parsed)
forall p. XVar p -> LIdP p -> HsExpr p
HsVar XVar (GhcPass 'Parsed)
NoExtField
noExtField) RdrName
s' }
    cvt (ConE Name
s)   = do { RdrName
s' <- Name -> CvtM RdrName
cName Name
s; (GenLocated SrcSpanAnnN RdrName -> HsExpr (GhcPass 'Parsed))
-> RdrName -> CvtM (HsExpr (GhcPass 'Parsed))
forall ann a b. (LocatedAn ann a -> b) -> a -> CvtM b
wrapParLA (XVar (GhcPass 'Parsed)
-> LIdP (GhcPass 'Parsed) -> HsExpr (GhcPass 'Parsed)
forall p. XVar p -> LIdP p -> HsExpr p
HsVar XVar (GhcPass 'Parsed)
NoExtField
noExtField) RdrName
s' }
    cvt (LitE Lit
l)
      | Lit -> Bool
overloadedLit Lit
l = (Lit -> CvtM (HsOverLit (GhcPass 'Parsed)))
-> (HsOverLit (GhcPass 'Parsed) -> HsExpr (GhcPass 'Parsed))
-> (HsOverLit (GhcPass 'Parsed) -> Bool)
-> CvtM (HsExpr (GhcPass 'Parsed))
forall (l :: * -> *).
(Lit -> CvtM (l (GhcPass 'Parsed)))
-> (l (GhcPass 'Parsed) -> HsExpr (GhcPass 'Parsed))
-> (l (GhcPass 'Parsed) -> Bool)
-> CvtM (HsExpr (GhcPass 'Parsed))
go Lit -> CvtM (HsOverLit (GhcPass 'Parsed))
cvtOverLit (XOverLitE (GhcPass 'Parsed)
-> HsOverLit (GhcPass 'Parsed) -> HsExpr (GhcPass 'Parsed)
forall p. XOverLitE p -> HsOverLit p -> HsExpr p
HsOverLit XOverLitE (GhcPass 'Parsed)
EpAnnCO
noComments)
                             (PprPrec -> HsOverLit (GhcPass 'Parsed) -> Bool
forall x. PprPrec -> HsOverLit x -> Bool
hsOverLitNeedsParens PprPrec
appPrec)
      | Bool
otherwise       = (Lit -> CvtM (HsLit (GhcPass 'Parsed)))
-> (HsLit (GhcPass 'Parsed) -> HsExpr (GhcPass 'Parsed))
-> (HsLit (GhcPass 'Parsed) -> Bool)
-> CvtM (HsExpr (GhcPass 'Parsed))
forall (l :: * -> *).
(Lit -> CvtM (l (GhcPass 'Parsed)))
-> (l (GhcPass 'Parsed) -> HsExpr (GhcPass 'Parsed))
-> (l (GhcPass 'Parsed) -> Bool)
-> CvtM (HsExpr (GhcPass 'Parsed))
go Lit -> CvtM (HsLit (GhcPass 'Parsed))
cvtLit (XLitE (GhcPass 'Parsed)
-> HsLit (GhcPass 'Parsed) -> HsExpr (GhcPass 'Parsed)
forall p. XLitE p -> HsLit p -> HsExpr p
HsLit XLitE (GhcPass 'Parsed)
EpAnnCO
noComments)
                             (PprPrec -> HsLit (GhcPass 'Parsed) -> Bool
forall x. PprPrec -> HsLit x -> Bool
hsLitNeedsParens PprPrec
appPrec)
      where
        go :: (Lit -> CvtM (l GhcPs))
           -> (l GhcPs -> HsExpr GhcPs)
           -> (l GhcPs -> Bool)
           -> CvtM (HsExpr GhcPs)
        go :: forall (l :: * -> *).
(Lit -> CvtM (l (GhcPass 'Parsed)))
-> (l (GhcPass 'Parsed) -> HsExpr (GhcPass 'Parsed))
-> (l (GhcPass 'Parsed) -> Bool)
-> CvtM (HsExpr (GhcPass 'Parsed))
go Lit -> CvtM (l (GhcPass 'Parsed))
cvt_lit l (GhcPass 'Parsed) -> HsExpr (GhcPass 'Parsed)
mk_expr l (GhcPass 'Parsed) -> Bool
is_compound_lit = do
          l (GhcPass 'Parsed)
l' <- Lit -> CvtM (l (GhcPass 'Parsed))
cvt_lit Lit
l
          let e' :: HsExpr (GhcPass 'Parsed)
e' = l (GhcPass 'Parsed) -> HsExpr (GhcPass 'Parsed)
mk_expr l (GhcPass 'Parsed)
l'
          if l (GhcPass 'Parsed) -> Bool
is_compound_lit l (GhcPass 'Parsed)
l' then (LocatedA (HsExpr (GhcPass 'Parsed)) -> HsExpr (GhcPass 'Parsed))
-> HsExpr (GhcPass 'Parsed) -> CvtM (HsExpr (GhcPass 'Parsed))
forall ann a b. (LocatedAn ann a -> b) -> a -> CvtM b
wrapParLA LHsExpr (GhcPass 'Parsed) -> HsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed)) -> HsExpr (GhcPass 'Parsed)
forall (id :: Pass). LHsExpr (GhcPass id) -> HsExpr (GhcPass id)
gHsPar HsExpr (GhcPass 'Parsed)
e' else HsExpr (GhcPass 'Parsed) -> CvtM (HsExpr (GhcPass 'Parsed))
forall a. a -> CvtM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HsExpr (GhcPass 'Parsed)
e'
    cvt (AppE x :: Exp
x@(LamE [Pat]
_ Exp
_) Exp
y) = do { LocatedA (HsExpr (GhcPass 'Parsed))
x' <- Exp -> CvtM (LHsExpr (GhcPass 'Parsed))
cvtl Exp
x; LocatedA (HsExpr (GhcPass 'Parsed))
y' <- Exp -> CvtM (LHsExpr (GhcPass 'Parsed))
cvtl Exp
y
                                   ; HsExpr (GhcPass 'Parsed) -> CvtM (HsExpr (GhcPass 'Parsed))
forall a. a -> CvtM a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsExpr (GhcPass 'Parsed) -> CvtM (HsExpr (GhcPass 'Parsed)))
-> HsExpr (GhcPass 'Parsed) -> CvtM (HsExpr (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ XApp (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> HsExpr (GhcPass 'Parsed)
forall p. XApp p -> LHsExpr p -> LHsExpr p -> HsExpr p
HsApp XApp (GhcPass 'Parsed)
EpAnnCO
noComments (LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (id :: Pass).
IsPass id =>
LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
mkLHsPar LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
x')
                                                          (LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (id :: Pass).
IsPass id =>
LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
mkLHsPar LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
y')}
    cvt (AppE Exp
x Exp
y)            = do { LocatedA (HsExpr (GhcPass 'Parsed))
x' <- Exp -> CvtM (LHsExpr (GhcPass 'Parsed))
cvtl Exp
x; LocatedA (HsExpr (GhcPass 'Parsed))
y' <- Exp -> CvtM (LHsExpr (GhcPass 'Parsed))
cvtl Exp
y
                                   ; HsExpr (GhcPass 'Parsed) -> CvtM (HsExpr (GhcPass 'Parsed))
forall a. a -> CvtM a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsExpr (GhcPass 'Parsed) -> CvtM (HsExpr (GhcPass 'Parsed)))
-> HsExpr (GhcPass 'Parsed) -> CvtM (HsExpr (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ XApp (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> HsExpr (GhcPass 'Parsed)
forall p. XApp p -> LHsExpr p -> LHsExpr p -> HsExpr p
HsApp XApp (GhcPass 'Parsed)
EpAnnCO
noComments (LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (id :: Pass).
IsPass id =>
LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
mkLHsPar LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
x')
                                                          (LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (id :: Pass).
IsPass id =>
LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
mkLHsPar LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
y')}
    cvt (AppTypeE Exp
e Type
t) = do { LocatedA (HsExpr (GhcPass 'Parsed))
e' <- Exp -> CvtM (LHsExpr (GhcPass 'Parsed))
cvtl Exp
e
                            ; GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
t' <- Type -> CvtM (LHsType (GhcPass 'Parsed))
cvtType Type
t
                            ; let tp :: LHsType (GhcPass 'Parsed)
tp = PprPrec -> LHsType (GhcPass 'Parsed) -> LHsType (GhcPass 'Parsed)
forall (p :: Pass).
PprPrec -> LHsType (GhcPass p) -> LHsType (GhcPass p)
parenthesizeHsType PprPrec
appPrec LHsType (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
t'
                            ; HsExpr (GhcPass 'Parsed) -> CvtM (HsExpr (GhcPass 'Parsed))
forall a. a -> CvtM a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsExpr (GhcPass 'Parsed) -> CvtM (HsExpr (GhcPass 'Parsed)))
-> HsExpr (GhcPass 'Parsed) -> CvtM (HsExpr (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ XAppTypeE (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> HsWildCardBndrs
     (NoGhcTc (GhcPass 'Parsed))
     (XRec
        (NoGhcTc (GhcPass 'Parsed)) (HsType (NoGhcTc (GhcPass 'Parsed))))
-> HsExpr (GhcPass 'Parsed)
forall p.
XAppTypeE p -> LHsExpr p -> LHsWcType (NoGhcTc p) -> HsExpr p
HsAppType XAppTypeE (GhcPass 'Parsed)
SrcSpan
noSrcSpan LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
e'
                                     (HsWildCardBndrs
   (NoGhcTc (GhcPass 'Parsed))
   (XRec
      (NoGhcTc (GhcPass 'Parsed)) (HsType (NoGhcTc (GhcPass 'Parsed))))
 -> HsExpr (GhcPass 'Parsed))
-> HsWildCardBndrs
     (NoGhcTc (GhcPass 'Parsed))
     (XRec
        (NoGhcTc (GhcPass 'Parsed)) (HsType (NoGhcTc (GhcPass 'Parsed))))
-> HsExpr (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
-> HsWildCardBndrs
     (GhcPass 'Parsed)
     (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
forall thing. thing -> HsWildCardBndrs (GhcPass 'Parsed) thing
mkHsWildCardBndrs LHsType (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
tp }
    cvt (LamE [] Exp
e)    = Exp -> CvtM (HsExpr (GhcPass 'Parsed))
cvt Exp
e -- Degenerate case. We convert the body as its
                               -- own expression to avoid pretty-printing
                               -- oddities that can result from zero-argument
                               -- lambda expressions. See #13856.
    cvt (LamE [Pat]
ps Exp
e)    = do { [GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))]
ps' <- [Pat] -> CvtM [LPat (GhcPass 'Parsed)]
cvtPats [Pat]
ps; LocatedA (HsExpr (GhcPass 'Parsed))
e' <- Exp -> CvtM (LHsExpr (GhcPass 'Parsed))
cvtl Exp
e
                            ; let pats :: [GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))]
pats = (GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
 -> GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed)))
-> [GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))]
-> [GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))]
forall a b. (a -> b) -> [a] -> [b]
map (PprPrec -> LPat (GhcPass 'Parsed) -> LPat (GhcPass 'Parsed)
forall (p :: Pass).
IsPass p =>
PprPrec -> LPat (GhcPass p) -> LPat (GhcPass p)
parenthesizePat PprPrec
appPrec) [GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))]
ps'
                            ; Origin
th_origin <- CvtM Origin
getOrigin
                            ; (LocatedAn
   AnnList
   [GenLocated
      SrcSpanAnnA
      (Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
 -> HsExpr (GhcPass 'Parsed))
-> [GenLocated
      SrcSpanAnnA
      (Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
-> CvtM (HsExpr (GhcPass 'Parsed))
forall ann a b. (LocatedAn ann a -> b) -> a -> CvtM b
wrapParLA (XLam (GhcPass 'Parsed)
-> MatchGroup (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
-> HsExpr (GhcPass 'Parsed)
forall p. XLam p -> MatchGroup p (LHsExpr p) -> HsExpr p
HsLam XLam (GhcPass 'Parsed)
NoExtField
noExtField (MatchGroup (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
 -> HsExpr (GhcPass 'Parsed))
-> (LocatedAn
      AnnList
      [GenLocated
         SrcSpanAnnA
         (Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
    -> MatchGroup
         (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))
-> LocatedAn
     AnnList
     [GenLocated
        SrcSpanAnnA
        (Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
-> HsExpr (GhcPass 'Parsed)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Origin
-> LocatedAn
     AnnList
     [GenLocated
        SrcSpanAnnA
        (Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
-> MatchGroup
     (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
forall (p :: Pass) (body :: * -> *).
AnnoBody p body =>
Origin
-> LocatedL
     [LocatedA (Match (GhcPass p) (LocatedA (body (GhcPass p))))]
-> MatchGroup (GhcPass p) (LocatedA (body (GhcPass p)))
mkMatchGroup Origin
th_origin)
                                        [HsMatchContext (GhcPass 'Parsed)
-> [LPat (GhcPass 'Parsed)]
-> LocatedA (HsExpr (GhcPass 'Parsed))
-> LMatch (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
forall (p :: Pass) (body :: * -> *).
(Anno (Match (GhcPass p) (LocatedA (body (GhcPass p))))
 ~ SrcSpanAnnA,
 Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p))))
 ~ SrcAnn NoEpAnns) =>
HsMatchContext (GhcPass p)
-> [LPat (GhcPass p)]
-> LocatedA (body (GhcPass p))
-> LMatch (GhcPass p) (LocatedA (body (GhcPass p)))
mkSimpleMatch HsMatchContext (GhcPass 'Parsed)
forall p. HsMatchContext p
LambdaExpr [LPat (GhcPass 'Parsed)]
[GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))]
pats LocatedA (HsExpr (GhcPass 'Parsed))
e']}
    cvt (LamCaseE [Match]
ms)  = do { [GenLocated
   SrcSpanAnnA
   (Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
ms' <- (Match
 -> CvtM
      (GenLocated
         SrcSpanAnnA
         (Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))))
-> [Match]
-> CvtM
     [GenLocated
        SrcSpanAnnA
        (Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (HsMatchContext (GhcPass 'Parsed)
-> Match
-> CvtM (LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)))
cvtMatch (HsMatchContext (GhcPass 'Parsed)
 -> Match
 -> CvtM (LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))))
-> HsMatchContext (GhcPass 'Parsed)
-> Match
-> CvtM (LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)))
forall a b. (a -> b) -> a -> b
$ LamCaseVariant -> HsMatchContext (GhcPass 'Parsed)
forall p. LamCaseVariant -> HsMatchContext p
LamCaseAlt LamCaseVariant
LamCase) [Match]
ms
                            ; Origin
th_origin <- CvtM Origin
getOrigin
                            ; (LocatedAn
   AnnList
   [GenLocated
      SrcSpanAnnA
      (Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
 -> HsExpr (GhcPass 'Parsed))
-> [GenLocated
      SrcSpanAnnA
      (Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
-> CvtM (HsExpr (GhcPass 'Parsed))
forall ann a b. (LocatedAn ann a -> b) -> a -> CvtM b
wrapParLA (XLamCase (GhcPass 'Parsed)
-> LamCaseVariant
-> MatchGroup (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
-> HsExpr (GhcPass 'Parsed)
forall p.
XLamCase p
-> LamCaseVariant -> MatchGroup p (LHsExpr p) -> HsExpr p
HsLamCase XLamCase (GhcPass 'Parsed)
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn LamCaseVariant
LamCase (MatchGroup (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
 -> HsExpr (GhcPass 'Parsed))
-> (LocatedAn
      AnnList
      [GenLocated
         SrcSpanAnnA
         (Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
    -> MatchGroup
         (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))
-> LocatedAn
     AnnList
     [GenLocated
        SrcSpanAnnA
        (Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
-> HsExpr (GhcPass 'Parsed)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Origin
-> LocatedAn
     AnnList
     [GenLocated
        SrcSpanAnnA
        (Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
-> MatchGroup
     (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
forall (p :: Pass) (body :: * -> *).
AnnoBody p body =>
Origin
-> LocatedL
     [LocatedA (Match (GhcPass p) (LocatedA (body (GhcPass p))))]
-> MatchGroup (GhcPass p) (LocatedA (body (GhcPass p)))
mkMatchGroup Origin
th_origin) [GenLocated
   SrcSpanAnnA
   (Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
ms'
                            }
    cvt (LamCasesE [Clause]
ms)
      | [Clause] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Clause]
ms   = SDoc -> CvtM (HsExpr (GhcPass 'Parsed))
forall a. SDoc -> CvtM a
failWith (String -> SDoc
text String
"\\cases expression with no alternatives")
      | Bool
otherwise = do { [GenLocated
   SrcSpanAnnA
   (Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
ms' <- (Clause
 -> CvtM
      (GenLocated
         SrcSpanAnnA
         (Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))))
-> [Clause]
-> CvtM
     [GenLocated
        SrcSpanAnnA
        (Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (HsMatchContext (GhcPass 'Parsed)
-> Clause
-> CvtM (LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)))
cvtClause (HsMatchContext (GhcPass 'Parsed)
 -> Clause
 -> CvtM (LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))))
-> HsMatchContext (GhcPass 'Parsed)
-> Clause
-> CvtM (LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)))
forall a b. (a -> b) -> a -> b
$ LamCaseVariant -> HsMatchContext (GhcPass 'Parsed)
forall p. LamCaseVariant -> HsMatchContext p
LamCaseAlt LamCaseVariant
LamCases) [Clause]
ms
                       ; Origin
th_origin <- CvtM Origin
getOrigin
                       ; (LocatedAn
   AnnList
   [GenLocated
      SrcSpanAnnA
      (Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
 -> HsExpr (GhcPass 'Parsed))
-> [GenLocated
      SrcSpanAnnA
      (Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
-> CvtM (HsExpr (GhcPass 'Parsed))
forall ann a b. (LocatedAn ann a -> b) -> a -> CvtM b
wrapParLA (XLamCase (GhcPass 'Parsed)
-> LamCaseVariant
-> MatchGroup (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
-> HsExpr (GhcPass 'Parsed)
forall p.
XLamCase p
-> LamCaseVariant -> MatchGroup p (LHsExpr p) -> HsExpr p
HsLamCase XLamCase (GhcPass 'Parsed)
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn LamCaseVariant
LamCases (MatchGroup (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
 -> HsExpr (GhcPass 'Parsed))
-> (LocatedAn
      AnnList
      [GenLocated
         SrcSpanAnnA
         (Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
    -> MatchGroup
         (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))
-> LocatedAn
     AnnList
     [GenLocated
        SrcSpanAnnA
        (Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
-> HsExpr (GhcPass 'Parsed)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Origin
-> LocatedAn
     AnnList
     [GenLocated
        SrcSpanAnnA
        (Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
-> MatchGroup
     (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
forall (p :: Pass) (body :: * -> *).
AnnoBody p body =>
Origin
-> LocatedL
     [LocatedA (Match (GhcPass p) (LocatedA (body (GhcPass p))))]
-> MatchGroup (GhcPass p) (LocatedA (body (GhcPass p)))
mkMatchGroup Origin
th_origin) [GenLocated
   SrcSpanAnnA
   (Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
ms'
                       }
    cvt (TupE [Maybe Exp]
es)        = [Maybe Exp] -> Boxity -> CvtM (HsExpr (GhcPass 'Parsed))
cvt_tup [Maybe Exp]
es Boxity
Boxed
    cvt (UnboxedTupE [Maybe Exp]
es) = [Maybe Exp] -> Boxity -> CvtM (HsExpr (GhcPass 'Parsed))
cvt_tup [Maybe Exp]
es Boxity
Unboxed
    cvt (UnboxedSumE Exp
e Int
alt Int
arity) = do { LocatedA (HsExpr (GhcPass 'Parsed))
e' <- Exp -> CvtM (LHsExpr (GhcPass 'Parsed))
cvtl Exp
e
                                       ; Int -> Int -> CvtM ()
unboxedSumChecks Int
alt Int
arity
                                       ; HsExpr (GhcPass 'Parsed) -> CvtM (HsExpr (GhcPass 'Parsed))
forall a. a -> CvtM a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsExpr (GhcPass 'Parsed) -> CvtM (HsExpr (GhcPass 'Parsed)))
-> HsExpr (GhcPass 'Parsed) -> CvtM (HsExpr (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ XExplicitSum (GhcPass 'Parsed)
-> Int
-> Int
-> LHsExpr (GhcPass 'Parsed)
-> HsExpr (GhcPass 'Parsed)
forall p. XExplicitSum p -> Int -> Int -> LHsExpr p -> HsExpr p
ExplicitSum XExplicitSum (GhcPass 'Parsed)
EpAnn AnnExplicitSum
forall a. EpAnn a
noAnn Int
alt Int
arity LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
e'}
    cvt (CondE Exp
x Exp
y Exp
z)  = do { LocatedA (HsExpr (GhcPass 'Parsed))
x' <- Exp -> CvtM (LHsExpr (GhcPass 'Parsed))
cvtl Exp
x; LocatedA (HsExpr (GhcPass 'Parsed))
y' <- Exp -> CvtM (LHsExpr (GhcPass 'Parsed))
cvtl Exp
y; LocatedA (HsExpr (GhcPass 'Parsed))
z' <- Exp -> CvtM (LHsExpr (GhcPass 'Parsed))
cvtl Exp
z;
                            ; HsExpr (GhcPass 'Parsed) -> CvtM (HsExpr (GhcPass 'Parsed))
forall a. a -> CvtM a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsExpr (GhcPass 'Parsed) -> CvtM (HsExpr (GhcPass 'Parsed)))
-> HsExpr (GhcPass 'Parsed) -> CvtM (HsExpr (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> EpAnn AnnsIf
-> HsExpr (GhcPass 'Parsed)
mkHsIf LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
x' LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
y' LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
z' EpAnn AnnsIf
forall a. EpAnn a
noAnn }
    cvt (MultiIfE [(Guard, Exp)]
alts)
      | [(Guard, Exp)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Guard, Exp)]
alts      = SDoc -> CvtM (HsExpr (GhcPass 'Parsed))
forall a. SDoc -> CvtM a
failWith (String -> SDoc
text String
"Multi-way if-expression with no alternatives")
      | Bool
otherwise      = do { [GenLocated
   (SrcAnn NoEpAnns)
   (GRHS (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
alts' <- ((Guard, Exp)
 -> CvtM
      (GenLocated
         (SrcAnn NoEpAnns)
         (GRHS (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))))
-> [(Guard, Exp)]
-> CvtM
     [GenLocated
        (SrcAnn NoEpAnns)
        (GRHS (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Guard, Exp)
-> CvtM (LGRHS (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)))
(Guard, Exp)
-> CvtM
     (GenLocated
        (SrcAnn NoEpAnns)
        (GRHS (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))))
cvtpair [(Guard, Exp)]
alts
                            ; HsExpr (GhcPass 'Parsed) -> CvtM (HsExpr (GhcPass 'Parsed))
forall a. a -> CvtM a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsExpr (GhcPass 'Parsed) -> CvtM (HsExpr (GhcPass 'Parsed)))
-> HsExpr (GhcPass 'Parsed) -> CvtM (HsExpr (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ XMultiIf (GhcPass 'Parsed)
-> [LGRHS (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
-> HsExpr (GhcPass 'Parsed)
forall p. XMultiIf p -> [LGRHS p (LHsExpr p)] -> HsExpr p
HsMultiIf XMultiIf (GhcPass 'Parsed)
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn [LGRHS (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
[GenLocated
   (SrcAnn NoEpAnns)
   (GRHS (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
alts' }
    cvt (LetE [Dec]
ds Exp
e)    = do { HsLocalBinds (GhcPass 'Parsed)
ds' <- SDoc -> [Dec] -> CvtM (HsLocalBinds (GhcPass 'Parsed))
cvtLocalDecs (String -> SDoc
text String
"a let expression") [Dec]
ds
                            ; LocatedA (HsExpr (GhcPass 'Parsed))
e' <- Exp -> CvtM (LHsExpr (GhcPass 'Parsed))
cvtl Exp
e; HsExpr (GhcPass 'Parsed) -> CvtM (HsExpr (GhcPass 'Parsed))
forall a. a -> CvtM a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsExpr (GhcPass 'Parsed) -> CvtM (HsExpr (GhcPass 'Parsed)))
-> HsExpr (GhcPass 'Parsed) -> CvtM (HsExpr (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ XLet (GhcPass 'Parsed)
-> LHsToken "let" (GhcPass 'Parsed)
-> HsLocalBinds (GhcPass 'Parsed)
-> LHsToken "in" (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> HsExpr (GhcPass 'Parsed)
forall p.
XLet p
-> LHsToken "let" p
-> HsLocalBinds p
-> LHsToken "in" p
-> LHsExpr p
-> HsExpr p
HsLet XLet (GhcPass 'Parsed)
EpAnnCO
forall a. EpAnn a
noAnn LHsToken "let" (GhcPass 'Parsed)
GenLocated TokenLocation (HsToken "let")
forall (tok :: Symbol). GenLocated TokenLocation (HsToken tok)
noHsTok HsLocalBinds (GhcPass 'Parsed)
ds' LHsToken "in" (GhcPass 'Parsed)
GenLocated TokenLocation (HsToken "in")
forall (tok :: Symbol). GenLocated TokenLocation (HsToken tok)
noHsTok LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
e'}
    cvt (CaseE Exp
e [Match]
ms)   = do { LocatedA (HsExpr (GhcPass 'Parsed))
e' <- Exp -> CvtM (LHsExpr (GhcPass 'Parsed))
cvtl Exp
e; [GenLocated
   SrcSpanAnnA
   (Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
ms' <- (Match
 -> CvtM
      (GenLocated
         SrcSpanAnnA
         (Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))))
-> [Match]
-> CvtM
     [GenLocated
        SrcSpanAnnA
        (Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (HsMatchContext (GhcPass 'Parsed)
-> Match
-> CvtM (LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)))
cvtMatch HsMatchContext (GhcPass 'Parsed)
forall p. HsMatchContext p
CaseAlt) [Match]
ms
                            ; Origin
th_origin <- CvtM Origin
getOrigin
                            ; (LocatedAn
   AnnList
   [GenLocated
      SrcSpanAnnA
      (Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
 -> HsExpr (GhcPass 'Parsed))
-> [GenLocated
      SrcSpanAnnA
      (Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
-> CvtM (HsExpr (GhcPass 'Parsed))
forall ann a b. (LocatedAn ann a -> b) -> a -> CvtM b
wrapParLA (XCase (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> MatchGroup (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
-> HsExpr (GhcPass 'Parsed)
forall p.
XCase p -> LHsExpr p -> MatchGroup p (LHsExpr p) -> HsExpr p
HsCase XCase (GhcPass 'Parsed)
EpAnn EpAnnHsCase
forall a. EpAnn a
noAnn LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
e' (MatchGroup (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
 -> HsExpr (GhcPass 'Parsed))
-> (LocatedAn
      AnnList
      [GenLocated
         SrcSpanAnnA
         (Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
    -> MatchGroup
         (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))
-> LocatedAn
     AnnList
     [GenLocated
        SrcSpanAnnA
        (Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
-> HsExpr (GhcPass 'Parsed)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Origin
-> LocatedAn
     AnnList
     [GenLocated
        SrcSpanAnnA
        (Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
-> MatchGroup
     (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
forall (p :: Pass) (body :: * -> *).
AnnoBody p body =>
Origin
-> LocatedL
     [LocatedA (Match (GhcPass p) (LocatedA (body (GhcPass p))))]
-> MatchGroup (GhcPass p) (LocatedA (body (GhcPass p)))
mkMatchGroup Origin
th_origin) [GenLocated
   SrcSpanAnnA
   (Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
ms' }
    cvt (DoE Maybe ModName
m [Stmt]
ss)     = HsDoFlavour -> [Stmt] -> CvtM (HsExpr (GhcPass 'Parsed))
cvtHsDo (Maybe ModuleName -> HsDoFlavour
DoExpr (ModName -> ModuleName
mk_mod (ModName -> ModuleName) -> Maybe ModName -> Maybe ModuleName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ModName
m)) [Stmt]
ss
    cvt (MDoE Maybe ModName
m [Stmt]
ss)    = HsDoFlavour -> [Stmt] -> CvtM (HsExpr (GhcPass 'Parsed))
cvtHsDo (Maybe ModuleName -> HsDoFlavour
MDoExpr (ModName -> ModuleName
mk_mod (ModName -> ModuleName) -> Maybe ModName -> Maybe ModuleName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ModName
m)) [Stmt]
ss
    cvt (CompE [Stmt]
ss)     = HsDoFlavour -> [Stmt] -> CvtM (HsExpr (GhcPass 'Parsed))
cvtHsDo HsDoFlavour
ListComp [Stmt]
ss
    cvt (ArithSeqE Range
dd) = do { ArithSeqInfo (GhcPass 'Parsed)
dd' <- Range -> CvtM (ArithSeqInfo (GhcPass 'Parsed))
cvtDD Range
dd
                            ; HsExpr (GhcPass 'Parsed) -> CvtM (HsExpr (GhcPass 'Parsed))
forall a. a -> CvtM a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsExpr (GhcPass 'Parsed) -> CvtM (HsExpr (GhcPass 'Parsed)))
-> HsExpr (GhcPass 'Parsed) -> CvtM (HsExpr (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ XArithSeq (GhcPass 'Parsed)
-> Maybe (SyntaxExpr (GhcPass 'Parsed))
-> ArithSeqInfo (GhcPass 'Parsed)
-> HsExpr (GhcPass 'Parsed)
forall p.
XArithSeq p -> Maybe (SyntaxExpr p) -> ArithSeqInfo p -> HsExpr p
ArithSeq XArithSeq (GhcPass 'Parsed)
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn Maybe NoExtField
Maybe (SyntaxExpr (GhcPass 'Parsed))
forall a. Maybe a
Nothing ArithSeqInfo (GhcPass 'Parsed)
dd' }
    cvt (ListE [Exp]
xs)
      | Just String
s <- [Exp] -> Maybe String
allCharLs [Exp]
xs       = do { HsLit (GhcPass 'Parsed)
l' <- Lit -> CvtM (HsLit (GhcPass 'Parsed))
cvtLit (String -> Lit
StringL String
s)
                                          ; HsExpr (GhcPass 'Parsed) -> CvtM (HsExpr (GhcPass 'Parsed))
forall a. a -> CvtM a
forall (m :: * -> *) a. Monad m => a -> m a
return (XLitE (GhcPass 'Parsed)
-> HsLit (GhcPass 'Parsed) -> HsExpr (GhcPass 'Parsed)
forall p. XLitE p -> HsLit p -> HsExpr p
HsLit XLitE (GhcPass 'Parsed)
EpAnnCO
noComments HsLit (GhcPass 'Parsed)
l') }
             -- Note [Converting strings]
      | Bool
otherwise       = do { [LocatedA (HsExpr (GhcPass 'Parsed))]
xs' <- (Exp -> CvtM (LocatedA (HsExpr (GhcPass 'Parsed))))
-> [Exp] -> CvtM [LocatedA (HsExpr (GhcPass 'Parsed))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Exp -> CvtM (LHsExpr (GhcPass 'Parsed))
Exp -> CvtM (LocatedA (HsExpr (GhcPass 'Parsed)))
cvtl [Exp]
xs
                             ; HsExpr (GhcPass 'Parsed) -> CvtM (HsExpr (GhcPass 'Parsed))
forall a. a -> CvtM a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsExpr (GhcPass 'Parsed) -> CvtM (HsExpr (GhcPass 'Parsed)))
-> HsExpr (GhcPass 'Parsed) -> CvtM (HsExpr (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ XExplicitList (GhcPass 'Parsed)
-> [LHsExpr (GhcPass 'Parsed)] -> HsExpr (GhcPass 'Parsed)
forall p. XExplicitList p -> [LHsExpr p] -> HsExpr p
ExplicitList XExplicitList (GhcPass 'Parsed)
EpAnn AnnList
forall a. EpAnn a
noAnn [LHsExpr (GhcPass 'Parsed)]
[LocatedA (HsExpr (GhcPass 'Parsed))]
xs'
                             }

    -- Infix expressions
    cvt (InfixE (Just Exp
x) Exp
s (Just Exp
y)) = Exp
-> CvtM (HsExpr (GhcPass 'Parsed))
-> CvtM (HsExpr (GhcPass 'Parsed))
forall a. Exp -> CvtM a -> CvtM a
ensureValidOpExp Exp
s (CvtM (HsExpr (GhcPass 'Parsed))
 -> CvtM (HsExpr (GhcPass 'Parsed)))
-> CvtM (HsExpr (GhcPass 'Parsed))
-> CvtM (HsExpr (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$
      do { LocatedA (HsExpr (GhcPass 'Parsed))
x' <- Exp -> CvtM (LHsExpr (GhcPass 'Parsed))
cvtl Exp
x
         ; LocatedA (HsExpr (GhcPass 'Parsed))
s' <- Exp -> CvtM (LHsExpr (GhcPass 'Parsed))
cvtl Exp
s
         ; LocatedA (HsExpr (GhcPass 'Parsed))
y' <- Exp -> CvtM (LHsExpr (GhcPass 'Parsed))
cvtl Exp
y
         ; let px :: LHsExpr (GhcPass 'Parsed)
px = PprPrec -> LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass).
IsPass p =>
PprPrec -> LHsExpr (GhcPass p) -> LHsExpr (GhcPass p)
parenthesizeHsExpr PprPrec
opPrec LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
x'
               py :: LHsExpr (GhcPass 'Parsed)
py = PprPrec -> LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass).
IsPass p =>
PprPrec -> LHsExpr (GhcPass p) -> LHsExpr (GhcPass p)
parenthesizeHsExpr PprPrec
opPrec LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
y'
         ; (LocatedA (HsExpr (GhcPass 'Parsed)) -> HsExpr (GhcPass 'Parsed))
-> HsExpr (GhcPass 'Parsed) -> CvtM (HsExpr (GhcPass 'Parsed))
forall ann a b. (LocatedAn ann a -> b) -> a -> CvtM b
wrapParLA LHsExpr (GhcPass 'Parsed) -> HsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed)) -> HsExpr (GhcPass 'Parsed)
forall (id :: Pass). LHsExpr (GhcPass id) -> HsExpr (GhcPass id)
gHsPar
           (HsExpr (GhcPass 'Parsed) -> CvtM (HsExpr (GhcPass 'Parsed)))
-> HsExpr (GhcPass 'Parsed) -> CvtM (HsExpr (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ XOpApp (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> HsExpr (GhcPass 'Parsed)
forall p.
XOpApp p -> LHsExpr p -> LHsExpr p -> LHsExpr p -> HsExpr p
OpApp XOpApp (GhcPass 'Parsed)
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn LHsExpr (GhcPass 'Parsed)
px LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
s' LHsExpr (GhcPass 'Parsed)
py }
           -- Parenthesise both arguments and result,
           -- to ensure this operator application does
           -- does not get re-associated
           -- See Note [Operator association]
    cvt (InfixE Maybe Exp
Nothing  Exp
s (Just Exp
y)) = Exp
-> CvtM (HsExpr (GhcPass 'Parsed))
-> CvtM (HsExpr (GhcPass 'Parsed))
forall a. Exp -> CvtM a -> CvtM a
ensureValidOpExp Exp
s (CvtM (HsExpr (GhcPass 'Parsed))
 -> CvtM (HsExpr (GhcPass 'Parsed)))
-> CvtM (HsExpr (GhcPass 'Parsed))
-> CvtM (HsExpr (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$
                                       do { LocatedA (HsExpr (GhcPass 'Parsed))
s' <- Exp -> CvtM (LHsExpr (GhcPass 'Parsed))
cvtl Exp
s; LocatedA (HsExpr (GhcPass 'Parsed))
y' <- Exp -> CvtM (LHsExpr (GhcPass 'Parsed))
cvtl Exp
y
                                          ; (LocatedA (HsExpr (GhcPass 'Parsed)) -> HsExpr (GhcPass 'Parsed))
-> HsExpr (GhcPass 'Parsed) -> CvtM (HsExpr (GhcPass 'Parsed))
forall ann a b. (LocatedAn ann a -> b) -> a -> CvtM b
wrapParLA LHsExpr (GhcPass 'Parsed) -> HsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed)) -> HsExpr (GhcPass 'Parsed)
forall (id :: Pass). LHsExpr (GhcPass id) -> HsExpr (GhcPass id)
gHsPar (HsExpr (GhcPass 'Parsed) -> CvtM (HsExpr (GhcPass 'Parsed)))
-> HsExpr (GhcPass 'Parsed) -> CvtM (HsExpr (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$
                                                          XSectionR (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> HsExpr (GhcPass 'Parsed)
forall p. XSectionR p -> LHsExpr p -> LHsExpr p -> HsExpr p
SectionR XSectionR (GhcPass 'Parsed)
EpAnnCO
noComments LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
s' LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
y' }
                                            -- See Note [Sections in HsSyn] in GHC.Hs.Expr
    cvt (InfixE (Just Exp
x) Exp
s Maybe Exp
Nothing ) = Exp
-> CvtM (HsExpr (GhcPass 'Parsed))
-> CvtM (HsExpr (GhcPass 'Parsed))
forall a. Exp -> CvtM a -> CvtM a
ensureValidOpExp Exp
s (CvtM (HsExpr (GhcPass 'Parsed))
 -> CvtM (HsExpr (GhcPass 'Parsed)))
-> CvtM (HsExpr (GhcPass 'Parsed))
-> CvtM (HsExpr (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$
                                       do { LocatedA (HsExpr (GhcPass 'Parsed))
x' <- Exp -> CvtM (LHsExpr (GhcPass 'Parsed))
cvtl Exp
x; LocatedA (HsExpr (GhcPass 'Parsed))
s' <- Exp -> CvtM (LHsExpr (GhcPass 'Parsed))
cvtl Exp
s
                                          ; (LocatedA (HsExpr (GhcPass 'Parsed)) -> HsExpr (GhcPass 'Parsed))
-> HsExpr (GhcPass 'Parsed) -> CvtM (HsExpr (GhcPass 'Parsed))
forall ann a b. (LocatedAn ann a -> b) -> a -> CvtM b
wrapParLA LHsExpr (GhcPass 'Parsed) -> HsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed)) -> HsExpr (GhcPass 'Parsed)
forall (id :: Pass). LHsExpr (GhcPass id) -> HsExpr (GhcPass id)
gHsPar (HsExpr (GhcPass 'Parsed) -> CvtM (HsExpr (GhcPass 'Parsed)))
-> HsExpr (GhcPass 'Parsed) -> CvtM (HsExpr (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$
                                                          XSectionL (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> HsExpr (GhcPass 'Parsed)
forall p. XSectionL p -> LHsExpr p -> LHsExpr p -> HsExpr p
SectionL XSectionL (GhcPass 'Parsed)
EpAnnCO
noComments LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
x' LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
s' }

    cvt (InfixE Maybe Exp
Nothing  Exp
s Maybe Exp
Nothing ) = Exp
-> CvtM (HsExpr (GhcPass 'Parsed))
-> CvtM (HsExpr (GhcPass 'Parsed))
forall a. Exp -> CvtM a -> CvtM a
ensureValidOpExp Exp
s (CvtM (HsExpr (GhcPass 'Parsed))
 -> CvtM (HsExpr (GhcPass 'Parsed)))
-> CvtM (HsExpr (GhcPass 'Parsed))
-> CvtM (HsExpr (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$
                                       do { LocatedA (HsExpr (GhcPass 'Parsed))
s' <- Exp -> CvtM (LHsExpr (GhcPass 'Parsed))
cvtl Exp
s
                                          ; HsExpr (GhcPass 'Parsed) -> CvtM (HsExpr (GhcPass 'Parsed))
forall a. a -> CvtM a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsExpr (GhcPass 'Parsed) -> CvtM (HsExpr (GhcPass 'Parsed)))
-> HsExpr (GhcPass 'Parsed) -> CvtM (HsExpr (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ LHsExpr (GhcPass 'Parsed) -> HsExpr (GhcPass 'Parsed)
forall (id :: Pass). LHsExpr (GhcPass id) -> HsExpr (GhcPass id)
gHsPar LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
s' }
                                       -- Can I indicate this is an infix thing?
                                       -- Note [Dropping constructors]

    cvt (UInfixE Exp
x Exp
s Exp
y)  = Exp
-> CvtM (HsExpr (GhcPass 'Parsed))
-> CvtM (HsExpr (GhcPass 'Parsed))
forall a. Exp -> CvtM a -> CvtM a
ensureValidOpExp Exp
s (CvtM (HsExpr (GhcPass 'Parsed))
 -> CvtM (HsExpr (GhcPass 'Parsed)))
-> CvtM (HsExpr (GhcPass 'Parsed))
-> CvtM (HsExpr (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$
                           do { LocatedA (HsExpr (GhcPass 'Parsed))
x' <- Exp -> CvtM (LHsExpr (GhcPass 'Parsed))
cvtl Exp
x
                              ; let x'' :: LocatedA (HsExpr (GhcPass 'Parsed))
x'' = case LocatedA (HsExpr (GhcPass 'Parsed)) -> HsExpr (GhcPass 'Parsed)
forall l e. GenLocated l e -> e
unLoc LocatedA (HsExpr (GhcPass 'Parsed))
x' of
                                            OpApp {} -> LocatedA (HsExpr (GhcPass 'Parsed))
x'
                                            HsExpr (GhcPass 'Parsed)
_ -> LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (id :: Pass).
IsPass id =>
LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
mkLHsPar LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
x'
                              ; LHsExpr (GhcPass 'Parsed)
-> Exp -> Exp -> CvtM (HsExpr (GhcPass 'Parsed))
cvtOpApp LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
x'' Exp
s Exp
y } --  Note [Converting UInfix]

    cvt (ParensE Exp
e)      = do { LocatedA (HsExpr (GhcPass 'Parsed))
e' <- Exp -> CvtM (LHsExpr (GhcPass 'Parsed))
cvtl Exp
e; HsExpr (GhcPass 'Parsed) -> CvtM (HsExpr (GhcPass 'Parsed))
forall a. a -> CvtM a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsExpr (GhcPass 'Parsed) -> CvtM (HsExpr (GhcPass 'Parsed)))
-> HsExpr (GhcPass 'Parsed) -> CvtM (HsExpr (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ LHsExpr (GhcPass 'Parsed) -> HsExpr (GhcPass 'Parsed)
forall (id :: Pass). LHsExpr (GhcPass id) -> HsExpr (GhcPass id)
gHsPar LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
e' }
    cvt (SigE Exp
e Type
t)       = do { LocatedA (HsExpr (GhcPass 'Parsed))
e' <- Exp -> CvtM (LHsExpr (GhcPass 'Parsed))
cvtl Exp
e; GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Parsed))
t' <- Type -> CvtM (LHsSigType (GhcPass 'Parsed))
cvtSigType Type
t
                              ; let pe :: LHsExpr (GhcPass 'Parsed)
pe = PprPrec -> LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall (p :: Pass).
IsPass p =>
PprPrec -> LHsExpr (GhcPass p) -> LHsExpr (GhcPass p)
parenthesizeHsExpr PprPrec
sigPrec LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
e'
                              ; HsExpr (GhcPass 'Parsed) -> CvtM (HsExpr (GhcPass 'Parsed))
forall a. a -> CvtM a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsExpr (GhcPass 'Parsed) -> CvtM (HsExpr (GhcPass 'Parsed)))
-> HsExpr (GhcPass 'Parsed) -> CvtM (HsExpr (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ XExprWithTySig (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> LHsSigWcType (NoGhcTc (GhcPass 'Parsed))
-> HsExpr (GhcPass 'Parsed)
forall p.
XExprWithTySig p
-> LHsExpr p -> LHsSigWcType (NoGhcTc p) -> HsExpr p
ExprWithTySig XExprWithTySig (GhcPass 'Parsed)
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn LHsExpr (GhcPass 'Parsed)
pe (GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Parsed))
-> HsWildCardBndrs
     (GhcPass 'Parsed)
     (GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Parsed)))
forall thing. thing -> HsWildCardBndrs (GhcPass 'Parsed) thing
mkHsWildCardBndrs GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Parsed))
t') }
    cvt (RecConE Name
c [FieldExp]
flds) = do { GenLocated SrcSpanAnnN RdrName
c' <- Name -> CvtM (GenLocated SrcSpanAnnN RdrName)
cNameN Name
c
                              ; [GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass 'Parsed)))
      (LocatedA (HsExpr (GhcPass 'Parsed))))]
flds' <- (FieldExp
 -> CvtM
      (GenLocated
         SrcSpanAnnA
         (HsFieldBind
            (GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass 'Parsed)))
            (LocatedA (HsExpr (GhcPass 'Parsed))))))
-> [FieldExp]
-> CvtM
     [GenLocated
        SrcSpanAnnA
        (HsFieldBind
           (GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass 'Parsed)))
           (LocatedA (HsExpr (GhcPass 'Parsed))))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((RdrName -> CvtM (FieldOcc (GhcPass 'Parsed)))
-> FieldExp
-> CvtM
     (LHsFieldBind
        (GhcPass 'Parsed)
        (GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass 'Parsed)))
        (LHsExpr (GhcPass 'Parsed)))
forall t.
(RdrName -> CvtM t)
-> FieldExp
-> CvtM
     (LHsFieldBind
        (GhcPass 'Parsed)
        (LocatedAn NoEpAnns t)
        (LHsExpr (GhcPass 'Parsed)))
cvtFld ((GenLocated SrcSpanAnnN RdrName -> FieldOcc (GhcPass 'Parsed))
-> RdrName -> CvtM (FieldOcc (GhcPass 'Parsed))
forall ann a b. (LocatedAn ann a -> b) -> a -> CvtM b
wrapParLA GenLocated SrcSpanAnnN RdrName -> FieldOcc (GhcPass 'Parsed)
mkFieldOcc)) [FieldExp]
flds
                              ; HsExpr (GhcPass 'Parsed) -> CvtM (HsExpr (GhcPass 'Parsed))
forall a. a -> CvtM a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsExpr (GhcPass 'Parsed) -> CvtM (HsExpr (GhcPass 'Parsed)))
-> HsExpr (GhcPass 'Parsed) -> CvtM (HsExpr (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnN RdrName
-> HsRecordBinds (GhcPass 'Parsed)
-> EpAnn [AddEpAnn]
-> HsExpr (GhcPass 'Parsed)
mkRdrRecordCon GenLocated SrcSpanAnnN RdrName
c' ([LHsRecField
   (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))]
-> Maybe (Located Int)
-> HsRecFields
     (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
forall p arg.
[LHsRecField p arg] -> Maybe (Located Int) -> HsRecFields p arg
HsRecFields [LHsRecField
   (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))]
[GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass 'Parsed)))
      (LocatedA (HsExpr (GhcPass 'Parsed))))]
flds' Maybe (Located Int)
forall a. Maybe a
Nothing) EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn }
    cvt (RecUpdE Exp
e [FieldExp]
flds) = do { LocatedA (HsExpr (GhcPass 'Parsed))
e' <- Exp -> CvtM (LHsExpr (GhcPass 'Parsed))
cvtl Exp
e
                              ; [GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (LocatedAn NoEpAnns (AmbiguousFieldOcc (GhcPass 'Parsed)))
      (LocatedA (HsExpr (GhcPass 'Parsed))))]
flds'
                                  <- (FieldExp
 -> CvtM
      (GenLocated
         SrcSpanAnnA
         (HsFieldBind
            (LocatedAn NoEpAnns (AmbiguousFieldOcc (GhcPass 'Parsed)))
            (LocatedA (HsExpr (GhcPass 'Parsed))))))
-> [FieldExp]
-> CvtM
     [GenLocated
        SrcSpanAnnA
        (HsFieldBind
           (LocatedAn NoEpAnns (AmbiguousFieldOcc (GhcPass 'Parsed)))
           (LocatedA (HsExpr (GhcPass 'Parsed))))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((RdrName -> CvtM (AmbiguousFieldOcc (GhcPass 'Parsed)))
-> FieldExp
-> CvtM
     (LHsFieldBind
        (GhcPass 'Parsed)
        (LocatedAn NoEpAnns (AmbiguousFieldOcc (GhcPass 'Parsed)))
        (LHsExpr (GhcPass 'Parsed)))
forall t.
(RdrName -> CvtM t)
-> FieldExp
-> CvtM
     (LHsFieldBind
        (GhcPass 'Parsed)
        (LocatedAn NoEpAnns t)
        (LHsExpr (GhcPass 'Parsed)))
cvtFld ((GenLocated SrcSpanAnnN RdrName
 -> AmbiguousFieldOcc (GhcPass 'Parsed))
-> RdrName -> CvtM (AmbiguousFieldOcc (GhcPass 'Parsed))
forall ann a b. (LocatedAn ann a -> b) -> a -> CvtM b
wrapParLA GenLocated SrcSpanAnnN RdrName
-> AmbiguousFieldOcc (GhcPass 'Parsed)
mkAmbiguousFieldOcc))
                                           [FieldExp]
flds
                              ; HsExpr (GhcPass 'Parsed) -> CvtM (HsExpr (GhcPass 'Parsed))
forall a. a -> CvtM a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsExpr (GhcPass 'Parsed) -> CvtM (HsExpr (GhcPass 'Parsed)))
-> HsExpr (GhcPass 'Parsed) -> CvtM (HsExpr (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ XRecordUpd (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> Either
     [LHsRecUpdField (GhcPass 'Parsed)]
     [LHsRecUpdProj (GhcPass 'Parsed)]
-> HsExpr (GhcPass 'Parsed)
forall p.
XRecordUpd p
-> LHsExpr p
-> Either [LHsRecUpdField p] [LHsRecUpdProj p]
-> HsExpr p
RecordUpd XRecordUpd (GhcPass 'Parsed)
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
e' ([GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (LocatedAn NoEpAnns (AmbiguousFieldOcc (GhcPass 'Parsed)))
      (LocatedA (HsExpr (GhcPass 'Parsed))))]
-> Either
     [GenLocated
        SrcSpanAnnA
        (HsFieldBind
           (LocatedAn NoEpAnns (AmbiguousFieldOcc (GhcPass 'Parsed)))
           (LocatedA (HsExpr (GhcPass 'Parsed))))]
     [GenLocated
        SrcSpanAnnA
        (HsFieldBind
           (GenLocated
              (SrcAnn NoEpAnns) (FieldLabelStrings (GhcPass 'Parsed)))
           (LocatedA (HsExpr (GhcPass 'Parsed))))]
forall a b. a -> Either a b
Left [GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (LocatedAn NoEpAnns (AmbiguousFieldOcc (GhcPass 'Parsed)))
      (LocatedA (HsExpr (GhcPass 'Parsed))))]
flds') }
    cvt (StaticE Exp
e)      = (LHsExpr (GhcPass 'Parsed) -> HsExpr (GhcPass 'Parsed))
-> CvtM (LHsExpr (GhcPass 'Parsed))
-> CvtM (HsExpr (GhcPass 'Parsed))
forall a b. (a -> b) -> CvtM a -> CvtM b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (XStatic (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed) -> HsExpr (GhcPass 'Parsed)
forall p. XStatic p -> LHsExpr p -> HsExpr p
HsStatic XStatic (GhcPass 'Parsed)
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn) (CvtM (LHsExpr (GhcPass 'Parsed))
 -> CvtM (HsExpr (GhcPass 'Parsed)))
-> CvtM (LHsExpr (GhcPass 'Parsed))
-> CvtM (HsExpr (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ Exp -> CvtM (LHsExpr (GhcPass 'Parsed))
cvtl Exp
e
    cvt (UnboundVarE Name
s)  = do -- Use of 'vcName' here instead of 'vName' is
                              -- important, because UnboundVarE may contain
                              -- constructor names - see #14627.
                              { RdrName
s' <- Name -> CvtM RdrName
vcName Name
s
                              ; (GenLocated SrcSpanAnnN RdrName -> HsExpr (GhcPass 'Parsed))
-> RdrName -> CvtM (HsExpr (GhcPass 'Parsed))
forall ann a b. (LocatedAn ann a -> b) -> a -> CvtM b
wrapParLA (XVar (GhcPass 'Parsed)
-> LIdP (GhcPass 'Parsed) -> HsExpr (GhcPass 'Parsed)
forall p. XVar p -> LIdP p -> HsExpr p
HsVar XVar (GhcPass 'Parsed)
NoExtField
noExtField) RdrName
s' }
    cvt (LabelE String
s)       = HsExpr (GhcPass 'Parsed) -> CvtM (HsExpr (GhcPass 'Parsed))
forall a. a -> CvtM a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsExpr (GhcPass 'Parsed) -> CvtM (HsExpr (GhcPass 'Parsed)))
-> HsExpr (GhcPass 'Parsed) -> CvtM (HsExpr (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ XOverLabel (GhcPass 'Parsed)
-> CLabelString -> HsExpr (GhcPass 'Parsed)
forall p. XOverLabel p -> CLabelString -> HsExpr p
HsOverLabel XOverLabel (GhcPass 'Parsed)
EpAnnCO
noComments (String -> CLabelString
fsLit String
s)
    cvt (ImplicitParamVarE String
n) = do { HsIPName
n' <- String -> CvtM HsIPName
ipName String
n; HsExpr (GhcPass 'Parsed) -> CvtM (HsExpr (GhcPass 'Parsed))
forall a. a -> CvtM a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsExpr (GhcPass 'Parsed) -> CvtM (HsExpr (GhcPass 'Parsed)))
-> HsExpr (GhcPass 'Parsed) -> CvtM (HsExpr (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ XIPVar (GhcPass 'Parsed) -> HsIPName -> HsExpr (GhcPass 'Parsed)
forall p. XIPVar p -> HsIPName -> HsExpr p
HsIPVar XIPVar (GhcPass 'Parsed)
EpAnnCO
noComments HsIPName
n' }
    cvt (GetFieldE Exp
exp String
f) = do { LocatedA (HsExpr (GhcPass 'Parsed))
e' <- Exp -> CvtM (LHsExpr (GhcPass 'Parsed))
cvtl Exp
exp
                               ; HsExpr (GhcPass 'Parsed) -> CvtM (HsExpr (GhcPass 'Parsed))
forall a. a -> CvtM a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsExpr (GhcPass 'Parsed) -> CvtM (HsExpr (GhcPass 'Parsed)))
-> HsExpr (GhcPass 'Parsed) -> CvtM (HsExpr (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ XGetField (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> XRec (GhcPass 'Parsed) (DotFieldOcc (GhcPass 'Parsed))
-> HsExpr (GhcPass 'Parsed)
forall p.
XGetField p -> LHsExpr p -> XRec p (DotFieldOcc p) -> HsExpr p
HsGetField XGetField (GhcPass 'Parsed)
EpAnnCO
noComments LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
e' (SrcAnn NoEpAnns
-> DotFieldOcc (GhcPass 'Parsed)
-> GenLocated (SrcAnn NoEpAnns) (DotFieldOcc (GhcPass 'Parsed))
forall l e. l -> e -> GenLocated l e
L SrcAnn NoEpAnns
forall ann. SrcAnn ann
noSrcSpanA (XCDotFieldOcc (GhcPass 'Parsed)
-> XRec (GhcPass 'Parsed) CLabelString
-> DotFieldOcc (GhcPass 'Parsed)
forall p. XCDotFieldOcc p -> XRec p CLabelString -> DotFieldOcc p
DotFieldOcc XCDotFieldOcc (GhcPass 'Parsed)
EpAnn AnnFieldLabel
forall a. EpAnn a
noAnn (SrcSpanAnnN -> CLabelString -> GenLocated SrcSpanAnnN CLabelString
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnN
forall ann. SrcAnn ann
noSrcSpanA (String -> CLabelString
fsLit String
f)))) }
    cvt (ProjectionE NonEmpty String
xs) = HsExpr (GhcPass 'Parsed) -> CvtM (HsExpr (GhcPass 'Parsed))
forall a. a -> CvtM a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsExpr (GhcPass 'Parsed) -> CvtM (HsExpr (GhcPass 'Parsed)))
-> HsExpr (GhcPass 'Parsed) -> CvtM (HsExpr (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ XProjection (GhcPass 'Parsed)
-> NonEmpty
     (XRec (GhcPass 'Parsed) (DotFieldOcc (GhcPass 'Parsed)))
-> HsExpr (GhcPass 'Parsed)
forall p.
XProjection p -> NonEmpty (XRec p (DotFieldOcc p)) -> HsExpr p
HsProjection XProjection (GhcPass 'Parsed)
EpAnn AnnProjection
forall a. EpAnn a
noAnn (NonEmpty (XRec (GhcPass 'Parsed) (DotFieldOcc (GhcPass 'Parsed)))
 -> HsExpr (GhcPass 'Parsed))
-> NonEmpty
     (XRec (GhcPass 'Parsed) (DotFieldOcc (GhcPass 'Parsed)))
-> HsExpr (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$ (String
 -> GenLocated (SrcAnn NoEpAnns) (DotFieldOcc (GhcPass 'Parsed)))
-> NonEmpty String
-> NonEmpty
     (GenLocated (SrcAnn NoEpAnns) (DotFieldOcc (GhcPass 'Parsed)))
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SrcAnn NoEpAnns
-> DotFieldOcc (GhcPass 'Parsed)
-> GenLocated (SrcAnn NoEpAnns) (DotFieldOcc (GhcPass 'Parsed))
forall l e. l -> e -> GenLocated l e
L SrcAnn NoEpAnns
forall ann. SrcAnn ann
noSrcSpanA (DotFieldOcc (GhcPass 'Parsed)
 -> GenLocated (SrcAnn NoEpAnns) (DotFieldOcc (GhcPass 'Parsed)))
-> (String -> DotFieldOcc (GhcPass 'Parsed))
-> String
-> GenLocated (SrcAnn NoEpAnns) (DotFieldOcc (GhcPass 'Parsed))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XCDotFieldOcc (GhcPass 'Parsed)
-> XRec (GhcPass 'Parsed) CLabelString
-> DotFieldOcc (GhcPass 'Parsed)
forall p. XCDotFieldOcc p -> XRec p CLabelString -> DotFieldOcc p
DotFieldOcc XCDotFieldOcc (GhcPass 'Parsed)
EpAnn AnnFieldLabel
forall a. EpAnn a
noAnn (GenLocated SrcSpanAnnN CLabelString
 -> DotFieldOcc (GhcPass 'Parsed))
-> (String -> GenLocated SrcSpanAnnN CLabelString)
-> String
-> DotFieldOcc (GhcPass 'Parsed)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpanAnnN -> CLabelString -> GenLocated SrcSpanAnnN CLabelString
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnN
forall ann. SrcAnn ann
noSrcSpanA (CLabelString -> GenLocated SrcSpanAnnN CLabelString)
-> (String -> CLabelString)
-> String
-> GenLocated SrcSpanAnnN CLabelString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> CLabelString
fsLit) NonEmpty String
xs

{- | #16895 Ensure an infix expression's operator is a variable/constructor.
Consider this example:

  $(uInfixE [|1|] [|id id|] [|2|])

This infix expression is obviously ill-formed so we use this helper function
to reject such programs outright.

The constructors `ensureValidOpExp` permits should be in sync with `pprInfixExp`
in Language.Haskell.TH.Ppr from the template-haskell library.
-}
ensureValidOpExp :: TH.Exp -> CvtM a -> CvtM a
ensureValidOpExp :: forall a. Exp -> CvtM a -> CvtM a
ensureValidOpExp (VarE Name
_n) CvtM a
m = CvtM a
m
ensureValidOpExp (ConE Name
_n) CvtM a
m = CvtM a
m
ensureValidOpExp (UnboundVarE Name
_n) CvtM a
m = CvtM a
m
ensureValidOpExp Exp
_e CvtM a
_m =
    SDoc -> CvtM a
forall a. SDoc -> CvtM a
failWith (String -> SDoc
text String
"Non-variable expression is not allowed in an infix expression")

{- Note [Dropping constructors]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
When we drop constructors from the input, we must insert parentheses around the
argument. For example:

  UInfixE x * (AppE (InfixE (Just y) + Nothing) z)

If we convert the InfixE expression to an operator section but don't insert
parentheses, the above expression would be reassociated to

  OpApp (OpApp x * y) + z

which we don't want.
-}

cvtFld :: (RdrName -> CvtM t) -> (TH.Name, TH.Exp)
       -> CvtM (LHsFieldBind GhcPs (LocatedAn NoEpAnns t) (LHsExpr GhcPs))
cvtFld :: forall t.
(RdrName -> CvtM t)
-> FieldExp
-> CvtM
     (LHsFieldBind
        (GhcPass 'Parsed)
        (LocatedAn NoEpAnns t)
        (LHsExpr (GhcPass 'Parsed)))
cvtFld RdrName -> CvtM t
f (Name
v,Exp
e)
  = do  { LocatedA RdrName
v' <- Name -> CvtM (LocatedA RdrName)
vNameL Name
v
        ; GenLocated SrcSpanAnnA t
lhs' <- (RdrName -> CvtM t)
-> LocatedA RdrName -> CvtM (GenLocated SrcSpanAnnA t)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> GenLocated SrcSpanAnnA a -> f (GenLocated SrcSpanAnnA b)
traverse RdrName -> CvtM t
f LocatedA RdrName
v'
        ; LocatedA (HsExpr (GhcPass 'Parsed))
e' <- Exp -> CvtM (LHsExpr (GhcPass 'Parsed))
cvtl Exp
e
        ; HsFieldBind
  (LocatedAn NoEpAnns t) (LocatedA (HsExpr (GhcPass 'Parsed)))
-> CvtM
     (LocatedAn
        AnnListItem
        (HsFieldBind
           (LocatedAn NoEpAnns t) (LocatedA (HsExpr (GhcPass 'Parsed)))))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (HsFieldBind
   (LocatedAn NoEpAnns t) (LocatedA (HsExpr (GhcPass 'Parsed)))
 -> CvtM
      (LocatedAn
         AnnListItem
         (HsFieldBind
            (LocatedAn NoEpAnns t) (LocatedA (HsExpr (GhcPass 'Parsed))))))
-> HsFieldBind
     (LocatedAn NoEpAnns t) (LocatedA (HsExpr (GhcPass 'Parsed)))
-> CvtM
     (LocatedAn
        AnnListItem
        (HsFieldBind
           (LocatedAn NoEpAnns t) (LocatedA (HsExpr (GhcPass 'Parsed)))))
forall a b. (a -> b) -> a -> b
$ HsFieldBind { hfbAnn :: XHsFieldBind (LocatedAn NoEpAnns t)
hfbAnn = XHsFieldBind (LocatedAn NoEpAnns t)
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn
                                 , hfbLHS :: LocatedAn NoEpAnns t
hfbLHS = GenLocated SrcSpanAnnA t -> LocatedAn NoEpAnns t
forall ann1 a2 ann2. LocatedAn ann1 a2 -> LocatedAn ann2 a2
la2la GenLocated SrcSpanAnnA t
lhs'
                                 , hfbRHS :: LocatedA (HsExpr (GhcPass 'Parsed))
hfbRHS = LocatedA (HsExpr (GhcPass 'Parsed))
e'
                                 , hfbPun :: Bool
hfbPun = Bool
False} }

cvtDD :: Range -> CvtM (ArithSeqInfo GhcPs)
cvtDD :: Range -> CvtM (ArithSeqInfo (GhcPass 'Parsed))
cvtDD (FromR Exp
x)           = do { LocatedA (HsExpr (GhcPass 'Parsed))
x' <- Exp -> CvtM (LHsExpr (GhcPass 'Parsed))
cvtl Exp
x; ArithSeqInfo (GhcPass 'Parsed)
-> CvtM (ArithSeqInfo (GhcPass 'Parsed))
forall a. a -> CvtM a
forall (m :: * -> *) a. Monad m => a -> m a
return (ArithSeqInfo (GhcPass 'Parsed)
 -> CvtM (ArithSeqInfo (GhcPass 'Parsed)))
-> ArithSeqInfo (GhcPass 'Parsed)
-> CvtM (ArithSeqInfo (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ LHsExpr (GhcPass 'Parsed) -> ArithSeqInfo (GhcPass 'Parsed)
forall id. LHsExpr id -> ArithSeqInfo id
From LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
x' }
cvtDD (FromThenR Exp
x Exp
y)     = do { LocatedA (HsExpr (GhcPass 'Parsed))
x' <- Exp -> CvtM (LHsExpr (GhcPass 'Parsed))
cvtl Exp
x; LocatedA (HsExpr (GhcPass 'Parsed))
y' <- Exp -> CvtM (LHsExpr (GhcPass 'Parsed))
cvtl Exp
y; ArithSeqInfo (GhcPass 'Parsed)
-> CvtM (ArithSeqInfo (GhcPass 'Parsed))
forall a. a -> CvtM a
forall (m :: * -> *) a. Monad m => a -> m a
return (ArithSeqInfo (GhcPass 'Parsed)
 -> CvtM (ArithSeqInfo (GhcPass 'Parsed)))
-> ArithSeqInfo (GhcPass 'Parsed)
-> CvtM (ArithSeqInfo (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed) -> ArithSeqInfo (GhcPass 'Parsed)
forall id. LHsExpr id -> LHsExpr id -> ArithSeqInfo id
FromThen LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
x' LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
y' }
cvtDD (FromToR Exp
x Exp
y)       = do { LocatedA (HsExpr (GhcPass 'Parsed))
x' <- Exp -> CvtM (LHsExpr (GhcPass 'Parsed))
cvtl Exp
x; LocatedA (HsExpr (GhcPass 'Parsed))
y' <- Exp -> CvtM (LHsExpr (GhcPass 'Parsed))
cvtl Exp
y; ArithSeqInfo (GhcPass 'Parsed)
-> CvtM (ArithSeqInfo (GhcPass 'Parsed))
forall a. a -> CvtM a
forall (m :: * -> *) a. Monad m => a -> m a
return (ArithSeqInfo (GhcPass 'Parsed)
 -> CvtM (ArithSeqInfo (GhcPass 'Parsed)))
-> ArithSeqInfo (GhcPass 'Parsed)
-> CvtM (ArithSeqInfo (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed) -> ArithSeqInfo (GhcPass 'Parsed)
forall id. LHsExpr id -> LHsExpr id -> ArithSeqInfo id
FromTo LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
x' LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
y' }
cvtDD (FromThenToR Exp
x Exp
y Exp
z) = do { LocatedA (HsExpr (GhcPass 'Parsed))
x' <- Exp -> CvtM (LHsExpr (GhcPass 'Parsed))
cvtl Exp
x; LocatedA (HsExpr (GhcPass 'Parsed))
y' <- Exp -> CvtM (LHsExpr (GhcPass 'Parsed))
cvtl Exp
y; LocatedA (HsExpr (GhcPass 'Parsed))
z' <- Exp -> CvtM (LHsExpr (GhcPass 'Parsed))
cvtl Exp
z; ArithSeqInfo (GhcPass 'Parsed)
-> CvtM (ArithSeqInfo (GhcPass 'Parsed))
forall a. a -> CvtM a
forall (m :: * -> *) a. Monad m => a -> m a
return (ArithSeqInfo (GhcPass 'Parsed)
 -> CvtM (ArithSeqInfo (GhcPass 'Parsed)))
-> ArithSeqInfo (GhcPass 'Parsed)
-> CvtM (ArithSeqInfo (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> ArithSeqInfo (GhcPass 'Parsed)
forall id.
LHsExpr id -> LHsExpr id -> LHsExpr id -> ArithSeqInfo id
FromThenTo LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
x' LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
y' LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
z' }

cvt_tup :: [Maybe Exp] -> Boxity -> CvtM (HsExpr GhcPs)
cvt_tup :: [Maybe Exp] -> Boxity -> CvtM (HsExpr (GhcPass 'Parsed))
cvt_tup [Maybe Exp]
es Boxity
boxity = do { let cvtl_maybe :: Maybe Exp -> CvtM (HsTupArg (GhcPass 'Parsed))
cvtl_maybe Maybe Exp
Nothing  = HsTupArg (GhcPass 'Parsed) -> CvtM (HsTupArg (GhcPass 'Parsed))
forall a. a -> CvtM a
forall (m :: * -> *) a. Monad m => a -> m a
return (EpAnn EpaLocation -> HsTupArg (GhcPass 'Parsed)
missingTupArg EpAnn EpaLocation
forall a. EpAnn a
noAnn)
                             cvtl_maybe (Just Exp
e) = (LocatedA (HsExpr (GhcPass 'Parsed)) -> HsTupArg (GhcPass 'Parsed))
-> CvtM (LocatedA (HsExpr (GhcPass 'Parsed)))
-> CvtM (HsTupArg (GhcPass 'Parsed))
forall a b. (a -> b) -> CvtM a -> CvtM b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (XPresent (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed) -> HsTupArg (GhcPass 'Parsed)
forall id. XPresent id -> LHsExpr id -> HsTupArg id
Present XPresent (GhcPass 'Parsed)
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn) (Exp -> CvtM (LHsExpr (GhcPass 'Parsed))
cvtl Exp
e)
                       ; [HsTupArg (GhcPass 'Parsed)]
es' <- (Maybe Exp -> CvtM (HsTupArg (GhcPass 'Parsed)))
-> [Maybe Exp] -> CvtM [HsTupArg (GhcPass 'Parsed)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Maybe Exp -> CvtM (HsTupArg (GhcPass 'Parsed))
cvtl_maybe [Maybe Exp]
es
                       ; HsExpr (GhcPass 'Parsed) -> CvtM (HsExpr (GhcPass 'Parsed))
forall a. a -> CvtM a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsExpr (GhcPass 'Parsed) -> CvtM (HsExpr (GhcPass 'Parsed)))
-> HsExpr (GhcPass 'Parsed) -> CvtM (HsExpr (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ XExplicitTuple (GhcPass 'Parsed)
-> [HsTupArg (GhcPass 'Parsed)]
-> Boxity
-> HsExpr (GhcPass 'Parsed)
forall p. XExplicitTuple p -> [HsTupArg p] -> Boxity -> HsExpr p
ExplicitTuple
                                    XExplicitTuple (GhcPass 'Parsed)
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn
                                    [HsTupArg (GhcPass 'Parsed)]
es'
                                    Boxity
boxity }

{- Note [Operator association]
   ~~~~~~~~~~~~~~~~~~~~~~~~~~~
We must be quite careful about adding parens:
  * Infix (UInfix ...) op arg      Needs parens round the first arg
  * Infix (Infix ...) op arg       Needs parens round the first arg
  * UInfix (UInfix ...) op arg     No parens for first arg
  * UInfix (Infix ...) op arg      Needs parens round first arg


Note [Converting UInfix]
~~~~~~~~~~~~~~~~~~~~~~~~
When converting @UInfixE@, @UInfixP@, @UInfixT@, and @PromotedUInfixT@ values,
we want to readjust the trees to reflect the fixities of the underlying
operators:

  UInfixE x * (UInfixE y + z) ---> (x * y) + z

This is done by the renamer (see @mkOppAppRn@, @mkConOppPatRn@, and
@mkHsOpTyRn@ in GHC.Rename.HsType), which expects that the input will be
completely right-biased for types and left-biased for everything else. So we
left-bias the trees of @UInfixP@ and @UInfixE@ and right-bias the trees of
@UInfixT@ and @PromotedUnfixT@.

Sample input:

  UInfixE
   (UInfixE x op1 y)
   op2
   (UInfixE z op3 w)

Sample output:

  OpApp
    (OpApp
      (OpApp x op1 y)
      op2
      z)
    op3
    w

The functions @cvtOpApp@, @cvtOpAppP@, and @cvtOpAppT@ are responsible for this
biasing.
-}

{- | @cvtOpApp x op y@ converts @op@ and @y@ and produces the operator application @x `op` y@.
The produced tree of infix expressions will be left-biased, provided @x@ is.

We can see that @cvtOpApp@ is correct as follows. The inductive hypothesis
is that @cvtOpApp x op y@ is left-biased, provided @x@ is. It is clear that
this holds for both branches (of @cvtOpApp@), provided we assume it holds for
the recursive calls to @cvtOpApp@.

When we call @cvtOpApp@ from @cvtl@, the first argument will always be left-biased
since we have already run @cvtl@ on it.
-}
cvtOpApp :: LHsExpr GhcPs -> TH.Exp -> TH.Exp -> CvtM (HsExpr GhcPs)
cvtOpApp :: LHsExpr (GhcPass 'Parsed)
-> Exp -> Exp -> CvtM (HsExpr (GhcPass 'Parsed))
cvtOpApp LHsExpr (GhcPass 'Parsed)
x Exp
op1 (UInfixE Exp
y Exp
op2 Exp
z)
  = do { LocatedA (HsExpr (GhcPass 'Parsed))
l <- CvtM (HsExpr (GhcPass 'Parsed))
-> CvtM (LocatedA (HsExpr (GhcPass 'Parsed)))
forall a. CvtM a -> CvtM (LocatedA a)
wrapLA (CvtM (HsExpr (GhcPass 'Parsed))
 -> CvtM (LocatedA (HsExpr (GhcPass 'Parsed))))
-> CvtM (HsExpr (GhcPass 'Parsed))
-> CvtM (LocatedA (HsExpr (GhcPass 'Parsed)))
forall a b. (a -> b) -> a -> b
$ LHsExpr (GhcPass 'Parsed)
-> Exp -> Exp -> CvtM (HsExpr (GhcPass 'Parsed))
cvtOpApp LHsExpr (GhcPass 'Parsed)
x Exp
op1 Exp
y
       ; LHsExpr (GhcPass 'Parsed)
-> Exp -> Exp -> CvtM (HsExpr (GhcPass 'Parsed))
cvtOpApp LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
l Exp
op2 Exp
z }
cvtOpApp LHsExpr (GhcPass 'Parsed)
x Exp
op Exp
y
  = do { LocatedA (HsExpr (GhcPass 'Parsed))
op' <- Exp -> CvtM (LHsExpr (GhcPass 'Parsed))
cvtl Exp
op
       ; LocatedA (HsExpr (GhcPass 'Parsed))
y' <- Exp -> CvtM (LHsExpr (GhcPass 'Parsed))
cvtl Exp
y
       ; HsExpr (GhcPass 'Parsed) -> CvtM (HsExpr (GhcPass 'Parsed))
forall a. a -> CvtM a
forall (m :: * -> *) a. Monad m => a -> m a
return (XOpApp (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> HsExpr (GhcPass 'Parsed)
forall p.
XOpApp p -> LHsExpr p -> LHsExpr p -> LHsExpr p -> HsExpr p
OpApp XOpApp (GhcPass 'Parsed)
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn LHsExpr (GhcPass 'Parsed)
x LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
op' LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
y') }

-------------------------------------
--      Do notation and statements
-------------------------------------

cvtHsDo :: HsDoFlavour -> [TH.Stmt] -> CvtM (HsExpr GhcPs)
cvtHsDo :: HsDoFlavour -> [Stmt] -> CvtM (HsExpr (GhcPass 'Parsed))
cvtHsDo HsDoFlavour
do_or_lc [Stmt]
stmts
  | [Stmt] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Stmt]
stmts = SDoc -> CvtM (HsExpr (GhcPass 'Parsed))
forall a. SDoc -> CvtM a
failWith (String -> SDoc
text String
"Empty stmt list in do-block")
  | Bool
otherwise
  = do  { [GenLocated
   SrcSpanAnnA
   (StmtLR
      (GhcPass 'Parsed)
      (GhcPass 'Parsed)
      (LocatedA (HsExpr (GhcPass 'Parsed))))]
stmts' <- [Stmt]
-> CvtM [LStmt (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
cvtStmts [Stmt]
stmts
        ; let Just ([GenLocated
   SrcSpanAnnA
   (StmtLR
      (GhcPass 'Parsed)
      (GhcPass 'Parsed)
      (LocatedA (HsExpr (GhcPass 'Parsed))))]
stmts'', GenLocated
  SrcSpanAnnA
  (StmtLR
     (GhcPass 'Parsed)
     (GhcPass 'Parsed)
     (LocatedA (HsExpr (GhcPass 'Parsed))))
last') = [GenLocated
   SrcSpanAnnA
   (StmtLR
      (GhcPass 'Parsed)
      (GhcPass 'Parsed)
      (LocatedA (HsExpr (GhcPass 'Parsed))))]
-> Maybe
     ([GenLocated
         SrcSpanAnnA
         (StmtLR
            (GhcPass 'Parsed)
            (GhcPass 'Parsed)
            (LocatedA (HsExpr (GhcPass 'Parsed))))],
      GenLocated
        SrcSpanAnnA
        (StmtLR
           (GhcPass 'Parsed)
           (GhcPass 'Parsed)
           (LocatedA (HsExpr (GhcPass 'Parsed)))))
forall a. [a] -> Maybe ([a], a)
snocView [GenLocated
   SrcSpanAnnA
   (StmtLR
      (GhcPass 'Parsed)
      (GhcPass 'Parsed)
      (LocatedA (HsExpr (GhcPass 'Parsed))))]
stmts'

        ; GenLocated
  SrcSpanAnnA
  (StmtLR
     (GhcPass 'Parsed)
     (GhcPass 'Parsed)
     (LocatedA (HsExpr (GhcPass 'Parsed))))
last'' <- case GenLocated
  SrcSpanAnnA
  (StmtLR
     (GhcPass 'Parsed)
     (GhcPass 'Parsed)
     (LocatedA (HsExpr (GhcPass 'Parsed))))
last' of
                    (L SrcSpanAnnA
loc (BodyStmt XBodyStmt
  (GhcPass 'Parsed)
  (GhcPass 'Parsed)
  (LocatedA (HsExpr (GhcPass 'Parsed)))
_ LocatedA (HsExpr (GhcPass 'Parsed))
body SyntaxExpr (GhcPass 'Parsed)
_ SyntaxExpr (GhcPass 'Parsed)
_))
                      -> GenLocated
  SrcSpanAnnA
  (StmtLR
     (GhcPass 'Parsed)
     (GhcPass 'Parsed)
     (LocatedA (HsExpr (GhcPass 'Parsed))))
-> CvtM
     (GenLocated
        SrcSpanAnnA
        (StmtLR
           (GhcPass 'Parsed)
           (GhcPass 'Parsed)
           (LocatedA (HsExpr (GhcPass 'Parsed)))))
forall a. a -> CvtM a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpanAnnA
-> StmtLR
     (GhcPass 'Parsed)
     (GhcPass 'Parsed)
     (LocatedA (HsExpr (GhcPass 'Parsed)))
-> GenLocated
     SrcSpanAnnA
     (StmtLR
        (GhcPass 'Parsed)
        (GhcPass 'Parsed)
        (LocatedA (HsExpr (GhcPass 'Parsed))))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc (LocatedA (HsExpr (GhcPass 'Parsed))
-> StmtLR
     (GhcPass 'Parsed)
     (GhcPass 'Parsed)
     (LocatedA (HsExpr (GhcPass 'Parsed)))
forall (idR :: Pass) (bodyR :: * -> *) (idL :: Pass).
IsPass idR =>
LocatedA (bodyR (GhcPass idR))
-> StmtLR
     (GhcPass idL) (GhcPass idR) (LocatedA (bodyR (GhcPass idR)))
mkLastStmt LocatedA (HsExpr (GhcPass 'Parsed))
body))
                    GenLocated
  SrcSpanAnnA
  (StmtLR
     (GhcPass 'Parsed)
     (GhcPass 'Parsed)
     (LocatedA (HsExpr (GhcPass 'Parsed))))
_ -> SDoc
-> CvtM
     (GenLocated
        SrcSpanAnnA
        (StmtLR
           (GhcPass 'Parsed)
           (GhcPass 'Parsed)
           (LocatedA (HsExpr (GhcPass 'Parsed)))))
forall a. SDoc -> CvtM a
failWith (GenLocated
  SrcSpanAnnA
  (StmtLR
     (GhcPass 'Parsed)
     (GhcPass 'Parsed)
     (LocatedA (HsExpr (GhcPass 'Parsed))))
-> SDoc
bad_last GenLocated
  SrcSpanAnnA
  (StmtLR
     (GhcPass 'Parsed)
     (GhcPass 'Parsed)
     (LocatedA (HsExpr (GhcPass 'Parsed))))
last')

        ; (LocatedAn
   AnnList
   [GenLocated
      SrcSpanAnnA
      (StmtLR
         (GhcPass 'Parsed)
         (GhcPass 'Parsed)
         (LocatedA (HsExpr (GhcPass 'Parsed))))]
 -> HsExpr (GhcPass 'Parsed))
-> [GenLocated
      SrcSpanAnnA
      (StmtLR
         (GhcPass 'Parsed)
         (GhcPass 'Parsed)
         (LocatedA (HsExpr (GhcPass 'Parsed))))]
-> CvtM (HsExpr (GhcPass 'Parsed))
forall ann a b. (LocatedAn ann a -> b) -> a -> CvtM b
wrapParLA (XDo (GhcPass 'Parsed)
-> HsDoFlavour
-> XRec
     (GhcPass 'Parsed)
     [LStmt (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
-> HsExpr (GhcPass 'Parsed)
forall p. XDo p -> HsDoFlavour -> XRec p [ExprLStmt p] -> HsExpr p
HsDo XDo (GhcPass 'Parsed)
EpAnn AnnList
forall a. EpAnn a
noAnn HsDoFlavour
do_or_lc) ([GenLocated
   SrcSpanAnnA
   (StmtLR
      (GhcPass 'Parsed)
      (GhcPass 'Parsed)
      (LocatedA (HsExpr (GhcPass 'Parsed))))]
stmts'' [GenLocated
   SrcSpanAnnA
   (StmtLR
      (GhcPass 'Parsed)
      (GhcPass 'Parsed)
      (LocatedA (HsExpr (GhcPass 'Parsed))))]
-> [GenLocated
      SrcSpanAnnA
      (StmtLR
         (GhcPass 'Parsed)
         (GhcPass 'Parsed)
         (LocatedA (HsExpr (GhcPass 'Parsed))))]
-> [GenLocated
      SrcSpanAnnA
      (StmtLR
         (GhcPass 'Parsed)
         (GhcPass 'Parsed)
         (LocatedA (HsExpr (GhcPass 'Parsed))))]
forall a. [a] -> [a] -> [a]
++ [GenLocated
  SrcSpanAnnA
  (StmtLR
     (GhcPass 'Parsed)
     (GhcPass 'Parsed)
     (LocatedA (HsExpr (GhcPass 'Parsed))))
last'']) }
  where
    bad_last :: GenLocated
  SrcSpanAnnA
  (StmtLR
     (GhcPass 'Parsed)
     (GhcPass 'Parsed)
     (LocatedA (HsExpr (GhcPass 'Parsed))))
-> SDoc
bad_last GenLocated
  SrcSpanAnnA
  (StmtLR
     (GhcPass 'Parsed)
     (GhcPass 'Parsed)
     (LocatedA (HsExpr (GhcPass 'Parsed))))
stmt = [SDoc] -> SDoc
vcat [ String -> SDoc
text String
"Illegal last statement of" SDoc -> SDoc -> SDoc
<+> HsDoFlavour -> SDoc
pprAHsDoFlavour HsDoFlavour
do_or_lc SDoc -> SDoc -> SDoc
<> SDoc
colon
                         , Int -> SDoc -> SDoc
nest Int
2 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ GenLocated
  SrcSpanAnnA
  (StmtLR
     (GhcPass 'Parsed)
     (GhcPass 'Parsed)
     (LocatedA (HsExpr (GhcPass 'Parsed))))
-> SDoc
forall a. Outputable a => a -> SDoc
Outputable.ppr GenLocated
  SrcSpanAnnA
  (StmtLR
     (GhcPass 'Parsed)
     (GhcPass 'Parsed)
     (LocatedA (HsExpr (GhcPass 'Parsed))))
stmt
                         , String -> SDoc
text String
"(It should be an expression.)" ]

cvtStmts :: [TH.Stmt] -> CvtM [Hs.LStmt GhcPs (LHsExpr GhcPs)]
cvtStmts :: [Stmt]
-> CvtM [LStmt (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
cvtStmts = (Stmt
 -> CvtM
      (GenLocated
         SrcSpanAnnA
         (StmtLR
            (GhcPass 'Parsed)
            (GhcPass 'Parsed)
            (LocatedA (HsExpr (GhcPass 'Parsed))))))
-> [Stmt]
-> CvtM
     [GenLocated
        SrcSpanAnnA
        (StmtLR
           (GhcPass 'Parsed)
           (GhcPass 'Parsed)
           (LocatedA (HsExpr (GhcPass 'Parsed))))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Stmt -> CvtM (LStmt (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)))
Stmt
-> CvtM
     (GenLocated
        SrcSpanAnnA
        (StmtLR
           (GhcPass 'Parsed)
           (GhcPass 'Parsed)
           (LocatedA (HsExpr (GhcPass 'Parsed)))))
cvtStmt

cvtStmt :: TH.Stmt -> CvtM (Hs.LStmt GhcPs (LHsExpr GhcPs))
cvtStmt :: Stmt -> CvtM (LStmt (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)))
cvtStmt (NoBindS Exp
e)    = do { LocatedA (HsExpr (GhcPass 'Parsed))
e' <- Exp -> CvtM (LHsExpr (GhcPass 'Parsed))
cvtl Exp
e; StmtLR
  (GhcPass 'Parsed)
  (GhcPass 'Parsed)
  (LocatedA (HsExpr (GhcPass 'Parsed)))
-> CvtM
     (GenLocated
        SrcSpanAnnA
        (StmtLR
           (GhcPass 'Parsed)
           (GhcPass 'Parsed)
           (LocatedA (HsExpr (GhcPass 'Parsed)))))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (StmtLR
   (GhcPass 'Parsed)
   (GhcPass 'Parsed)
   (LocatedA (HsExpr (GhcPass 'Parsed)))
 -> CvtM
      (GenLocated
         SrcSpanAnnA
         (StmtLR
            (GhcPass 'Parsed)
            (GhcPass 'Parsed)
            (LocatedA (HsExpr (GhcPass 'Parsed))))))
-> StmtLR
     (GhcPass 'Parsed)
     (GhcPass 'Parsed)
     (LocatedA (HsExpr (GhcPass 'Parsed)))
-> CvtM
     (GenLocated
        SrcSpanAnnA
        (StmtLR
           (GhcPass 'Parsed)
           (GhcPass 'Parsed)
           (LocatedA (HsExpr (GhcPass 'Parsed)))))
forall a b. (a -> b) -> a -> b
$ LocatedA (HsExpr (GhcPass 'Parsed))
-> StmtLR
     (GhcPass 'Parsed)
     (GhcPass 'Parsed)
     (LocatedA (HsExpr (GhcPass 'Parsed)))
forall (bodyR :: * -> *) (idL :: Pass).
LocatedA (bodyR (GhcPass 'Parsed))
-> StmtLR
     (GhcPass idL)
     (GhcPass 'Parsed)
     (LocatedA (bodyR (GhcPass 'Parsed)))
mkBodyStmt LocatedA (HsExpr (GhcPass 'Parsed))
e' }
cvtStmt (TH.BindS Pat
p Exp
e) = do { GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
p' <- Pat -> CvtM (LPat (GhcPass 'Parsed))
cvtPat Pat
p; LocatedA (HsExpr (GhcPass 'Parsed))
e' <- Exp -> CvtM (LHsExpr (GhcPass 'Parsed))
cvtl Exp
e; StmtLR
  (GhcPass 'Parsed)
  (GhcPass 'Parsed)
  (LocatedA (HsExpr (GhcPass 'Parsed)))
-> CvtM
     (GenLocated
        SrcSpanAnnA
        (StmtLR
           (GhcPass 'Parsed)
           (GhcPass 'Parsed)
           (LocatedA (HsExpr (GhcPass 'Parsed)))))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (StmtLR
   (GhcPass 'Parsed)
   (GhcPass 'Parsed)
   (LocatedA (HsExpr (GhcPass 'Parsed)))
 -> CvtM
      (GenLocated
         SrcSpanAnnA
         (StmtLR
            (GhcPass 'Parsed)
            (GhcPass 'Parsed)
            (LocatedA (HsExpr (GhcPass 'Parsed))))))
-> StmtLR
     (GhcPass 'Parsed)
     (GhcPass 'Parsed)
     (LocatedA (HsExpr (GhcPass 'Parsed)))
-> CvtM
     (GenLocated
        SrcSpanAnnA
        (StmtLR
           (GhcPass 'Parsed)
           (GhcPass 'Parsed)
           (LocatedA (HsExpr (GhcPass 'Parsed)))))
forall a b. (a -> b) -> a -> b
$ EpAnn [AddEpAnn]
-> LPat (GhcPass 'Parsed)
-> LocatedA (HsExpr (GhcPass 'Parsed))
-> StmtLR
     (GhcPass 'Parsed)
     (GhcPass 'Parsed)
     (LocatedA (HsExpr (GhcPass 'Parsed)))
forall (bodyR :: * -> *).
EpAnn [AddEpAnn]
-> LPat (GhcPass 'Parsed)
-> LocatedA (bodyR (GhcPass 'Parsed))
-> StmtLR
     (GhcPass 'Parsed)
     (GhcPass 'Parsed)
     (LocatedA (bodyR (GhcPass 'Parsed)))
mkPsBindStmt EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn LPat (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
p' LocatedA (HsExpr (GhcPass 'Parsed))
e' }
cvtStmt (TH.LetS [Dec]
ds)   = do { HsLocalBinds (GhcPass 'Parsed)
ds' <- SDoc -> [Dec] -> CvtM (HsLocalBinds (GhcPass 'Parsed))
cvtLocalDecs (String -> SDoc
text String
"a let binding") [Dec]
ds
                            ; StmtLR
  (GhcPass 'Parsed)
  (GhcPass 'Parsed)
  (LocatedA (HsExpr (GhcPass 'Parsed)))
-> CvtM
     (GenLocated
        SrcSpanAnnA
        (StmtLR
           (GhcPass 'Parsed)
           (GhcPass 'Parsed)
           (LocatedA (HsExpr (GhcPass 'Parsed)))))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (StmtLR
   (GhcPass 'Parsed)
   (GhcPass 'Parsed)
   (LocatedA (HsExpr (GhcPass 'Parsed)))
 -> CvtM
      (GenLocated
         SrcSpanAnnA
         (StmtLR
            (GhcPass 'Parsed)
            (GhcPass 'Parsed)
            (LocatedA (HsExpr (GhcPass 'Parsed))))))
-> StmtLR
     (GhcPass 'Parsed)
     (GhcPass 'Parsed)
     (LocatedA (HsExpr (GhcPass 'Parsed)))
-> CvtM
     (GenLocated
        SrcSpanAnnA
        (StmtLR
           (GhcPass 'Parsed)
           (GhcPass 'Parsed)
           (LocatedA (HsExpr (GhcPass 'Parsed)))))
forall a b. (a -> b) -> a -> b
$ XLetStmt
  (GhcPass 'Parsed)
  (GhcPass 'Parsed)
  (LocatedA (HsExpr (GhcPass 'Parsed)))
-> HsLocalBinds (GhcPass 'Parsed)
-> StmtLR
     (GhcPass 'Parsed)
     (GhcPass 'Parsed)
     (LocatedA (HsExpr (GhcPass 'Parsed)))
forall idL idR body.
XLetStmt idL idR body
-> HsLocalBindsLR idL idR -> StmtLR idL idR body
LetStmt XLetStmt
  (GhcPass 'Parsed)
  (GhcPass 'Parsed)
  (LocatedA (HsExpr (GhcPass 'Parsed)))
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn HsLocalBinds (GhcPass 'Parsed)
ds' }
cvtStmt (TH.ParS [[Stmt]]
dss)  = do { [ParStmtBlock (GhcPass 'Parsed) (GhcPass 'Parsed)]
dss' <- ([Stmt] -> CvtM (ParStmtBlock (GhcPass 'Parsed) (GhcPass 'Parsed)))
-> [[Stmt]]
-> CvtM [ParStmtBlock (GhcPass 'Parsed) (GhcPass 'Parsed)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM [Stmt] -> CvtM (ParStmtBlock (GhcPass 'Parsed) (GhcPass 'Parsed))
forall {p :: Pass} {idR}.
(SyntaxExprGhc p ~ SyntaxExpr idR,
 XParStmtBlock (GhcPass 'Parsed) idR ~ NoExtField, IsPass p) =>
[Stmt] -> CvtM (ParStmtBlock (GhcPass 'Parsed) idR)
cvt_one [[Stmt]]
dss
                            ; StmtLR
  (GhcPass 'Parsed)
  (GhcPass 'Parsed)
  (LocatedA (HsExpr (GhcPass 'Parsed)))
-> CvtM
     (GenLocated
        SrcSpanAnnA
        (StmtLR
           (GhcPass 'Parsed)
           (GhcPass 'Parsed)
           (LocatedA (HsExpr (GhcPass 'Parsed)))))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (StmtLR
   (GhcPass 'Parsed)
   (GhcPass 'Parsed)
   (LocatedA (HsExpr (GhcPass 'Parsed)))
 -> CvtM
      (GenLocated
         SrcSpanAnnA
         (StmtLR
            (GhcPass 'Parsed)
            (GhcPass 'Parsed)
            (LocatedA (HsExpr (GhcPass 'Parsed))))))
-> StmtLR
     (GhcPass 'Parsed)
     (GhcPass 'Parsed)
     (LocatedA (HsExpr (GhcPass 'Parsed)))
-> CvtM
     (GenLocated
        SrcSpanAnnA
        (StmtLR
           (GhcPass 'Parsed)
           (GhcPass 'Parsed)
           (LocatedA (HsExpr (GhcPass 'Parsed)))))
forall a b. (a -> b) -> a -> b
$ XParStmt
  (GhcPass 'Parsed)
  (GhcPass 'Parsed)
  (LocatedA (HsExpr (GhcPass 'Parsed)))
-> [ParStmtBlock (GhcPass 'Parsed) (GhcPass 'Parsed)]
-> HsExpr (GhcPass 'Parsed)
-> SyntaxExpr (GhcPass 'Parsed)
-> StmtLR
     (GhcPass 'Parsed)
     (GhcPass 'Parsed)
     (LocatedA (HsExpr (GhcPass 'Parsed)))
forall idL idR body.
XParStmt idL idR body
-> [ParStmtBlock idL idR]
-> HsExpr idR
-> SyntaxExpr idR
-> StmtLR idL idR body
ParStmt XParStmt
  (GhcPass 'Parsed)
  (GhcPass 'Parsed)
  (LocatedA (HsExpr (GhcPass 'Parsed)))
NoExtField
noExtField [ParStmtBlock (GhcPass 'Parsed) (GhcPass 'Parsed)]
dss' HsExpr (GhcPass 'Parsed)
forall (p :: Pass). HsExpr (GhcPass p)
noExpr SyntaxExpr (GhcPass 'Parsed)
forall (p :: Pass). IsPass p => SyntaxExpr (GhcPass p)
noSyntaxExpr }
  where
    cvt_one :: [Stmt] -> CvtM (ParStmtBlock (GhcPass 'Parsed) idR)
cvt_one [Stmt]
ds = do { [GenLocated
   SrcSpanAnnA
   (StmtLR
      (GhcPass 'Parsed)
      (GhcPass 'Parsed)
      (LocatedA (HsExpr (GhcPass 'Parsed))))]
ds' <- [Stmt]
-> CvtM [LStmt (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
cvtStmts [Stmt]
ds
                    ; ParStmtBlock (GhcPass 'Parsed) idR
-> CvtM (ParStmtBlock (GhcPass 'Parsed) idR)
forall a. a -> CvtM a
forall (m :: * -> *) a. Monad m => a -> m a
return (XParStmtBlock (GhcPass 'Parsed) idR
-> [LStmt (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
-> [IdP idR]
-> SyntaxExpr idR
-> ParStmtBlock (GhcPass 'Parsed) idR
forall idL idR.
XParStmtBlock idL idR
-> [ExprLStmt idL]
-> [IdP idR]
-> SyntaxExpr idR
-> ParStmtBlock idL idR
ParStmtBlock XParStmtBlock (GhcPass 'Parsed) idR
NoExtField
noExtField [LStmt (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
[GenLocated
   SrcSpanAnnA
   (StmtLR
      (GhcPass 'Parsed)
      (GhcPass 'Parsed)
      (LocatedA (HsExpr (GhcPass 'Parsed))))]
ds' [IdP idR]
forall a. HasCallStack => a
undefined SyntaxExpr idR
SyntaxExpr (GhcPass p)
forall (p :: Pass). IsPass p => SyntaxExpr (GhcPass p)
noSyntaxExpr) }
cvtStmt (TH.RecS [Stmt]
ss) = do { [GenLocated
   SrcSpanAnnA
   (StmtLR
      (GhcPass 'Parsed)
      (GhcPass 'Parsed)
      (LocatedA (HsExpr (GhcPass 'Parsed))))]
ss' <- (Stmt
 -> CvtM
      (GenLocated
         SrcSpanAnnA
         (StmtLR
            (GhcPass 'Parsed)
            (GhcPass 'Parsed)
            (LocatedA (HsExpr (GhcPass 'Parsed))))))
-> [Stmt]
-> CvtM
     [GenLocated
        SrcSpanAnnA
        (StmtLR
           (GhcPass 'Parsed)
           (GhcPass 'Parsed)
           (LocatedA (HsExpr (GhcPass 'Parsed))))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Stmt -> CvtM (LStmt (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)))
Stmt
-> CvtM
     (GenLocated
        SrcSpanAnnA
        (StmtLR
           (GhcPass 'Parsed)
           (GhcPass 'Parsed)
           (LocatedA (HsExpr (GhcPass 'Parsed)))))
cvtStmt [Stmt]
ss
                          ; StmtLR
  (GhcPass 'Parsed)
  (GhcPass 'Parsed)
  (LocatedA (HsExpr (GhcPass 'Parsed)))
rec_stmt <- (LocatedAn
   AnnList
   [GenLocated
      SrcSpanAnnA
      (StmtLR
         (GhcPass 'Parsed)
         (GhcPass 'Parsed)
         (LocatedA (HsExpr (GhcPass 'Parsed))))]
 -> StmtLR
      (GhcPass 'Parsed)
      (GhcPass 'Parsed)
      (LocatedA (HsExpr (GhcPass 'Parsed))))
-> [GenLocated
      SrcSpanAnnA
      (StmtLR
         (GhcPass 'Parsed)
         (GhcPass 'Parsed)
         (LocatedA (HsExpr (GhcPass 'Parsed))))]
-> CvtM
     (StmtLR
        (GhcPass 'Parsed)
        (GhcPass 'Parsed)
        (LocatedA (HsExpr (GhcPass 'Parsed))))
forall ann a b. (LocatedAn ann a -> b) -> a -> CvtM b
wrapParLA (EpAnn AnnList
-> LocatedL
     [LStmtLR
        (GhcPass 'Parsed)
        (GhcPass 'Parsed)
        (LocatedA (HsExpr (GhcPass 'Parsed)))]
-> StmtLR
     (GhcPass 'Parsed)
     (GhcPass 'Parsed)
     (LocatedA (HsExpr (GhcPass 'Parsed)))
forall (idL :: Pass) bodyR.
(Anno
   [GenLocated
      (Anno (StmtLR (GhcPass idL) (GhcPass 'Parsed) bodyR))
      (StmtLR (GhcPass idL) (GhcPass 'Parsed) bodyR)]
 ~ SrcSpanAnnL) =>
EpAnn AnnList
-> LocatedL [LStmtLR (GhcPass idL) (GhcPass 'Parsed) bodyR]
-> StmtLR (GhcPass idL) (GhcPass 'Parsed) bodyR
mkRecStmt EpAnn AnnList
forall a. EpAnn a
noAnn) [GenLocated
   SrcSpanAnnA
   (StmtLR
      (GhcPass 'Parsed)
      (GhcPass 'Parsed)
      (LocatedA (HsExpr (GhcPass 'Parsed))))]
ss'
                          ; StmtLR
  (GhcPass 'Parsed)
  (GhcPass 'Parsed)
  (LocatedA (HsExpr (GhcPass 'Parsed)))
-> CvtM
     (GenLocated
        SrcSpanAnnA
        (StmtLR
           (GhcPass 'Parsed)
           (GhcPass 'Parsed)
           (LocatedA (HsExpr (GhcPass 'Parsed)))))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA StmtLR
  (GhcPass 'Parsed)
  (GhcPass 'Parsed)
  (LocatedA (HsExpr (GhcPass 'Parsed)))
rec_stmt }

cvtMatch :: HsMatchContext GhcPs
         -> TH.Match -> CvtM (Hs.LMatch GhcPs (LHsExpr GhcPs))
cvtMatch :: HsMatchContext (GhcPass 'Parsed)
-> Match
-> CvtM (LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)))
cvtMatch HsMatchContext (GhcPass 'Parsed)
ctxt (TH.Match Pat
p Body
body [Dec]
decs)
  = do  { GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
p' <- Pat -> CvtM (LPat (GhcPass 'Parsed))
cvtPat Pat
p
        ; let lp :: GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
lp = case GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
p' of
                     (L SrcSpanAnnA
loc SigPat{}) -> SrcSpanAnnA
-> Pat (GhcPass 'Parsed)
-> GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc (LPat (GhcPass 'Parsed) -> Pat (GhcPass 'Parsed)
forall (pass :: Pass). LPat (GhcPass pass) -> Pat (GhcPass pass)
gParPat LPat (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
p') -- #14875
                     GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
_                -> GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
p'
        ; [GenLocated
   (SrcAnn NoEpAnns)
   (GRHS (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
g' <- Body -> CvtM [LGRHS (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
cvtGuard Body
body
        ; HsLocalBinds (GhcPass 'Parsed)
decs' <- SDoc -> [Dec] -> CvtM (HsLocalBinds (GhcPass 'Parsed))
cvtLocalDecs (String -> SDoc
text String
"a where clause") [Dec]
decs
        ; Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
-> CvtM
     (GenLocated
        SrcSpanAnnA
        (Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
 -> CvtM
      (GenLocated
         SrcSpanAnnA
         (Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))))
-> Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
-> CvtM
     (GenLocated
        SrcSpanAnnA
        (Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))))
forall a b. (a -> b) -> a -> b
$ XCMatch (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
-> HsMatchContext (GhcPass 'Parsed)
-> [LPat (GhcPass 'Parsed)]
-> GRHSs (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
-> Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
forall p body.
XCMatch p body
-> HsMatchContext p -> [LPat p] -> GRHSs p body -> Match p body
Hs.Match XCMatch (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn HsMatchContext (GhcPass 'Parsed)
ctxt [LPat (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
lp] (XCGRHSs (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
-> [LGRHS (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))]
-> HsLocalBinds (GhcPass 'Parsed)
-> GRHSs (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
forall p body.
XCGRHSs p body -> [LGRHS p body] -> HsLocalBinds p -> GRHSs p body
GRHSs XCGRHSs (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
EpAnnComments
emptyComments [LGRHS (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))]
[GenLocated
   (SrcAnn NoEpAnns)
   (GRHS (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
g' HsLocalBinds (GhcPass 'Parsed)
decs') }

cvtGuard :: TH.Body -> CvtM [LGRHS GhcPs (LHsExpr GhcPs)]
cvtGuard :: Body -> CvtM [LGRHS (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
cvtGuard (GuardedB [(Guard, Exp)]
pairs) = ((Guard, Exp)
 -> CvtM
      (GenLocated
         (SrcAnn NoEpAnns)
         (GRHS (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))))
-> [(Guard, Exp)]
-> CvtM
     [GenLocated
        (SrcAnn NoEpAnns)
        (GRHS (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Guard, Exp)
-> CvtM (LGRHS (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)))
(Guard, Exp)
-> CvtM
     (GenLocated
        (SrcAnn NoEpAnns)
        (GRHS (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))))
cvtpair [(Guard, Exp)]
pairs
cvtGuard (NormalB Exp
e)      = do { LocatedA (HsExpr (GhcPass 'Parsed))
e' <- Exp -> CvtM (LHsExpr (GhcPass 'Parsed))
cvtl Exp
e
                               ; GenLocated
  (SrcAnn NoEpAnns)
  (GRHS (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))
g' <- GRHS (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
-> CvtM
     (GenLocated
        (SrcAnn NoEpAnns)
        (GRHS (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (GRHS (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
 -> CvtM
      (GenLocated
         (SrcAnn NoEpAnns)
         (GRHS (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))))
-> GRHS (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
-> CvtM
     (GenLocated
        (SrcAnn NoEpAnns)
        (GRHS (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))))
forall a b. (a -> b) -> a -> b
$ XCGRHS (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
-> [LStmt (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
-> LocatedA (HsExpr (GhcPass 'Parsed))
-> GRHS (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
forall p body.
XCGRHS p body -> [GuardLStmt p] -> body -> GRHS p body
GRHS XCGRHS (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
EpAnn GrhsAnn
forall a. EpAnn a
noAnn [] LocatedA (HsExpr (GhcPass 'Parsed))
e'; [GenLocated
   (SrcAnn NoEpAnns)
   (GRHS (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
-> CvtM
     [GenLocated
        (SrcAnn NoEpAnns)
        (GRHS (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
forall a. a -> CvtM a
forall (m :: * -> *) a. Monad m => a -> m a
return [GenLocated
  (SrcAnn NoEpAnns)
  (GRHS (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))
g'] }

cvtpair :: (TH.Guard, TH.Exp) -> CvtM (LGRHS GhcPs (LHsExpr GhcPs))
cvtpair :: (Guard, Exp)
-> CvtM (LGRHS (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)))
cvtpair (NormalG Exp
ge,Exp
rhs) = do { LocatedA (HsExpr (GhcPass 'Parsed))
ge' <- Exp -> CvtM (LHsExpr (GhcPass 'Parsed))
cvtl Exp
ge; LocatedA (HsExpr (GhcPass 'Parsed))
rhs' <- Exp -> CvtM (LHsExpr (GhcPass 'Parsed))
cvtl Exp
rhs
                              ; GenLocated
  SrcSpanAnnA
  (StmtLR
     (GhcPass 'Parsed)
     (GhcPass 'Parsed)
     (LocatedA (HsExpr (GhcPass 'Parsed))))
g' <- StmtLR
  (GhcPass 'Parsed)
  (GhcPass 'Parsed)
  (LocatedA (HsExpr (GhcPass 'Parsed)))
-> CvtM
     (GenLocated
        SrcSpanAnnA
        (StmtLR
           (GhcPass 'Parsed)
           (GhcPass 'Parsed)
           (LocatedA (HsExpr (GhcPass 'Parsed)))))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (StmtLR
   (GhcPass 'Parsed)
   (GhcPass 'Parsed)
   (LocatedA (HsExpr (GhcPass 'Parsed)))
 -> CvtM
      (GenLocated
         SrcSpanAnnA
         (StmtLR
            (GhcPass 'Parsed)
            (GhcPass 'Parsed)
            (LocatedA (HsExpr (GhcPass 'Parsed))))))
-> StmtLR
     (GhcPass 'Parsed)
     (GhcPass 'Parsed)
     (LocatedA (HsExpr (GhcPass 'Parsed)))
-> CvtM
     (GenLocated
        SrcSpanAnnA
        (StmtLR
           (GhcPass 'Parsed)
           (GhcPass 'Parsed)
           (LocatedA (HsExpr (GhcPass 'Parsed)))))
forall a b. (a -> b) -> a -> b
$ LocatedA (HsExpr (GhcPass 'Parsed))
-> StmtLR
     (GhcPass 'Parsed)
     (GhcPass 'Parsed)
     (LocatedA (HsExpr (GhcPass 'Parsed)))
forall (bodyR :: * -> *) (idL :: Pass).
LocatedA (bodyR (GhcPass 'Parsed))
-> StmtLR
     (GhcPass idL)
     (GhcPass 'Parsed)
     (LocatedA (bodyR (GhcPass 'Parsed)))
mkBodyStmt LocatedA (HsExpr (GhcPass 'Parsed))
ge'
                              ; GRHS (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
-> CvtM
     (GenLocated
        (SrcAnn NoEpAnns)
        (GRHS (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (GRHS (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
 -> CvtM
      (GenLocated
         (SrcAnn NoEpAnns)
         (GRHS (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))))
-> GRHS (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
-> CvtM
     (GenLocated
        (SrcAnn NoEpAnns)
        (GRHS (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))))
forall a b. (a -> b) -> a -> b
$ XCGRHS (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
-> [LStmt (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
-> LocatedA (HsExpr (GhcPass 'Parsed))
-> GRHS (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
forall p body.
XCGRHS p body -> [GuardLStmt p] -> body -> GRHS p body
GRHS XCGRHS (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
EpAnn GrhsAnn
forall a. EpAnn a
noAnn [LStmt (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
GenLocated
  SrcSpanAnnA
  (StmtLR
     (GhcPass 'Parsed)
     (GhcPass 'Parsed)
     (LocatedA (HsExpr (GhcPass 'Parsed))))
g'] LocatedA (HsExpr (GhcPass 'Parsed))
rhs' }
cvtpair (PatG [Stmt]
gs,Exp
rhs)    = do { [GenLocated
   SrcSpanAnnA
   (StmtLR
      (GhcPass 'Parsed)
      (GhcPass 'Parsed)
      (LocatedA (HsExpr (GhcPass 'Parsed))))]
gs' <- [Stmt]
-> CvtM [LStmt (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
cvtStmts [Stmt]
gs; LocatedA (HsExpr (GhcPass 'Parsed))
rhs' <- Exp -> CvtM (LHsExpr (GhcPass 'Parsed))
cvtl Exp
rhs
                              ; GRHS (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
-> CvtM
     (GenLocated
        (SrcAnn NoEpAnns)
        (GRHS (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (GRHS (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
 -> CvtM
      (GenLocated
         (SrcAnn NoEpAnns)
         (GRHS (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))))
-> GRHS (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
-> CvtM
     (GenLocated
        (SrcAnn NoEpAnns)
        (GRHS (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))))
forall a b. (a -> b) -> a -> b
$ XCGRHS (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
-> [LStmt (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
-> LocatedA (HsExpr (GhcPass 'Parsed))
-> GRHS (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
forall p body.
XCGRHS p body -> [GuardLStmt p] -> body -> GRHS p body
GRHS XCGRHS (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
EpAnn GrhsAnn
forall a. EpAnn a
noAnn [LStmt (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
[GenLocated
   SrcSpanAnnA
   (StmtLR
      (GhcPass 'Parsed)
      (GhcPass 'Parsed)
      (LocatedA (HsExpr (GhcPass 'Parsed))))]
gs' LocatedA (HsExpr (GhcPass 'Parsed))
rhs' }

cvtOverLit :: Lit -> CvtM (HsOverLit GhcPs)
cvtOverLit :: Lit -> CvtM (HsOverLit (GhcPass 'Parsed))
cvtOverLit (IntegerL Integer
i)
  = do { Integer -> CvtM ()
forall a. a -> CvtM ()
force Integer
i; HsOverLit (GhcPass 'Parsed) -> CvtM (HsOverLit (GhcPass 'Parsed))
forall a. a -> CvtM a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsOverLit (GhcPass 'Parsed) -> CvtM (HsOverLit (GhcPass 'Parsed)))
-> HsOverLit (GhcPass 'Parsed)
-> CvtM (HsOverLit (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ IntegralLit -> HsOverLit (GhcPass 'Parsed)
mkHsIntegral   (Integer -> IntegralLit
forall a. Integral a => a -> IntegralLit
mkIntegralLit Integer
i) }
cvtOverLit (RationalL Rational
r)
  = do { Rational -> CvtM ()
forall a. a -> CvtM ()
force Rational
r; HsOverLit (GhcPass 'Parsed) -> CvtM (HsOverLit (GhcPass 'Parsed))
forall a. a -> CvtM a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsOverLit (GhcPass 'Parsed) -> CvtM (HsOverLit (GhcPass 'Parsed)))
-> HsOverLit (GhcPass 'Parsed)
-> CvtM (HsOverLit (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ FractionalLit -> HsOverLit (GhcPass 'Parsed)
mkHsFractional (Rational -> FractionalLit
mkTHFractionalLit Rational
r) }
cvtOverLit (StringL String
s)
  = do { let { s' :: CLabelString
s' = String -> CLabelString
mkFastString String
s }
       ; CLabelString -> CvtM ()
forall a. a -> CvtM ()
force CLabelString
s'
       ; HsOverLit (GhcPass 'Parsed) -> CvtM (HsOverLit (GhcPass 'Parsed))
forall a. a -> CvtM a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsOverLit (GhcPass 'Parsed) -> CvtM (HsOverLit (GhcPass 'Parsed)))
-> HsOverLit (GhcPass 'Parsed)
-> CvtM (HsOverLit (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ SourceText -> CLabelString -> HsOverLit (GhcPass 'Parsed)
mkHsIsString (String -> SourceText
quotedSourceText String
s) CLabelString
s'
       }
cvtOverLit Lit
_ = String -> CvtM (HsOverLit (GhcPass 'Parsed))
forall a. String -> a
panic String
"Convert.cvtOverLit: Unexpected overloaded literal"
-- An Integer is like an (overloaded) '3' in a Haskell source program
-- Similarly 3.5 for fractionals

{- Note [Converting strings]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~
If we get (ListE [CharL 'x', CharL 'y']) we'd like to convert to
a string literal for "xy".  Of course, we might hope to get
(LitE (StringL "xy")), but not always, and allCharLs fails quickly
if it isn't a literal string
-}

allCharLs :: [TH.Exp] -> Maybe String
-- Note [Converting strings]
-- NB: only fire up this setup for a non-empty list, else
--     there's a danger of returning "" for [] :: [Int]!
allCharLs :: [Exp] -> Maybe String
allCharLs [Exp]
xs
  = case [Exp]
xs of
      LitE (CharL Char
c) : [Exp]
ys -> String -> [Exp] -> Maybe String
go [Char
c] [Exp]
ys
      [Exp]
_                   -> Maybe String
forall a. Maybe a
Nothing
  where
    go :: String -> [Exp] -> Maybe String
go String
cs []                    = String -> Maybe String
forall a. a -> Maybe a
Just (String -> String
forall a. [a] -> [a]
reverse String
cs)
    go String
cs (LitE (CharL Char
c) : [Exp]
ys) = String -> [Exp] -> Maybe String
go (Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:String
cs) [Exp]
ys
    go String
_  [Exp]
_                     = Maybe String
forall a. Maybe a
Nothing

cvtLit :: Lit -> CvtM (HsLit GhcPs)
cvtLit :: Lit -> CvtM (HsLit (GhcPass 'Parsed))
cvtLit (IntPrimL Integer
i)    = do { Integer -> CvtM ()
forall a. a -> CvtM ()
force Integer
i; HsLit (GhcPass 'Parsed) -> CvtM (HsLit (GhcPass 'Parsed))
forall a. a -> CvtM a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsLit (GhcPass 'Parsed) -> CvtM (HsLit (GhcPass 'Parsed)))
-> HsLit (GhcPass 'Parsed) -> CvtM (HsLit (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ XHsIntPrim (GhcPass 'Parsed) -> Integer -> HsLit (GhcPass 'Parsed)
forall x. XHsIntPrim x -> Integer -> HsLit x
HsIntPrim XHsIntPrim (GhcPass 'Parsed)
SourceText
NoSourceText Integer
i }
cvtLit (WordPrimL Integer
w)   = do { Integer -> CvtM ()
forall a. a -> CvtM ()
force Integer
w; HsLit (GhcPass 'Parsed) -> CvtM (HsLit (GhcPass 'Parsed))
forall a. a -> CvtM a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsLit (GhcPass 'Parsed) -> CvtM (HsLit (GhcPass 'Parsed)))
-> HsLit (GhcPass 'Parsed) -> CvtM (HsLit (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ XHsWordPrim (GhcPass 'Parsed) -> Integer -> HsLit (GhcPass 'Parsed)
forall x. XHsWordPrim x -> Integer -> HsLit x
HsWordPrim XHsWordPrim (GhcPass 'Parsed)
SourceText
NoSourceText Integer
w }
cvtLit (FloatPrimL Rational
f)
  = do { Rational -> CvtM ()
forall a. a -> CvtM ()
force Rational
f; HsLit (GhcPass 'Parsed) -> CvtM (HsLit (GhcPass 'Parsed))
forall a. a -> CvtM a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsLit (GhcPass 'Parsed) -> CvtM (HsLit (GhcPass 'Parsed)))
-> HsLit (GhcPass 'Parsed) -> CvtM (HsLit (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ XHsFloatPrim (GhcPass 'Parsed)
-> FractionalLit -> HsLit (GhcPass 'Parsed)
forall x. XHsFloatPrim x -> FractionalLit -> HsLit x
HsFloatPrim XHsFloatPrim (GhcPass 'Parsed)
NoExtField
noExtField (Rational -> FractionalLit
mkTHFractionalLit Rational
f) }
cvtLit (DoublePrimL Rational
f)
  = do { Rational -> CvtM ()
forall a. a -> CvtM ()
force Rational
f; HsLit (GhcPass 'Parsed) -> CvtM (HsLit (GhcPass 'Parsed))
forall a. a -> CvtM a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsLit (GhcPass 'Parsed) -> CvtM (HsLit (GhcPass 'Parsed)))
-> HsLit (GhcPass 'Parsed) -> CvtM (HsLit (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ XHsDoublePrim (GhcPass 'Parsed)
-> FractionalLit -> HsLit (GhcPass 'Parsed)
forall x. XHsDoublePrim x -> FractionalLit -> HsLit x
HsDoublePrim XHsDoublePrim (GhcPass 'Parsed)
NoExtField
noExtField (Rational -> FractionalLit
mkTHFractionalLit Rational
f) }
cvtLit (CharL Char
c)       = do { Char -> CvtM ()
forall a. a -> CvtM ()
force Char
c; HsLit (GhcPass 'Parsed) -> CvtM (HsLit (GhcPass 'Parsed))
forall a. a -> CvtM a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsLit (GhcPass 'Parsed) -> CvtM (HsLit (GhcPass 'Parsed)))
-> HsLit (GhcPass 'Parsed) -> CvtM (HsLit (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ XHsChar (GhcPass 'Parsed) -> Char -> HsLit (GhcPass 'Parsed)
forall x. XHsChar x -> Char -> HsLit x
HsChar XHsChar (GhcPass 'Parsed)
SourceText
NoSourceText Char
c }
cvtLit (CharPrimL Char
c)   = do { Char -> CvtM ()
forall a. a -> CvtM ()
force Char
c; HsLit (GhcPass 'Parsed) -> CvtM (HsLit (GhcPass 'Parsed))
forall a. a -> CvtM a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsLit (GhcPass 'Parsed) -> CvtM (HsLit (GhcPass 'Parsed)))
-> HsLit (GhcPass 'Parsed) -> CvtM (HsLit (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ XHsCharPrim (GhcPass 'Parsed) -> Char -> HsLit (GhcPass 'Parsed)
forall x. XHsCharPrim x -> Char -> HsLit x
HsCharPrim XHsCharPrim (GhcPass 'Parsed)
SourceText
NoSourceText Char
c }
cvtLit (StringL String
s)     = do { let { s' :: CLabelString
s' = String -> CLabelString
mkFastString String
s }
                            ; CLabelString -> CvtM ()
forall a. a -> CvtM ()
force CLabelString
s'
                            ; HsLit (GhcPass 'Parsed) -> CvtM (HsLit (GhcPass 'Parsed))
forall a. a -> CvtM a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsLit (GhcPass 'Parsed) -> CvtM (HsLit (GhcPass 'Parsed)))
-> HsLit (GhcPass 'Parsed) -> CvtM (HsLit (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ XHsString (GhcPass 'Parsed)
-> CLabelString -> HsLit (GhcPass 'Parsed)
forall x. XHsString x -> CLabelString -> HsLit x
HsString (String -> SourceText
quotedSourceText String
s) CLabelString
s' }
cvtLit (StringPrimL [Word8]
s) = do { let { !s' :: ByteString
s' = [Word8] -> ByteString
BS.pack [Word8]
s }
                            ; HsLit (GhcPass 'Parsed) -> CvtM (HsLit (GhcPass 'Parsed))
forall a. a -> CvtM a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsLit (GhcPass 'Parsed) -> CvtM (HsLit (GhcPass 'Parsed)))
-> HsLit (GhcPass 'Parsed) -> CvtM (HsLit (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ XHsStringPrim (GhcPass 'Parsed)
-> ByteString -> HsLit (GhcPass 'Parsed)
forall x. XHsStringPrim x -> ByteString -> HsLit x
HsStringPrim XHsStringPrim (GhcPass 'Parsed)
SourceText
NoSourceText ByteString
s' }
cvtLit (BytesPrimL (Bytes ForeignPtr Word8
fptr Word
off Word
sz)) = do
  let bs :: ByteString
bs = IO ByteString -> ByteString
forall a. IO a -> a
unsafePerformIO (IO ByteString -> ByteString) -> IO ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> (Ptr Word8 -> IO ByteString) -> IO ByteString
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fptr ((Ptr Word8 -> IO ByteString) -> IO ByteString)
-> (Ptr Word8 -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr ->
             CStringLen -> IO ByteString
BS.packCStringLen (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr CChar
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
off, Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
sz)
  ByteString -> CvtM ()
forall a. a -> CvtM ()
force ByteString
bs
  HsLit (GhcPass 'Parsed) -> CvtM (HsLit (GhcPass 'Parsed))
forall a. a -> CvtM a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsLit (GhcPass 'Parsed) -> CvtM (HsLit (GhcPass 'Parsed)))
-> HsLit (GhcPass 'Parsed) -> CvtM (HsLit (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ XHsStringPrim (GhcPass 'Parsed)
-> ByteString -> HsLit (GhcPass 'Parsed)
forall x. XHsStringPrim x -> ByteString -> HsLit x
HsStringPrim XHsStringPrim (GhcPass 'Parsed)
SourceText
NoSourceText ByteString
bs
cvtLit Lit
_ = String -> CvtM (HsLit (GhcPass 'Parsed))
forall a. String -> a
panic String
"Convert.cvtLit: Unexpected literal"
        -- cvtLit should not be called on IntegerL, RationalL
        -- That precondition is established right here in
        -- "GHC.ThToHs", hence panic

quotedSourceText :: String -> SourceText
quotedSourceText :: String -> SourceText
quotedSourceText String
s = String -> SourceText
SourceText (String -> SourceText) -> String -> SourceText
forall a b. (a -> b) -> a -> b
$ String
"\"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\""

cvtPats :: [TH.Pat] -> CvtM [Hs.LPat GhcPs]
cvtPats :: [Pat] -> CvtM [LPat (GhcPass 'Parsed)]
cvtPats [Pat]
pats = (Pat -> CvtM (GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))))
-> [Pat] -> CvtM [GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Pat -> CvtM (LPat (GhcPass 'Parsed))
Pat -> CvtM (GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed)))
cvtPat [Pat]
pats

cvtPat :: TH.Pat -> CvtM (Hs.LPat GhcPs)
cvtPat :: Pat -> CvtM (LPat (GhcPass 'Parsed))
cvtPat Pat
pat = CvtM (Pat (GhcPass 'Parsed))
-> CvtM (GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed)))
forall a. CvtM a -> CvtM (LocatedA a)
wrapLA (Pat -> CvtM (Pat (GhcPass 'Parsed))
cvtp Pat
pat)

cvtp :: TH.Pat -> CvtM (Hs.Pat GhcPs)
cvtp :: Pat -> CvtM (Pat (GhcPass 'Parsed))
cvtp (TH.LitP Lit
l)
  | Lit -> Bool
overloadedLit Lit
l    = do { HsOverLit (GhcPass 'Parsed)
l' <- Lit -> CvtM (HsOverLit (GhcPass 'Parsed))
cvtOverLit Lit
l
                            ; LocatedAn NoEpAnns (HsOverLit (GhcPass 'Parsed))
l'' <- HsOverLit (GhcPass 'Parsed)
-> CvtM (LocatedAn NoEpAnns (HsOverLit (GhcPass 'Parsed)))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA HsOverLit (GhcPass 'Parsed)
l'
                            ; Pat (GhcPass 'Parsed) -> CvtM (Pat (GhcPass 'Parsed))
forall a. a -> CvtM a
forall (m :: * -> *) a. Monad m => a -> m a
return (LocatedAn NoEpAnns (HsOverLit (GhcPass 'Parsed))
-> Maybe (SyntaxExpr (GhcPass 'Parsed))
-> EpAnn [AddEpAnn]
-> Pat (GhcPass 'Parsed)
mkNPat LocatedAn NoEpAnns (HsOverLit (GhcPass 'Parsed))
l'' Maybe NoExtField
Maybe (SyntaxExpr (GhcPass 'Parsed))
forall a. Maybe a
Nothing EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn) }
                                  -- Not right for negative patterns;
                                  -- need to think about that!
  | Bool
otherwise          = do { HsLit (GhcPass 'Parsed)
l' <- Lit -> CvtM (HsLit (GhcPass 'Parsed))
cvtLit Lit
l; Pat (GhcPass 'Parsed) -> CvtM (Pat (GhcPass 'Parsed))
forall a. a -> CvtM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Pat (GhcPass 'Parsed) -> CvtM (Pat (GhcPass 'Parsed)))
-> Pat (GhcPass 'Parsed) -> CvtM (Pat (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ XLitPat (GhcPass 'Parsed)
-> HsLit (GhcPass 'Parsed) -> Pat (GhcPass 'Parsed)
forall p. XLitPat p -> HsLit p -> Pat p
Hs.LitPat XLitPat (GhcPass 'Parsed)
NoExtField
noExtField HsLit (GhcPass 'Parsed)
l' }
cvtp (TH.VarP Name
s)       = do { RdrName
s' <- Name -> CvtM RdrName
vName Name
s
                            ; (GenLocated SrcSpanAnnN RdrName -> Pat (GhcPass 'Parsed))
-> RdrName -> CvtM (Pat (GhcPass 'Parsed))
forall ann a b. (LocatedAn ann a -> b) -> a -> CvtM b
wrapParLA (XVarPat (GhcPass 'Parsed)
-> LIdP (GhcPass 'Parsed) -> Pat (GhcPass 'Parsed)
forall p. XVarPat p -> LIdP p -> Pat p
Hs.VarPat XVarPat (GhcPass 'Parsed)
NoExtField
noExtField) RdrName
s' }
cvtp (TupP [Pat]
ps)         = do { [GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))]
ps' <- [Pat] -> CvtM [LPat (GhcPass 'Parsed)]
cvtPats [Pat]
ps
                            ; Pat (GhcPass 'Parsed) -> CvtM (Pat (GhcPass 'Parsed))
forall a. a -> CvtM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Pat (GhcPass 'Parsed) -> CvtM (Pat (GhcPass 'Parsed)))
-> Pat (GhcPass 'Parsed) -> CvtM (Pat (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ XTuplePat (GhcPass 'Parsed)
-> [LPat (GhcPass 'Parsed)] -> Boxity -> Pat (GhcPass 'Parsed)
forall p. XTuplePat p -> [LPat p] -> Boxity -> Pat p
TuplePat XTuplePat (GhcPass 'Parsed)
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn [LPat (GhcPass 'Parsed)]
[GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))]
ps' Boxity
Boxed }
cvtp (UnboxedTupP [Pat]
ps)  = do { [GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))]
ps' <- [Pat] -> CvtM [LPat (GhcPass 'Parsed)]
cvtPats [Pat]
ps
                            ; Pat (GhcPass 'Parsed) -> CvtM (Pat (GhcPass 'Parsed))
forall a. a -> CvtM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Pat (GhcPass 'Parsed) -> CvtM (Pat (GhcPass 'Parsed)))
-> Pat (GhcPass 'Parsed) -> CvtM (Pat (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ XTuplePat (GhcPass 'Parsed)
-> [LPat (GhcPass 'Parsed)] -> Boxity -> Pat (GhcPass 'Parsed)
forall p. XTuplePat p -> [LPat p] -> Boxity -> Pat p
TuplePat XTuplePat (GhcPass 'Parsed)
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn [LPat (GhcPass 'Parsed)]
[GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))]
ps' Boxity
Unboxed }
cvtp (UnboxedSumP Pat
p Int
alt Int
arity)
                       = do { GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
p' <- Pat -> CvtM (LPat (GhcPass 'Parsed))
cvtPat Pat
p
                            ; Int -> Int -> CvtM ()
unboxedSumChecks Int
alt Int
arity
                            ; Pat (GhcPass 'Parsed) -> CvtM (Pat (GhcPass 'Parsed))
forall a. a -> CvtM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Pat (GhcPass 'Parsed) -> CvtM (Pat (GhcPass 'Parsed)))
-> Pat (GhcPass 'Parsed) -> CvtM (Pat (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ XSumPat (GhcPass 'Parsed)
-> LPat (GhcPass 'Parsed) -> Int -> Int -> Pat (GhcPass 'Parsed)
forall p. XSumPat p -> LPat p -> Int -> Int -> Pat p
SumPat XSumPat (GhcPass 'Parsed)
EpAnn EpAnnSumPat
forall a. EpAnn a
noAnn LPat (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
p' Int
alt Int
arity }
cvtp (ConP Name
s [Type]
ts [Pat]
ps)    = do { GenLocated SrcSpanAnnN RdrName
s' <- Name -> CvtM (GenLocated SrcSpanAnnN RdrName)
cNameN Name
s
                            ; [GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))]
ps' <- [Pat] -> CvtM [LPat (GhcPass 'Parsed)]
cvtPats [Pat]
ps
                            ; [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
ts' <- (Type -> CvtM (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))))
-> [Type]
-> CvtM [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Type -> CvtM (LHsType (GhcPass 'Parsed))
Type -> CvtM (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
cvtType [Type]
ts
                            ; let pps :: [GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))]
pps = (GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
 -> GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed)))
-> [GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))]
-> [GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))]
forall a b. (a -> b) -> [a] -> [b]
map (PprPrec -> LPat (GhcPass 'Parsed) -> LPat (GhcPass 'Parsed)
forall (p :: Pass).
IsPass p =>
PprPrec -> LPat (GhcPass p) -> LPat (GhcPass p)
parenthesizePat PprPrec
appPrec) [GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))]
ps'
                            ; Pat (GhcPass 'Parsed) -> CvtM (Pat (GhcPass 'Parsed))
forall a. a -> CvtM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Pat (GhcPass 'Parsed) -> CvtM (Pat (GhcPass 'Parsed)))
-> Pat (GhcPass 'Parsed) -> CvtM (Pat (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ ConPat
                                { pat_con_ext :: XConPat (GhcPass 'Parsed)
pat_con_ext = XConPat (GhcPass 'Parsed)
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn
                                , pat_con :: XRec (GhcPass 'Parsed) (ConLikeP (GhcPass 'Parsed))
pat_con = XRec (GhcPass 'Parsed) (ConLikeP (GhcPass 'Parsed))
GenLocated SrcSpanAnnN RdrName
s'
                                , pat_args :: HsConPatDetails (GhcPass 'Parsed)
pat_args = [HsPatSigType (GhcPass 'Parsed)]
-> [GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))]
-> HsConDetails
     (HsPatSigType (GhcPass 'Parsed))
     (GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed)))
     (HsRecFields
        (GhcPass 'Parsed) (GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))))
forall tyarg arg rec.
[tyarg] -> [arg] -> HsConDetails tyarg arg rec
PrefixCon ((GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
 -> HsPatSigType (GhcPass 'Parsed))
-> [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
-> [HsPatSigType (GhcPass 'Parsed)]
forall a b. (a -> b) -> [a] -> [b]
map (EpAnn EpaLocation
-> LHsType (GhcPass 'Parsed) -> HsPatSigType (GhcPass 'Parsed)
mkHsPatSigType EpAnn EpaLocation
forall a. EpAnn a
noAnn) [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
ts') [GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))]
pps
                                }
                            }
cvtp (InfixP Pat
p1 Name
s Pat
p2)  = do { GenLocated SrcSpanAnnN RdrName
s' <- Name -> CvtM (GenLocated SrcSpanAnnN RdrName)
cNameN Name
s; GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
p1' <- Pat -> CvtM (LPat (GhcPass 'Parsed))
cvtPat Pat
p1; GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
p2' <- Pat -> CvtM (LPat (GhcPass 'Parsed))
cvtPat Pat
p2
                            ; (GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
 -> Pat (GhcPass 'Parsed))
-> Pat (GhcPass 'Parsed) -> CvtM (Pat (GhcPass 'Parsed))
forall ann a b. (LocatedAn ann a -> b) -> a -> CvtM b
wrapParLA LPat (GhcPass 'Parsed) -> Pat (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
-> Pat (GhcPass 'Parsed)
forall (pass :: Pass). LPat (GhcPass pass) -> Pat (GhcPass pass)
gParPat (Pat (GhcPass 'Parsed) -> CvtM (Pat (GhcPass 'Parsed)))
-> Pat (GhcPass 'Parsed) -> CvtM (Pat (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$
                              ConPat
                                { pat_con_ext :: XConPat (GhcPass 'Parsed)
pat_con_ext = XConPat (GhcPass 'Parsed)
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn
                                , pat_con :: XRec (GhcPass 'Parsed) (ConLikeP (GhcPass 'Parsed))
pat_con = XRec (GhcPass 'Parsed) (ConLikeP (GhcPass 'Parsed))
GenLocated SrcSpanAnnN RdrName
s'
                                , pat_args :: HsConPatDetails (GhcPass 'Parsed)
pat_args = GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
-> GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
-> HsConDetails
     (HsPatSigType (GhcPass 'Parsed))
     (GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed)))
     (HsRecFields
        (GhcPass 'Parsed) (GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))))
forall tyarg arg rec. arg -> arg -> HsConDetails tyarg arg rec
InfixCon
                                    (PprPrec -> LPat (GhcPass 'Parsed) -> LPat (GhcPass 'Parsed)
forall (p :: Pass).
IsPass p =>
PprPrec -> LPat (GhcPass p) -> LPat (GhcPass p)
parenthesizePat PprPrec
opPrec LPat (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
p1')
                                    (PprPrec -> LPat (GhcPass 'Parsed) -> LPat (GhcPass 'Parsed)
forall (p :: Pass).
IsPass p =>
PprPrec -> LPat (GhcPass p) -> LPat (GhcPass p)
parenthesizePat PprPrec
opPrec LPat (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
p2')
                                }
                            }
                            -- See Note [Operator association]
cvtp (UInfixP Pat
p1 Name
s Pat
p2) = do { GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
p1' <- Pat -> CvtM (LPat (GhcPass 'Parsed))
cvtPat Pat
p1; LPat (GhcPass 'Parsed)
-> Name -> Pat -> CvtM (Pat (GhcPass 'Parsed))
cvtOpAppP LPat (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
p1' Name
s Pat
p2 } -- Note [Converting UInfix]
cvtp (ParensP Pat
p)       = do { GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
p' <- Pat -> CvtM (LPat (GhcPass 'Parsed))
cvtPat Pat
p;
                            ; case GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
-> Pat (GhcPass 'Parsed)
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
p' of  -- may be wrapped ConPatIn
                                ParPat {} -> Pat (GhcPass 'Parsed) -> CvtM (Pat (GhcPass 'Parsed))
forall a. a -> CvtM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Pat (GhcPass 'Parsed) -> CvtM (Pat (GhcPass 'Parsed)))
-> Pat (GhcPass 'Parsed) -> CvtM (Pat (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
-> Pat (GhcPass 'Parsed)
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
p'
                                Pat (GhcPass 'Parsed)
_         -> Pat (GhcPass 'Parsed) -> CvtM (Pat (GhcPass 'Parsed))
forall a. a -> CvtM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Pat (GhcPass 'Parsed) -> CvtM (Pat (GhcPass 'Parsed)))
-> Pat (GhcPass 'Parsed) -> CvtM (Pat (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ LPat (GhcPass 'Parsed) -> Pat (GhcPass 'Parsed)
forall (pass :: Pass). LPat (GhcPass pass) -> Pat (GhcPass pass)
gParPat LPat (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
p' }
cvtp (TildeP Pat
p)        = do { GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
p' <- Pat -> CvtM (LPat (GhcPass 'Parsed))
cvtPat Pat
p; Pat (GhcPass 'Parsed) -> CvtM (Pat (GhcPass 'Parsed))
forall a. a -> CvtM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Pat (GhcPass 'Parsed) -> CvtM (Pat (GhcPass 'Parsed)))
-> Pat (GhcPass 'Parsed) -> CvtM (Pat (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ XLazyPat (GhcPass 'Parsed)
-> LPat (GhcPass 'Parsed) -> Pat (GhcPass 'Parsed)
forall p. XLazyPat p -> LPat p -> Pat p
LazyPat XLazyPat (GhcPass 'Parsed)
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn LPat (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
p' }
cvtp (BangP Pat
p)         = do { GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
p' <- Pat -> CvtM (LPat (GhcPass 'Parsed))
cvtPat Pat
p; Pat (GhcPass 'Parsed) -> CvtM (Pat (GhcPass 'Parsed))
forall a. a -> CvtM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Pat (GhcPass 'Parsed) -> CvtM (Pat (GhcPass 'Parsed)))
-> Pat (GhcPass 'Parsed) -> CvtM (Pat (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ XBangPat (GhcPass 'Parsed)
-> LPat (GhcPass 'Parsed) -> Pat (GhcPass 'Parsed)
forall p. XBangPat p -> LPat p -> Pat p
BangPat XBangPat (GhcPass 'Parsed)
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn LPat (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
p' }
cvtp (TH.AsP Name
s Pat
p)      = do { GenLocated SrcSpanAnnN RdrName
s' <- Name -> CvtM (GenLocated SrcSpanAnnN RdrName)
vNameN Name
s; GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
p' <- Pat -> CvtM (LPat (GhcPass 'Parsed))
cvtPat Pat
p
                            ; Pat (GhcPass 'Parsed) -> CvtM (Pat (GhcPass 'Parsed))
forall a. a -> CvtM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Pat (GhcPass 'Parsed) -> CvtM (Pat (GhcPass 'Parsed)))
-> Pat (GhcPass 'Parsed) -> CvtM (Pat (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ XAsPat (GhcPass 'Parsed)
-> LIdP (GhcPass 'Parsed)
-> LPat (GhcPass 'Parsed)
-> Pat (GhcPass 'Parsed)
forall p. XAsPat p -> LIdP p -> LPat p -> Pat p
AsPat XAsPat (GhcPass 'Parsed)
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn LIdP (GhcPass 'Parsed)
GenLocated SrcSpanAnnN RdrName
s' LPat (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
p' }
cvtp Pat
TH.WildP          = Pat (GhcPass 'Parsed) -> CvtM (Pat (GhcPass 'Parsed))
forall a. a -> CvtM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Pat (GhcPass 'Parsed) -> CvtM (Pat (GhcPass 'Parsed)))
-> Pat (GhcPass 'Parsed) -> CvtM (Pat (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ XWildPat (GhcPass 'Parsed) -> Pat (GhcPass 'Parsed)
forall p. XWildPat p -> Pat p
WildPat XWildPat (GhcPass 'Parsed)
NoExtField
noExtField
cvtp (RecP Name
c [FieldPat]
fs)       = do { GenLocated SrcSpanAnnN RdrName
c' <- Name -> CvtM (GenLocated SrcSpanAnnN RdrName)
cNameN Name
c; [GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass 'Parsed)))
      (GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))))]
fs' <- (FieldPat
 -> CvtM
      (GenLocated
         SrcSpanAnnA
         (HsFieldBind
            (GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass 'Parsed)))
            (GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))))))
-> [FieldPat]
-> CvtM
     [GenLocated
        SrcSpanAnnA
        (HsFieldBind
           (GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass 'Parsed)))
           (GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM FieldPat
-> CvtM (LHsRecField (GhcPass 'Parsed) (LPat (GhcPass 'Parsed)))
FieldPat
-> CvtM
     (GenLocated
        SrcSpanAnnA
        (HsFieldBind
           (GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass 'Parsed)))
           (GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed)))))
cvtPatFld [FieldPat]
fs
                            ; Pat (GhcPass 'Parsed) -> CvtM (Pat (GhcPass 'Parsed))
forall a. a -> CvtM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Pat (GhcPass 'Parsed) -> CvtM (Pat (GhcPass 'Parsed)))
-> Pat (GhcPass 'Parsed) -> CvtM (Pat (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ ConPat
                                { pat_con_ext :: XConPat (GhcPass 'Parsed)
pat_con_ext = XConPat (GhcPass 'Parsed)
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn
                                , pat_con :: XRec (GhcPass 'Parsed) (ConLikeP (GhcPass 'Parsed))
pat_con = XRec (GhcPass 'Parsed) (ConLikeP (GhcPass 'Parsed))
GenLocated SrcSpanAnnN RdrName
c'
                                , pat_args :: HsConPatDetails (GhcPass 'Parsed)
pat_args = HsRecFields (GhcPass 'Parsed) (LPat (GhcPass 'Parsed))
-> HsConPatDetails (GhcPass 'Parsed)
forall tyarg arg rec. rec -> HsConDetails tyarg arg rec
Hs.RecCon (HsRecFields (GhcPass 'Parsed) (LPat (GhcPass 'Parsed))
 -> HsConPatDetails (GhcPass 'Parsed))
-> HsRecFields (GhcPass 'Parsed) (LPat (GhcPass 'Parsed))
-> HsConPatDetails (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$ [LHsRecField
   (GhcPass 'Parsed) (GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed)))]
-> Maybe (Located Int)
-> HsRecFields
     (GhcPass 'Parsed) (GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed)))
forall p arg.
[LHsRecField p arg] -> Maybe (Located Int) -> HsRecFields p arg
HsRecFields [LHsRecField
   (GhcPass 'Parsed) (GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed)))]
[GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass 'Parsed)))
      (GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))))]
fs' Maybe (Located Int)
forall a. Maybe a
Nothing
                                }
                            }
cvtp (ListP [Pat]
ps)        = do { [GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))]
ps' <- [Pat] -> CvtM [LPat (GhcPass 'Parsed)]
cvtPats [Pat]
ps
                            ; Pat (GhcPass 'Parsed) -> CvtM (Pat (GhcPass 'Parsed))
forall a. a -> CvtM a
forall (m :: * -> *) a. Monad m => a -> m a
return
                                   (Pat (GhcPass 'Parsed) -> CvtM (Pat (GhcPass 'Parsed)))
-> Pat (GhcPass 'Parsed) -> CvtM (Pat (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ XListPat (GhcPass 'Parsed)
-> [LPat (GhcPass 'Parsed)] -> Pat (GhcPass 'Parsed)
forall p. XListPat p -> [LPat p] -> Pat p
ListPat XListPat (GhcPass 'Parsed)
EpAnn AnnList
forall a. EpAnn a
noAnn [LPat (GhcPass 'Parsed)]
[GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))]
ps'}
cvtp (SigP Pat
p Type
t)        = do { GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
p' <- Pat -> CvtM (LPat (GhcPass 'Parsed))
cvtPat Pat
p; GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
t' <- Type -> CvtM (LHsType (GhcPass 'Parsed))
cvtType Type
t
                            ; Pat (GhcPass 'Parsed) -> CvtM (Pat (GhcPass 'Parsed))
forall a. a -> CvtM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Pat (GhcPass 'Parsed) -> CvtM (Pat (GhcPass 'Parsed)))
-> Pat (GhcPass 'Parsed) -> CvtM (Pat (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ XSigPat (GhcPass 'Parsed)
-> LPat (GhcPass 'Parsed)
-> HsPatSigType (NoGhcTc (GhcPass 'Parsed))
-> Pat (GhcPass 'Parsed)
forall p. XSigPat p -> LPat p -> HsPatSigType (NoGhcTc p) -> Pat p
SigPat XSigPat (GhcPass 'Parsed)
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn LPat (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
p' (EpAnn EpaLocation
-> LHsType (GhcPass 'Parsed) -> HsPatSigType (GhcPass 'Parsed)
mkHsPatSigType EpAnn EpaLocation
forall a. EpAnn a
noAnn LHsType (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
t') }
cvtp (ViewP Exp
e Pat
p)       = do { LocatedA (HsExpr (GhcPass 'Parsed))
e' <- Exp -> CvtM (LHsExpr (GhcPass 'Parsed))
cvtl Exp
e; GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
p' <- Pat -> CvtM (LPat (GhcPass 'Parsed))
cvtPat Pat
p
                            ; Pat (GhcPass 'Parsed) -> CvtM (Pat (GhcPass 'Parsed))
forall a. a -> CvtM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Pat (GhcPass 'Parsed) -> CvtM (Pat (GhcPass 'Parsed)))
-> Pat (GhcPass 'Parsed) -> CvtM (Pat (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ XViewPat (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> LPat (GhcPass 'Parsed)
-> Pat (GhcPass 'Parsed)
forall p. XViewPat p -> LHsExpr p -> LPat p -> Pat p
ViewPat XViewPat (GhcPass 'Parsed)
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
e' LPat (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
p'}

cvtPatFld :: (TH.Name, TH.Pat) -> CvtM (LHsRecField GhcPs (LPat GhcPs))
cvtPatFld :: FieldPat
-> CvtM (LHsRecField (GhcPass 'Parsed) (LPat (GhcPass 'Parsed)))
cvtPatFld (Name
s,Pat
p)
  = do  { L SrcSpanAnnN
ls RdrName
s' <- Name -> CvtM (GenLocated SrcSpanAnnN RdrName)
vNameN Name
s
        ; GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
p' <- Pat -> CvtM (LPat (GhcPass 'Parsed))
cvtPat Pat
p
        ; HsFieldBind
  (GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass 'Parsed)))
  (GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed)))
-> CvtM
     (GenLocated
        SrcSpanAnnA
        (HsFieldBind
           (GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass 'Parsed)))
           (GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed)))))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (HsFieldBind
   (GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass 'Parsed)))
   (GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed)))
 -> CvtM
      (GenLocated
         SrcSpanAnnA
         (HsFieldBind
            (GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass 'Parsed)))
            (GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))))))
-> HsFieldBind
     (GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass 'Parsed)))
     (GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed)))
-> CvtM
     (GenLocated
        SrcSpanAnnA
        (HsFieldBind
           (GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass 'Parsed)))
           (GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed)))))
forall a b. (a -> b) -> a -> b
$ HsFieldBind { hfbAnn :: XHsFieldBind
  (GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass 'Parsed)))
hfbAnn = XHsFieldBind
  (GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass 'Parsed)))
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn
                                 , hfbLHS :: GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass 'Parsed))
hfbLHS
                                    = SrcAnn NoEpAnns
-> FieldOcc (GhcPass 'Parsed)
-> GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass 'Parsed))
forall l e. l -> e -> GenLocated l e
L (SrcSpanAnnN -> SrcAnn NoEpAnns
forall a ann. SrcSpanAnn' a -> SrcAnn ann
l2l SrcSpanAnnN
ls) (FieldOcc (GhcPass 'Parsed)
 -> GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass 'Parsed)))
-> FieldOcc (GhcPass 'Parsed)
-> GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnN RdrName -> FieldOcc (GhcPass 'Parsed)
mkFieldOcc (SrcSpanAnnN -> RdrName -> GenLocated SrcSpanAnnN RdrName
forall l e. l -> e -> GenLocated l e
L (SrcSpanAnnN -> SrcSpanAnnN
forall a ann. SrcSpanAnn' a -> SrcAnn ann
l2l SrcSpanAnnN
ls) RdrName
s')
                                 , hfbRHS :: GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
hfbRHS = GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
p'
                                 , hfbPun :: Bool
hfbPun = Bool
False} }

{- | @cvtOpAppP x op y@ converts @op@ and @y@ and produces the operator application @x `op` y@.
The produced tree of infix patterns will be left-biased, provided @x@ is.

See the @cvtOpApp@ documentation for how this function works.
-}
cvtOpAppP :: Hs.LPat GhcPs -> TH.Name -> TH.Pat -> CvtM (Hs.Pat GhcPs)
cvtOpAppP :: LPat (GhcPass 'Parsed)
-> Name -> Pat -> CvtM (Pat (GhcPass 'Parsed))
cvtOpAppP LPat (GhcPass 'Parsed)
x Name
op1 (UInfixP Pat
y Name
op2 Pat
z)
  = do { GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
l <- CvtM (Pat (GhcPass 'Parsed))
-> CvtM (GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed)))
forall a. CvtM a -> CvtM (LocatedA a)
wrapLA (CvtM (Pat (GhcPass 'Parsed))
 -> CvtM (GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))))
-> CvtM (Pat (GhcPass 'Parsed))
-> CvtM (GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed)))
forall a b. (a -> b) -> a -> b
$ LPat (GhcPass 'Parsed)
-> Name -> Pat -> CvtM (Pat (GhcPass 'Parsed))
cvtOpAppP LPat (GhcPass 'Parsed)
x Name
op1 Pat
y
       ; LPat (GhcPass 'Parsed)
-> Name -> Pat -> CvtM (Pat (GhcPass 'Parsed))
cvtOpAppP LPat (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
l Name
op2 Pat
z }
cvtOpAppP LPat (GhcPass 'Parsed)
x Name
op Pat
y
  = do { GenLocated SrcSpanAnnN RdrName
op' <- Name -> CvtM (GenLocated SrcSpanAnnN RdrName)
cNameN Name
op
       ; GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
y' <- Pat -> CvtM (LPat (GhcPass 'Parsed))
cvtPat Pat
y
       ; Pat (GhcPass 'Parsed) -> CvtM (Pat (GhcPass 'Parsed))
forall a. a -> CvtM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Pat (GhcPass 'Parsed) -> CvtM (Pat (GhcPass 'Parsed)))
-> Pat (GhcPass 'Parsed) -> CvtM (Pat (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ ConPat
          { pat_con_ext :: XConPat (GhcPass 'Parsed)
pat_con_ext = XConPat (GhcPass 'Parsed)
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn
          , pat_con :: XRec (GhcPass 'Parsed) (ConLikeP (GhcPass 'Parsed))
pat_con = XRec (GhcPass 'Parsed) (ConLikeP (GhcPass 'Parsed))
GenLocated SrcSpanAnnN RdrName
op'
          , pat_args :: HsConPatDetails (GhcPass 'Parsed)
pat_args = GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
-> GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
-> HsConDetails
     (HsPatSigType (GhcPass 'Parsed))
     (GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed)))
     (HsRecFields
        (GhcPass 'Parsed) (GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))))
forall tyarg arg rec. arg -> arg -> HsConDetails tyarg arg rec
InfixCon LPat (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
x GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
y'
          }
       }

-----------------------------------------------------------
--      Types and type variables

class CvtFlag flag flag' | flag -> flag' where
  cvtFlag :: flag -> flag'

instance CvtFlag () () where
  cvtFlag :: () -> ()
cvtFlag () = ()

instance CvtFlag TH.Specificity Hs.Specificity where
  cvtFlag :: Specificity -> Specificity
cvtFlag Specificity
TH.SpecifiedSpec = Specificity
Hs.SpecifiedSpec
  cvtFlag Specificity
TH.InferredSpec  = Specificity
Hs.InferredSpec

cvtTvs :: CvtFlag flag flag' => [TH.TyVarBndr flag] -> CvtM [LHsTyVarBndr flag' GhcPs]
cvtTvs :: forall flag flag'.
CvtFlag flag flag' =>
[TyVarBndr flag] -> CvtM [LHsTyVarBndr flag' (GhcPass 'Parsed)]
cvtTvs [TyVarBndr flag]
tvs = (TyVarBndr flag
 -> CvtM
      (GenLocated SrcSpanAnnA (HsTyVarBndr flag' (GhcPass 'Parsed))))
-> [TyVarBndr flag]
-> CvtM
     [GenLocated SrcSpanAnnA (HsTyVarBndr flag' (GhcPass 'Parsed))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM TyVarBndr flag
-> CvtM
     (XRec (GhcPass 'Parsed) (HsTyVarBndr flag' (GhcPass 'Parsed)))
TyVarBndr flag
-> CvtM
     (GenLocated SrcSpanAnnA (HsTyVarBndr flag' (GhcPass 'Parsed)))
forall flag flag'.
CvtFlag flag flag' =>
TyVarBndr flag -> CvtM (LHsTyVarBndr flag' (GhcPass 'Parsed))
cvt_tv [TyVarBndr flag]
tvs

cvt_tv :: CvtFlag flag flag' => (TH.TyVarBndr flag) -> CvtM (LHsTyVarBndr flag' GhcPs)
cvt_tv :: forall flag flag'.
CvtFlag flag flag' =>
TyVarBndr flag -> CvtM (LHsTyVarBndr flag' (GhcPass 'Parsed))
cvt_tv (TH.PlainTV Name
nm flag
fl)
  = do { GenLocated SrcSpanAnnN RdrName
nm' <- Name -> CvtM (GenLocated SrcSpanAnnN RdrName)
tNameN Name
nm
       ; let fl' :: flag'
fl' = flag -> flag'
forall flag flag'. CvtFlag flag flag' => flag -> flag'
cvtFlag flag
fl
       ; HsTyVarBndr flag' (GhcPass 'Parsed)
-> CvtM
     (LocatedAn AnnListItem (HsTyVarBndr flag' (GhcPass 'Parsed)))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (HsTyVarBndr flag' (GhcPass 'Parsed)
 -> CvtM
      (LocatedAn AnnListItem (HsTyVarBndr flag' (GhcPass 'Parsed))))
-> HsTyVarBndr flag' (GhcPass 'Parsed)
-> CvtM
     (LocatedAn AnnListItem (HsTyVarBndr flag' (GhcPass 'Parsed)))
forall a b. (a -> b) -> a -> b
$ XUserTyVar (GhcPass 'Parsed)
-> flag'
-> LIdP (GhcPass 'Parsed)
-> HsTyVarBndr flag' (GhcPass 'Parsed)
forall flag pass.
XUserTyVar pass -> flag -> LIdP pass -> HsTyVarBndr flag pass
UserTyVar XUserTyVar (GhcPass 'Parsed)
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn flag'
fl' LIdP (GhcPass 'Parsed)
GenLocated SrcSpanAnnN RdrName
nm' }
cvt_tv (TH.KindedTV Name
nm flag
fl Type
ki)
  = do { GenLocated SrcSpanAnnN RdrName
nm' <- Name -> CvtM (GenLocated SrcSpanAnnN RdrName)
tNameN Name
nm
       ; let fl' :: flag'
fl' = flag -> flag'
forall flag flag'. CvtFlag flag flag' => flag -> flag'
cvtFlag flag
fl
       ; GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
ki' <- Type -> CvtM (LHsType (GhcPass 'Parsed))
cvtKind Type
ki
       ; HsTyVarBndr flag' (GhcPass 'Parsed)
-> CvtM
     (LocatedAn AnnListItem (HsTyVarBndr flag' (GhcPass 'Parsed)))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (HsTyVarBndr flag' (GhcPass 'Parsed)
 -> CvtM
      (LocatedAn AnnListItem (HsTyVarBndr flag' (GhcPass 'Parsed))))
-> HsTyVarBndr flag' (GhcPass 'Parsed)
-> CvtM
     (LocatedAn AnnListItem (HsTyVarBndr flag' (GhcPass 'Parsed)))
forall a b. (a -> b) -> a -> b
$ XKindedTyVar (GhcPass 'Parsed)
-> flag'
-> LIdP (GhcPass 'Parsed)
-> LHsType (GhcPass 'Parsed)
-> HsTyVarBndr flag' (GhcPass 'Parsed)
forall flag pass.
XKindedTyVar pass
-> flag -> LIdP pass -> LHsKind pass -> HsTyVarBndr flag pass
KindedTyVar XKindedTyVar (GhcPass 'Parsed)
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn flag'
fl' LIdP (GhcPass 'Parsed)
GenLocated SrcSpanAnnN RdrName
nm' LHsType (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
ki' }

cvtRole :: TH.Role -> Maybe Coercion.Role
cvtRole :: Role -> Maybe Role
cvtRole Role
TH.NominalR          = Role -> Maybe Role
forall a. a -> Maybe a
Just Role
Coercion.Nominal
cvtRole Role
TH.RepresentationalR = Role -> Maybe Role
forall a. a -> Maybe a
Just Role
Coercion.Representational
cvtRole Role
TH.PhantomR          = Role -> Maybe Role
forall a. a -> Maybe a
Just Role
Coercion.Phantom
cvtRole Role
TH.InferR            = Maybe Role
forall a. Maybe a
Nothing

cvtContext :: PprPrec -> TH.Cxt -> CvtM (LHsContext GhcPs)
cvtContext :: PprPrec -> [Type] -> CvtM (LHsContext (GhcPass 'Parsed))
cvtContext PprPrec
p [Type]
tys = do { [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
preds' <- (Type -> CvtM (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))))
-> [Type]
-> CvtM [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Type -> CvtM (LHsType (GhcPass 'Parsed))
Type -> CvtM (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
cvtPred [Type]
tys
                      ; PprPrec
-> LHsContext (GhcPass 'Parsed) -> LHsContext (GhcPass 'Parsed)
forall (p :: Pass).
PprPrec -> LHsContext (GhcPass p) -> LHsContext (GhcPass p)
parenthesizeHsContext PprPrec
p (GenLocated
   SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
 -> GenLocated
      SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))])
-> CvtM
     (GenLocated
        SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))])
-> CvtM
     (GenLocated
        SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
-> CvtM
     (GenLocated
        SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))])
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
preds' }

cvtPred :: TH.Pred -> CvtM (LHsType GhcPs)
cvtPred :: Type -> CvtM (LHsType (GhcPass 'Parsed))
cvtPred = Type -> CvtM (LHsType (GhcPass 'Parsed))
cvtType

cvtDerivClauseTys :: TH.Cxt -> CvtM (LDerivClauseTys GhcPs)
cvtDerivClauseTys :: [Type] -> CvtM (LDerivClauseTys (GhcPass 'Parsed))
cvtDerivClauseTys [Type]
tys
  = do { [GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Parsed))]
tys' <- (Type
 -> CvtM (GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Parsed))))
-> [Type]
-> CvtM [GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Parsed))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Type -> CvtM (LHsSigType (GhcPass 'Parsed))
Type -> CvtM (GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Parsed)))
cvtSigType [Type]
tys
         -- Since TH.Cxt doesn't indicate the presence or absence of
         -- parentheses in a deriving clause, we have to choose between
         -- DctSingle and DctMulti somewhat arbitrarily. We opt to use DctMulti
         -- unless the TH.Cxt is a singleton list whose type is a bare type
         -- constructor with no arguments.
       ; case [GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Parsed))]
tys' of
           [ty' :: GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Parsed))
ty'@(L SrcSpanAnnA
l (HsSig { sig_bndrs :: forall pass. HsSigType pass -> HsOuterSigTyVarBndrs pass
sig_bndrs = HsOuterImplicit{}
                            , sig_body :: forall pass. HsSigType pass -> LHsType pass
sig_body  = L SrcSpanAnnA
_ (HsTyVar XTyVar (GhcPass 'Parsed)
_ PromotionFlag
NotPromoted LIdP (GhcPass 'Parsed)
_) }))]
                 -> GenLocated SrcSpanAnnC (DerivClauseTys (GhcPass 'Parsed))
-> CvtM (GenLocated SrcSpanAnnC (DerivClauseTys (GhcPass 'Parsed)))
forall a. a -> CvtM a
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnC (DerivClauseTys (GhcPass 'Parsed))
 -> CvtM
      (GenLocated SrcSpanAnnC (DerivClauseTys (GhcPass 'Parsed))))
-> GenLocated SrcSpanAnnC (DerivClauseTys (GhcPass 'Parsed))
-> CvtM (GenLocated SrcSpanAnnC (DerivClauseTys (GhcPass 'Parsed)))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnC
-> DerivClauseTys (GhcPass 'Parsed)
-> GenLocated SrcSpanAnnC (DerivClauseTys (GhcPass 'Parsed))
forall l e. l -> e -> GenLocated l e
L (SrcSpanAnnA -> SrcSpanAnnC
forall a ann. SrcSpanAnn' a -> SrcAnn ann
l2l SrcSpanAnnA
l) (DerivClauseTys (GhcPass 'Parsed)
 -> GenLocated SrcSpanAnnC (DerivClauseTys (GhcPass 'Parsed)))
-> DerivClauseTys (GhcPass 'Parsed)
-> GenLocated SrcSpanAnnC (DerivClauseTys (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ XDctSingle (GhcPass 'Parsed)
-> LHsSigType (GhcPass 'Parsed) -> DerivClauseTys (GhcPass 'Parsed)
forall pass.
XDctSingle pass -> LHsSigType pass -> DerivClauseTys pass
DctSingle XDctSingle (GhcPass 'Parsed)
NoExtField
noExtField LHsSigType (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Parsed))
ty'
           [GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Parsed))]
_     -> DerivClauseTys (GhcPass 'Parsed)
-> CvtM (GenLocated SrcSpanAnnC (DerivClauseTys (GhcPass 'Parsed)))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (DerivClauseTys (GhcPass 'Parsed)
 -> CvtM
      (GenLocated SrcSpanAnnC (DerivClauseTys (GhcPass 'Parsed))))
-> DerivClauseTys (GhcPass 'Parsed)
-> CvtM (GenLocated SrcSpanAnnC (DerivClauseTys (GhcPass 'Parsed)))
forall a b. (a -> b) -> a -> b
$ XDctMulti (GhcPass 'Parsed)
-> [LHsSigType (GhcPass 'Parsed)]
-> DerivClauseTys (GhcPass 'Parsed)
forall pass.
XDctMulti pass -> [LHsSigType pass] -> DerivClauseTys pass
DctMulti XDctMulti (GhcPass 'Parsed)
NoExtField
noExtField [LHsSigType (GhcPass 'Parsed)]
[GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Parsed))]
tys' }

cvtDerivClause :: TH.DerivClause
               -> CvtM (LHsDerivingClause GhcPs)
cvtDerivClause :: DerivClause -> CvtM (LHsDerivingClause (GhcPass 'Parsed))
cvtDerivClause (TH.DerivClause Maybe DerivStrategy
ds [Type]
tys)
  = do { GenLocated SrcSpanAnnC (DerivClauseTys (GhcPass 'Parsed))
tys' <- [Type] -> CvtM (LDerivClauseTys (GhcPass 'Parsed))
cvtDerivClauseTys [Type]
tys
       ; Maybe
  (GenLocated (SrcAnn NoEpAnns) (DerivStrategy (GhcPass 'Parsed)))
ds'  <- (DerivStrategy
 -> CvtM
      (GenLocated (SrcAnn NoEpAnns) (DerivStrategy (GhcPass 'Parsed))))
-> Maybe DerivStrategy
-> CvtM
     (Maybe
        (GenLocated (SrcAnn NoEpAnns) (DerivStrategy (GhcPass 'Parsed))))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse DerivStrategy -> CvtM (LDerivStrategy (GhcPass 'Parsed))
DerivStrategy
-> CvtM
     (GenLocated (SrcAnn NoEpAnns) (DerivStrategy (GhcPass 'Parsed)))
cvtDerivStrategy Maybe DerivStrategy
ds
       ; HsDerivingClause (GhcPass 'Parsed)
-> CvtM
     (GenLocated (SrcAnn NoEpAnns) (HsDerivingClause (GhcPass 'Parsed)))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (HsDerivingClause (GhcPass 'Parsed)
 -> CvtM
      (GenLocated
         (SrcAnn NoEpAnns) (HsDerivingClause (GhcPass 'Parsed))))
-> HsDerivingClause (GhcPass 'Parsed)
-> CvtM
     (GenLocated (SrcAnn NoEpAnns) (HsDerivingClause (GhcPass 'Parsed)))
forall a b. (a -> b) -> a -> b
$ XCHsDerivingClause (GhcPass 'Parsed)
-> Maybe (LDerivStrategy (GhcPass 'Parsed))
-> LDerivClauseTys (GhcPass 'Parsed)
-> HsDerivingClause (GhcPass 'Parsed)
forall pass.
XCHsDerivingClause pass
-> Maybe (LDerivStrategy pass)
-> LDerivClauseTys pass
-> HsDerivingClause pass
HsDerivingClause XCHsDerivingClause (GhcPass 'Parsed)
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn Maybe (LDerivStrategy (GhcPass 'Parsed))
Maybe
  (GenLocated (SrcAnn NoEpAnns) (DerivStrategy (GhcPass 'Parsed)))
ds' LDerivClauseTys (GhcPass 'Parsed)
GenLocated SrcSpanAnnC (DerivClauseTys (GhcPass 'Parsed))
tys' }

cvtDerivStrategy :: TH.DerivStrategy -> CvtM (Hs.LDerivStrategy GhcPs)
cvtDerivStrategy :: DerivStrategy -> CvtM (LDerivStrategy (GhcPass 'Parsed))
cvtDerivStrategy DerivStrategy
TH.StockStrategy    = DerivStrategy (GhcPass 'Parsed)
-> CvtM
     (GenLocated (SrcAnn NoEpAnns) (DerivStrategy (GhcPass 'Parsed)))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (XStockStrategy (GhcPass 'Parsed) -> DerivStrategy (GhcPass 'Parsed)
forall pass. XStockStrategy pass -> DerivStrategy pass
Hs.StockStrategy XStockStrategy (GhcPass 'Parsed)
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn)
cvtDerivStrategy DerivStrategy
TH.AnyclassStrategy = DerivStrategy (GhcPass 'Parsed)
-> CvtM
     (GenLocated (SrcAnn NoEpAnns) (DerivStrategy (GhcPass 'Parsed)))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (XAnyClassStrategy (GhcPass 'Parsed)
-> DerivStrategy (GhcPass 'Parsed)
forall pass. XAnyClassStrategy pass -> DerivStrategy pass
Hs.AnyclassStrategy XAnyClassStrategy (GhcPass 'Parsed)
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn)
cvtDerivStrategy DerivStrategy
TH.NewtypeStrategy  = DerivStrategy (GhcPass 'Parsed)
-> CvtM
     (GenLocated (SrcAnn NoEpAnns) (DerivStrategy (GhcPass 'Parsed)))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (XNewtypeStrategy (GhcPass 'Parsed)
-> DerivStrategy (GhcPass 'Parsed)
forall pass. XNewtypeStrategy pass -> DerivStrategy pass
Hs.NewtypeStrategy XNewtypeStrategy (GhcPass 'Parsed)
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn)
cvtDerivStrategy (TH.ViaStrategy Type
ty) = do
  GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Parsed))
ty' <- Type -> CvtM (LHsSigType (GhcPass 'Parsed))
cvtSigType Type
ty
  DerivStrategy (GhcPass 'Parsed)
-> CvtM
     (GenLocated (SrcAnn NoEpAnns) (DerivStrategy (GhcPass 'Parsed)))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (DerivStrategy (GhcPass 'Parsed)
 -> CvtM
      (GenLocated (SrcAnn NoEpAnns) (DerivStrategy (GhcPass 'Parsed))))
-> DerivStrategy (GhcPass 'Parsed)
-> CvtM
     (GenLocated (SrcAnn NoEpAnns) (DerivStrategy (GhcPass 'Parsed)))
forall a b. (a -> b) -> a -> b
$ XViaStrategy (GhcPass 'Parsed) -> DerivStrategy (GhcPass 'Parsed)
forall pass. XViaStrategy pass -> DerivStrategy pass
Hs.ViaStrategy (EpAnn [AddEpAnn] -> LHsSigType (GhcPass 'Parsed) -> XViaStrategyPs
XViaStrategyPs EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn LHsSigType (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Parsed))
ty')

cvtType :: TH.Type -> CvtM (LHsType GhcPs)
cvtType :: Type -> CvtM (LHsType (GhcPass 'Parsed))
cvtType = String -> Type -> CvtM (LHsType (GhcPass 'Parsed))
cvtTypeKind String
"type"

cvtSigType :: TH.Type -> CvtM (LHsSigType GhcPs)
cvtSigType :: Type -> CvtM (LHsSigType (GhcPass 'Parsed))
cvtSigType = String -> Type -> CvtM (LHsSigType (GhcPass 'Parsed))
cvtSigTypeKind String
"type"

-- | Convert a Template Haskell 'Type' to an 'LHsSigType'. To avoid duplicating
-- the logic in 'cvtTypeKind' here, we simply reuse 'cvtTypeKind' and perform
-- surgery on the 'LHsType' it returns to turn it into an 'LHsSigType'.
cvtSigTypeKind :: String -> TH.Type -> CvtM (LHsSigType GhcPs)
cvtSigTypeKind :: String -> Type -> CvtM (LHsSigType (GhcPass 'Parsed))
cvtSigTypeKind String
ty_str Type
ty = do
  GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
ty' <- String -> Type -> CvtM (LHsType (GhcPass 'Parsed))
cvtTypeKind String
ty_str Type
ty
  GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Parsed))
-> CvtM (GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Parsed)))
forall a. a -> CvtM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Parsed))
 -> CvtM (GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Parsed))))
-> GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Parsed))
-> CvtM (GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Parsed)))
forall a b. (a -> b) -> a -> b
$ LHsType (GhcPass 'Parsed) -> LHsSigType (GhcPass 'Parsed)
hsTypeToHsSigType (LHsType (GhcPass 'Parsed) -> LHsSigType (GhcPass 'Parsed))
-> LHsType (GhcPass 'Parsed) -> LHsSigType (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$ PprPrec -> LHsType (GhcPass 'Parsed) -> LHsType (GhcPass 'Parsed)
forall (p :: Pass).
PprPrec -> LHsType (GhcPass p) -> LHsType (GhcPass p)
parenthesizeHsType PprPrec
sigPrec LHsType (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
ty'

cvtTypeKind :: String -> TH.Type -> CvtM (LHsType GhcPs)
cvtTypeKind :: String -> Type -> CvtM (LHsType (GhcPass 'Parsed))
cvtTypeKind String
ty_str Type
ty
  = do { (Type
head_ty, [HsArg
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))]
tys') <- Type -> CvtM (Type, HsTyPats (GhcPass 'Parsed))
split_ty_app Type
ty
       ; let m_normals :: Maybe [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
m_normals = (HsArg
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
 -> Maybe (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))))
-> [HsArg
      (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
      (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))]
-> Maybe [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM HsArg
  (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
  (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
-> Maybe (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
forall {a} {ty}. HsArg a ty -> Maybe a
extract_normal [HsArg
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))]
tys'
                                where extract_normal :: HsArg a ty -> Maybe a
extract_normal (HsValArg a
ty) = a -> Maybe a
forall a. a -> Maybe a
Just a
ty
                                      extract_normal HsArg a ty
_ = Maybe a
forall a. Maybe a
Nothing

       ; case Type
head_ty of
           TupleT Int
n
            | Just [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
normals <- Maybe [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
m_normals
            , [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
normals [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))] -> Int -> Bool
forall a. [a] -> Int -> Bool
`lengthIs` Int
n         -- Saturated
            -> HsType (GhcPass 'Parsed)
-> CvtM (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (XTupleTy (GhcPass 'Parsed)
-> HsTupleSort
-> [LHsType (GhcPass 'Parsed)]
-> HsType (GhcPass 'Parsed)
forall pass.
XTupleTy pass -> HsTupleSort -> [LHsType pass] -> HsType pass
HsTupleTy XTupleTy (GhcPass 'Parsed)
EpAnn AnnParen
forall a. EpAnn a
noAnn HsTupleSort
HsBoxedOrConstraintTuple [LHsType (GhcPass 'Parsed)]
[GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
normals)
            | Bool
otherwise
            -> do { GenLocated SrcSpanAnnN RdrName
tuple_tc <- RdrName -> CvtM (GenLocated SrcSpanAnnN RdrName)
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (RdrName -> CvtM (GenLocated SrcSpanAnnN RdrName))
-> RdrName -> CvtM (GenLocated SrcSpanAnnN RdrName)
forall a b. (a -> b) -> a -> b
$ TyCon -> RdrName
forall thing. NamedThing thing => thing -> RdrName
getRdrName (TyCon -> RdrName) -> TyCon -> RdrName
forall a b. (a -> b) -> a -> b
$ Boxity -> Int -> TyCon
tupleTyCon Boxity
Boxed Int
n
                  ; HsType (GhcPass 'Parsed)
-> HsTyPats (GhcPass 'Parsed) -> CvtM (LHsType (GhcPass 'Parsed))
mk_apps (XTyVar (GhcPass 'Parsed)
-> PromotionFlag
-> LIdP (GhcPass 'Parsed)
-> HsType (GhcPass 'Parsed)
forall pass.
XTyVar pass -> PromotionFlag -> LIdP pass -> HsType pass
HsTyVar XTyVar (GhcPass 'Parsed)
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn PromotionFlag
NotPromoted LIdP (GhcPass 'Parsed)
GenLocated SrcSpanAnnN RdrName
tuple_tc) HsTyPats (GhcPass 'Parsed)
[HsArg
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))]
tys' }
           UnboxedTupleT Int
n
             | Just [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
normals <- Maybe [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
m_normals
             , [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
normals [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))] -> Int -> Bool
forall a. [a] -> Int -> Bool
`lengthIs` Int
n               -- Saturated
             -> HsType (GhcPass 'Parsed)
-> CvtM (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (XTupleTy (GhcPass 'Parsed)
-> HsTupleSort
-> [LHsType (GhcPass 'Parsed)]
-> HsType (GhcPass 'Parsed)
forall pass.
XTupleTy pass -> HsTupleSort -> [LHsType pass] -> HsType pass
HsTupleTy XTupleTy (GhcPass 'Parsed)
EpAnn AnnParen
forall a. EpAnn a
noAnn HsTupleSort
HsUnboxedTuple [LHsType (GhcPass 'Parsed)]
[GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
normals)
             | Bool
otherwise
             -> do { GenLocated SrcSpanAnnN RdrName
tuple_tc <- RdrName -> CvtM (GenLocated SrcSpanAnnN RdrName)
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (RdrName -> CvtM (GenLocated SrcSpanAnnN RdrName))
-> RdrName -> CvtM (GenLocated SrcSpanAnnN RdrName)
forall a b. (a -> b) -> a -> b
$ TyCon -> RdrName
forall thing. NamedThing thing => thing -> RdrName
getRdrName (TyCon -> RdrName) -> TyCon -> RdrName
forall a b. (a -> b) -> a -> b
$ Boxity -> Int -> TyCon
tupleTyCon Boxity
Unboxed Int
n
                   ; HsType (GhcPass 'Parsed)
-> HsTyPats (GhcPass 'Parsed) -> CvtM (LHsType (GhcPass 'Parsed))
mk_apps (XTyVar (GhcPass 'Parsed)
-> PromotionFlag
-> LIdP (GhcPass 'Parsed)
-> HsType (GhcPass 'Parsed)
forall pass.
XTyVar pass -> PromotionFlag -> LIdP pass -> HsType pass
HsTyVar XTyVar (GhcPass 'Parsed)
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn PromotionFlag
NotPromoted LIdP (GhcPass 'Parsed)
GenLocated SrcSpanAnnN RdrName
tuple_tc) HsTyPats (GhcPass 'Parsed)
[HsArg
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))]
tys' }
           UnboxedSumT Int
n
             | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2
            -> SDoc -> CvtM (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
forall a. SDoc -> CvtM a
failWith (SDoc -> CvtM (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))))
-> SDoc -> CvtM (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
forall a b. (a -> b) -> a -> b
$
                   [SDoc] -> SDoc
vcat [ String -> SDoc
text String
"Illegal sum arity:" SDoc -> SDoc -> SDoc
<+> String -> SDoc
text (Int -> String
forall a. Show a => a -> String
show Int
n)
                        , Int -> SDoc -> SDoc
nest Int
2 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
                            String -> SDoc
text String
"Sums must have an arity of at least 2" ]
             | Just [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
normals <- Maybe [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
m_normals
             , [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
normals [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))] -> Int -> Bool
forall a. [a] -> Int -> Bool
`lengthIs` Int
n -- Saturated
             -> HsType (GhcPass 'Parsed)
-> CvtM (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (XSumTy (GhcPass 'Parsed)
-> [LHsType (GhcPass 'Parsed)] -> HsType (GhcPass 'Parsed)
forall pass. XSumTy pass -> [LHsType pass] -> HsType pass
HsSumTy XSumTy (GhcPass 'Parsed)
EpAnn AnnParen
forall a. EpAnn a
noAnn [LHsType (GhcPass 'Parsed)]
[GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
normals)
             | Bool
otherwise
             -> do { GenLocated SrcSpanAnnN RdrName
sum_tc <- RdrName -> CvtM (GenLocated SrcSpanAnnN RdrName)
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (RdrName -> CvtM (GenLocated SrcSpanAnnN RdrName))
-> RdrName -> CvtM (GenLocated SrcSpanAnnN RdrName)
forall a b. (a -> b) -> a -> b
$ TyCon -> RdrName
forall thing. NamedThing thing => thing -> RdrName
getRdrName (TyCon -> RdrName) -> TyCon -> RdrName
forall a b. (a -> b) -> a -> b
$ Int -> TyCon
sumTyCon Int
n
                   ; HsType (GhcPass 'Parsed)
-> HsTyPats (GhcPass 'Parsed) -> CvtM (LHsType (GhcPass 'Parsed))
mk_apps (XTyVar (GhcPass 'Parsed)
-> PromotionFlag
-> LIdP (GhcPass 'Parsed)
-> HsType (GhcPass 'Parsed)
forall pass.
XTyVar pass -> PromotionFlag -> LIdP pass -> HsType pass
HsTyVar XTyVar (GhcPass 'Parsed)
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn PromotionFlag
NotPromoted LIdP (GhcPass 'Parsed)
GenLocated SrcSpanAnnN RdrName
sum_tc) HsTyPats (GhcPass 'Parsed)
[HsArg
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))]
tys' }
           Type
ArrowT
             | Just [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
normals <- Maybe [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
m_normals
             , [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
x',GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
y'] <- [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
normals -> do
                 GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
x'' <- case GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
-> HsType (GhcPass 'Parsed)
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
x' of
                          HsFunTy{}    -> HsType (GhcPass 'Parsed)
-> CvtM (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (XParTy (GhcPass 'Parsed)
-> LHsType (GhcPass 'Parsed) -> HsType (GhcPass 'Parsed)
forall pass. XParTy pass -> LHsType pass -> HsType pass
HsParTy XParTy (GhcPass 'Parsed)
EpAnn AnnParen
forall a. EpAnn a
noAnn LHsType (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
x')
                          HsForAllTy{} -> HsType (GhcPass 'Parsed)
-> CvtM (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (XParTy (GhcPass 'Parsed)
-> LHsType (GhcPass 'Parsed) -> HsType (GhcPass 'Parsed)
forall pass. XParTy pass -> LHsType pass -> HsType pass
HsParTy XParTy (GhcPass 'Parsed)
EpAnn AnnParen
forall a. EpAnn a
noAnn LHsType (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
x') -- #14646
                          HsQualTy{}   -> HsType (GhcPass 'Parsed)
-> CvtM (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (XParTy (GhcPass 'Parsed)
-> LHsType (GhcPass 'Parsed) -> HsType (GhcPass 'Parsed)
forall pass. XParTy pass -> LHsType pass -> HsType pass
HsParTy XParTy (GhcPass 'Parsed)
EpAnn AnnParen
forall a. EpAnn a
noAnn LHsType (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
x') -- #15324
                          HsType (GhcPass 'Parsed)
_            -> GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
-> CvtM (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
forall a. a -> CvtM a
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
 -> CvtM (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))))
-> GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
-> CvtM (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
forall a b. (a -> b) -> a -> b
$
                                          PprPrec -> LHsType (GhcPass 'Parsed) -> LHsType (GhcPass 'Parsed)
forall (p :: Pass).
PprPrec -> LHsType (GhcPass p) -> LHsType (GhcPass p)
parenthesizeHsType PprPrec
sigPrec LHsType (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
x'
                 let y'' :: LHsType (GhcPass 'Parsed)
y'' = PprPrec -> LHsType (GhcPass 'Parsed) -> LHsType (GhcPass 'Parsed)
forall (p :: Pass).
PprPrec -> LHsType (GhcPass p) -> LHsType (GhcPass p)
parenthesizeHsType PprPrec
sigPrec LHsType (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
y'
                 HsType (GhcPass 'Parsed)
-> CvtM (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (XFunTy (GhcPass 'Parsed)
-> HsArrow (GhcPass 'Parsed)
-> LHsType (GhcPass 'Parsed)
-> LHsType (GhcPass 'Parsed)
-> HsType (GhcPass 'Parsed)
forall pass.
XFunTy pass
-> HsArrow pass -> LHsType pass -> LHsType pass -> HsType pass
HsFunTy XFunTy (GhcPass 'Parsed)
EpAnnCO
forall a. EpAnn a
noAnn (LHsUniToken "->" "\8594" (GhcPass 'Parsed)
-> HsArrow (GhcPass 'Parsed)
forall pass. LHsUniToken "->" "\8594" pass -> HsArrow pass
HsUnrestrictedArrow LHsUniToken "->" "\8594" (GhcPass 'Parsed)
GenLocated TokenLocation (HsUniToken "->" "\8594")
forall (tok :: Symbol) (utok :: Symbol).
GenLocated TokenLocation (HsUniToken tok utok)
noHsUniTok) LHsType (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
x'' LHsType (GhcPass 'Parsed)
y'')
             | Bool
otherwise
             -> do { GenLocated SrcSpanAnnN RdrName
fun_tc <- RdrName -> CvtM (GenLocated SrcSpanAnnN RdrName)
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (RdrName -> CvtM (GenLocated SrcSpanAnnN RdrName))
-> RdrName -> CvtM (GenLocated SrcSpanAnnN RdrName)
forall a b. (a -> b) -> a -> b
$ TyCon -> RdrName
forall thing. NamedThing thing => thing -> RdrName
getRdrName TyCon
unrestrictedFunTyCon
                   ; HsType (GhcPass 'Parsed)
-> HsTyPats (GhcPass 'Parsed) -> CvtM (LHsType (GhcPass 'Parsed))
mk_apps (XTyVar (GhcPass 'Parsed)
-> PromotionFlag
-> LIdP (GhcPass 'Parsed)
-> HsType (GhcPass 'Parsed)
forall pass.
XTyVar pass -> PromotionFlag -> LIdP pass -> HsType pass
HsTyVar XTyVar (GhcPass 'Parsed)
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn PromotionFlag
NotPromoted LIdP (GhcPass 'Parsed)
GenLocated SrcSpanAnnN RdrName
fun_tc) HsTyPats (GhcPass 'Parsed)
[HsArg
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))]
tys' }
           Type
MulArrowT
             | Just [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
normals <- Maybe [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
m_normals
             , [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
w',GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
x',GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
y'] <- [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
normals -> do
                 GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
x'' <- case GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
-> HsType (GhcPass 'Parsed)
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
x' of
                          HsFunTy{}    -> HsType (GhcPass 'Parsed)
-> CvtM (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (XParTy (GhcPass 'Parsed)
-> LHsType (GhcPass 'Parsed) -> HsType (GhcPass 'Parsed)
forall pass. XParTy pass -> LHsType pass -> HsType pass
HsParTy XParTy (GhcPass 'Parsed)
EpAnn AnnParen
forall a. EpAnn a
noAnn LHsType (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
x')
                          HsForAllTy{} -> HsType (GhcPass 'Parsed)
-> CvtM (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (XParTy (GhcPass 'Parsed)
-> LHsType (GhcPass 'Parsed) -> HsType (GhcPass 'Parsed)
forall pass. XParTy pass -> LHsType pass -> HsType pass
HsParTy XParTy (GhcPass 'Parsed)
EpAnn AnnParen
forall a. EpAnn a
noAnn LHsType (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
x') -- #14646
                          HsQualTy{}   -> HsType (GhcPass 'Parsed)
-> CvtM (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (XParTy (GhcPass 'Parsed)
-> LHsType (GhcPass 'Parsed) -> HsType (GhcPass 'Parsed)
forall pass. XParTy pass -> LHsType pass -> HsType pass
HsParTy XParTy (GhcPass 'Parsed)
EpAnn AnnParen
forall a. EpAnn a
noAnn LHsType (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
x') -- #15324
                          HsType (GhcPass 'Parsed)
_            -> GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
-> CvtM (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
forall a. a -> CvtM a
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
 -> CvtM (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))))
-> GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
-> CvtM (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
forall a b. (a -> b) -> a -> b
$
                                          PprPrec -> LHsType (GhcPass 'Parsed) -> LHsType (GhcPass 'Parsed)
forall (p :: Pass).
PprPrec -> LHsType (GhcPass p) -> LHsType (GhcPass p)
parenthesizeHsType PprPrec
sigPrec LHsType (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
x'
                 let y'' :: LHsType (GhcPass 'Parsed)
y'' = PprPrec -> LHsType (GhcPass 'Parsed) -> LHsType (GhcPass 'Parsed)
forall (p :: Pass).
PprPrec -> LHsType (GhcPass p) -> LHsType (GhcPass p)
parenthesizeHsType PprPrec
sigPrec LHsType (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
y'
                     w'' :: HsArrow (GhcPass 'Parsed)
w'' = LHsType (GhcPass 'Parsed) -> HsArrow (GhcPass 'Parsed)
hsTypeToArrow LHsType (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
w'
                 HsType (GhcPass 'Parsed)
-> CvtM (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (XFunTy (GhcPass 'Parsed)
-> HsArrow (GhcPass 'Parsed)
-> LHsType (GhcPass 'Parsed)
-> LHsType (GhcPass 'Parsed)
-> HsType (GhcPass 'Parsed)
forall pass.
XFunTy pass
-> HsArrow pass -> LHsType pass -> LHsType pass -> HsType pass
HsFunTy XFunTy (GhcPass 'Parsed)
EpAnnCO
forall a. EpAnn a
noAnn HsArrow (GhcPass 'Parsed)
w'' LHsType (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
x'' LHsType (GhcPass 'Parsed)
y'')
             | Bool
otherwise
             -> do { GenLocated SrcSpanAnnN RdrName
fun_tc <- RdrName -> CvtM (GenLocated SrcSpanAnnN RdrName)
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (RdrName -> CvtM (GenLocated SrcSpanAnnN RdrName))
-> RdrName -> CvtM (GenLocated SrcSpanAnnN RdrName)
forall a b. (a -> b) -> a -> b
$ TyCon -> RdrName
forall thing. NamedThing thing => thing -> RdrName
getRdrName TyCon
funTyCon
                   ; HsType (GhcPass 'Parsed)
-> HsTyPats (GhcPass 'Parsed) -> CvtM (LHsType (GhcPass 'Parsed))
mk_apps (XTyVar (GhcPass 'Parsed)
-> PromotionFlag
-> LIdP (GhcPass 'Parsed)
-> HsType (GhcPass 'Parsed)
forall pass.
XTyVar pass -> PromotionFlag -> LIdP pass -> HsType pass
HsTyVar XTyVar (GhcPass 'Parsed)
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn PromotionFlag
NotPromoted LIdP (GhcPass 'Parsed)
GenLocated SrcSpanAnnN RdrName
fun_tc) HsTyPats (GhcPass 'Parsed)
[HsArg
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))]
tys' }
           Type
ListT
             | Just [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
normals <- Maybe [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
m_normals
             , [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
x'] <- [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
normals ->
                HsType (GhcPass 'Parsed)
-> CvtM (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (XListTy (GhcPass 'Parsed)
-> LHsType (GhcPass 'Parsed) -> HsType (GhcPass 'Parsed)
forall pass. XListTy pass -> LHsType pass -> HsType pass
HsListTy XListTy (GhcPass 'Parsed)
EpAnn AnnParen
forall a. EpAnn a
noAnn LHsType (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
x')
             | Bool
otherwise
             -> do { GenLocated SrcSpanAnnN RdrName
list_tc <- RdrName -> CvtM (GenLocated SrcSpanAnnN RdrName)
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (RdrName -> CvtM (GenLocated SrcSpanAnnN RdrName))
-> RdrName -> CvtM (GenLocated SrcSpanAnnN RdrName)
forall a b. (a -> b) -> a -> b
$ TyCon -> RdrName
forall thing. NamedThing thing => thing -> RdrName
getRdrName TyCon
listTyCon
                   ; HsType (GhcPass 'Parsed)
-> HsTyPats (GhcPass 'Parsed) -> CvtM (LHsType (GhcPass 'Parsed))
mk_apps (XTyVar (GhcPass 'Parsed)
-> PromotionFlag
-> LIdP (GhcPass 'Parsed)
-> HsType (GhcPass 'Parsed)
forall pass.
XTyVar pass -> PromotionFlag -> LIdP pass -> HsType pass
HsTyVar XTyVar (GhcPass 'Parsed)
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn PromotionFlag
NotPromoted LIdP (GhcPass 'Parsed)
GenLocated SrcSpanAnnN RdrName
list_tc) HsTyPats (GhcPass 'Parsed)
[HsArg
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))]
tys' }

           VarT Name
nm -> do { GenLocated SrcSpanAnnN RdrName
nm' <- Name -> CvtM (GenLocated SrcSpanAnnN RdrName)
tNameN Name
nm
                         ; HsType (GhcPass 'Parsed)
-> HsTyPats (GhcPass 'Parsed) -> CvtM (LHsType (GhcPass 'Parsed))
mk_apps (XTyVar (GhcPass 'Parsed)
-> PromotionFlag
-> LIdP (GhcPass 'Parsed)
-> HsType (GhcPass 'Parsed)
forall pass.
XTyVar pass -> PromotionFlag -> LIdP pass -> HsType pass
HsTyVar XTyVar (GhcPass 'Parsed)
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn PromotionFlag
NotPromoted LIdP (GhcPass 'Parsed)
GenLocated SrcSpanAnnN RdrName
nm') HsTyPats (GhcPass 'Parsed)
[HsArg
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))]
tys' }
           ConT Name
nm -> do { RdrName
nm' <- Name -> CvtM RdrName
tconName Name
nm
                         ; let prom :: PromotionFlag
prom = RdrName -> PromotionFlag
name_promotedness RdrName
nm'
                         ; GenLocated SrcSpanAnnN RdrName
lnm' <- RdrName -> CvtM (GenLocated SrcSpanAnnN RdrName)
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA RdrName
nm'
                         ; HsType (GhcPass 'Parsed)
-> HsTyPats (GhcPass 'Parsed) -> CvtM (LHsType (GhcPass 'Parsed))
mk_apps (XTyVar (GhcPass 'Parsed)
-> PromotionFlag
-> LIdP (GhcPass 'Parsed)
-> HsType (GhcPass 'Parsed)
forall pass.
XTyVar pass -> PromotionFlag -> LIdP pass -> HsType pass
HsTyVar XTyVar (GhcPass 'Parsed)
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn PromotionFlag
prom LIdP (GhcPass 'Parsed)
GenLocated SrcSpanAnnN RdrName
lnm') HsTyPats (GhcPass 'Parsed)
[HsArg
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))]
tys'}

           ForallT [TyVarBndr Specificity]
tvs [Type]
cxt Type
ty
             | [HsArg
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))]
-> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [HsArg
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))]
tys'
             -> do { [GenLocated
   SrcSpanAnnA (HsTyVarBndr Specificity (GhcPass 'Parsed))]
tvs' <- [TyVarBndr Specificity]
-> CvtM [LHsTyVarBndr Specificity (GhcPass 'Parsed)]
forall flag flag'.
CvtFlag flag flag' =>
[TyVarBndr flag] -> CvtM [LHsTyVarBndr flag' (GhcPass 'Parsed)]
cvtTvs [TyVarBndr Specificity]
tvs
                   ; GenLocated
  SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
cxt' <- PprPrec -> [Type] -> CvtM (LHsContext (GhcPass 'Parsed))
cvtContext PprPrec
funPrec [Type]
cxt
                   ; GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
ty'  <- Type -> CvtM (LHsType (GhcPass 'Parsed))
cvtType Type
ty
                   ; SrcSpan
loc <- CvtM SrcSpan
getL
                   ; let loc' :: SrcSpanAnnA
loc' = SrcSpan -> SrcSpanAnnA
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
loc
                   ; let tele :: HsForAllTelescope (GhcPass 'Parsed)
tele   = EpAnnForallTy
-> [LHsTyVarBndr Specificity (GhcPass 'Parsed)]
-> HsForAllTelescope (GhcPass 'Parsed)
forall (p :: Pass).
EpAnnForallTy
-> [LHsTyVarBndr Specificity (GhcPass p)]
-> HsForAllTelescope (GhcPass p)
mkHsForAllInvisTele EpAnnForallTy
forall a. EpAnn a
noAnn [LHsTyVarBndr Specificity (GhcPass 'Parsed)]
[GenLocated
   SrcSpanAnnA (HsTyVarBndr Specificity (GhcPass 'Parsed))]
tvs'
                         hs_ty :: LHsType (GhcPass 'Parsed)
hs_ty  = SrcSpanAnnA
-> HsForAllTelescope (GhcPass 'Parsed)
-> LHsType (GhcPass 'Parsed)
-> LHsType (GhcPass 'Parsed)
mkHsForAllTy SrcSpanAnnA
loc' HsForAllTelescope (GhcPass 'Parsed)
tele LHsType (GhcPass 'Parsed)
rho_ty
                         rho_ty :: LHsType (GhcPass 'Parsed)
rho_ty = [Type]
-> SrcSpanAnnA
-> LHsContext (GhcPass 'Parsed)
-> LHsType (GhcPass 'Parsed)
-> LHsType (GhcPass 'Parsed)
mkHsQualTy [Type]
cxt SrcSpanAnnA
loc' LHsContext (GhcPass 'Parsed)
GenLocated
  SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
cxt' LHsType (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
ty'

                   ; GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
-> CvtM (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
forall a. a -> CvtM a
forall (m :: * -> *) a. Monad m => a -> m a
return LHsType (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
hs_ty }

           ForallVisT [TyVarBndr ()]
tvs Type
ty
             | [HsArg
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))]
-> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [HsArg
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))]
tys'
             -> do { [GenLocated SrcSpanAnnA (HsTyVarBndr () (GhcPass 'Parsed))]
tvs' <- [TyVarBndr ()] -> CvtM [LHsTyVarBndr () (GhcPass 'Parsed)]
forall flag flag'.
CvtFlag flag flag' =>
[TyVarBndr flag] -> CvtM [LHsTyVarBndr flag' (GhcPass 'Parsed)]
cvtTvs [TyVarBndr ()]
tvs
                   ; GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
ty'  <- Type -> CvtM (LHsType (GhcPass 'Parsed))
cvtType Type
ty
                   ; SrcSpan
loc  <- CvtM SrcSpan
getL
                   ; let loc' :: SrcSpanAnnA
loc' = SrcSpan -> SrcSpanAnnA
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
loc
                   ; let tele :: HsForAllTelescope (GhcPass 'Parsed)
tele = EpAnnForallTy
-> [LHsTyVarBndr () (GhcPass 'Parsed)]
-> HsForAllTelescope (GhcPass 'Parsed)
forall (p :: Pass).
EpAnnForallTy
-> [LHsTyVarBndr () (GhcPass p)] -> HsForAllTelescope (GhcPass p)
mkHsForAllVisTele EpAnnForallTy
forall a. EpAnn a
noAnn [LHsTyVarBndr () (GhcPass 'Parsed)]
[GenLocated SrcSpanAnnA (HsTyVarBndr () (GhcPass 'Parsed))]
tvs'
                   ; LHsType (GhcPass 'Parsed) -> CvtM (LHsType (GhcPass 'Parsed))
forall a. a -> CvtM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LHsType (GhcPass 'Parsed) -> CvtM (LHsType (GhcPass 'Parsed)))
-> LHsType (GhcPass 'Parsed) -> CvtM (LHsType (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA
-> HsForAllTelescope (GhcPass 'Parsed)
-> LHsType (GhcPass 'Parsed)
-> LHsType (GhcPass 'Parsed)
mkHsForAllTy SrcSpanAnnA
loc' HsForAllTelescope (GhcPass 'Parsed)
tele LHsType (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
ty' }

           SigT Type
ty Type
ki
             -> do { GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
ty' <- Type -> CvtM (LHsType (GhcPass 'Parsed))
cvtType Type
ty
                   ; GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
ki' <- Type -> CvtM (LHsType (GhcPass 'Parsed))
cvtKind Type
ki
                   ; HsType (GhcPass 'Parsed)
-> HsTyPats (GhcPass 'Parsed) -> CvtM (LHsType (GhcPass 'Parsed))
mk_apps (XKindSig (GhcPass 'Parsed)
-> LHsType (GhcPass 'Parsed)
-> LHsType (GhcPass 'Parsed)
-> HsType (GhcPass 'Parsed)
forall pass.
XKindSig pass -> LHsType pass -> LHsType pass -> HsType pass
HsKindSig XKindSig (GhcPass 'Parsed)
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn LHsType (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
ty' LHsType (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
ki') HsTyPats (GhcPass 'Parsed)
[HsArg
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))]
tys'
                   }

           LitT TyLit
lit
             -> HsType (GhcPass 'Parsed)
-> HsTyPats (GhcPass 'Parsed) -> CvtM (LHsType (GhcPass 'Parsed))
mk_apps (XTyLit (GhcPass 'Parsed) -> HsTyLit -> HsType (GhcPass 'Parsed)
forall pass. XTyLit pass -> HsTyLit -> HsType pass
HsTyLit XTyLit (GhcPass 'Parsed)
NoExtField
noExtField (TyLit -> HsTyLit
cvtTyLit TyLit
lit)) HsTyPats (GhcPass 'Parsed)
[HsArg
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))]
tys'

           Type
WildCardT
             -> HsType (GhcPass 'Parsed)
-> HsTyPats (GhcPass 'Parsed) -> CvtM (LHsType (GhcPass 'Parsed))
mk_apps HsType (GhcPass 'Parsed)
mkAnonWildCardTy HsTyPats (GhcPass 'Parsed)
[HsArg
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))]
tys'

           InfixT Type
t1 Name
s Type
t2
             -> do { RdrName
s'  <- Name -> CvtM RdrName
tconName Name
s
                   ; GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
t1' <- Type -> CvtM (LHsType (GhcPass 'Parsed))
cvtType Type
t1
                   ; GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
t2' <- Type -> CvtM (LHsType (GhcPass 'Parsed))
cvtType Type
t2
                   ; let prom :: PromotionFlag
prom = RdrName -> PromotionFlag
name_promotedness RdrName
s'
                   ; GenLocated SrcSpanAnnN RdrName
ls' <- RdrName -> CvtM (GenLocated SrcSpanAnnN RdrName)
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA RdrName
s'
                   ; HsType (GhcPass 'Parsed)
-> HsTyPats (GhcPass 'Parsed) -> CvtM (LHsType (GhcPass 'Parsed))
mk_apps
                      (XTyVar (GhcPass 'Parsed)
-> PromotionFlag
-> LIdP (GhcPass 'Parsed)
-> HsType (GhcPass 'Parsed)
forall pass.
XTyVar pass -> PromotionFlag -> LIdP pass -> HsType pass
HsTyVar XTyVar (GhcPass 'Parsed)
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn PromotionFlag
prom LIdP (GhcPass 'Parsed)
GenLocated SrcSpanAnnN RdrName
ls')
                      ([GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
-> HsArg
     (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
     (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
forall tm ty. tm -> HsArg tm ty
HsValArg GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
t1', GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
-> HsArg
     (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
     (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
forall tm ty. tm -> HsArg tm ty
HsValArg GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
t2'] [HsArg
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))]
-> [HsArg
      (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
      (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))]
-> [HsArg
      (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
      (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))]
forall a. [a] -> [a] -> [a]
++ [HsArg
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))]
tys')
                   }

           UInfixT Type
t1 Name
s Type
t2
             -> do { GenLocated SrcSpanAnnN RdrName
s' <- Name -> CvtM (GenLocated SrcSpanAnnN RdrName)
tconNameN Name
s
                   ; GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
t2' <- Type -> CvtM (LHsType (GhcPass 'Parsed))
cvtType Type
t2
                   ; GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
t <- PromotionFlag
-> Type
-> GenLocated SrcSpanAnnN RdrName
-> LHsType (GhcPass 'Parsed)
-> CvtM (LHsType (GhcPass 'Parsed))
cvtOpAppT PromotionFlag
NotPromoted Type
t1 GenLocated SrcSpanAnnN RdrName
s' LHsType (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
t2'
                   ; HsType (GhcPass 'Parsed)
-> HsTyPats (GhcPass 'Parsed) -> CvtM (LHsType (GhcPass 'Parsed))
mk_apps (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
-> HsType (GhcPass 'Parsed)
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
t) HsTyPats (GhcPass 'Parsed)
[HsArg
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))]
tys'
                   } -- Note [Converting UInfix]

           PromotedInfixT Type
t1 Name
s Type
t2
             -> do { GenLocated SrcSpanAnnN RdrName
s'  <- Name -> CvtM (GenLocated SrcSpanAnnN RdrName)
cNameN Name
s
                   ; GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
t1' <- Type -> CvtM (LHsType (GhcPass 'Parsed))
cvtType Type
t1
                   ; GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
t2' <- Type -> CvtM (LHsType (GhcPass 'Parsed))
cvtType Type
t2
                   ; HsType (GhcPass 'Parsed)
-> HsTyPats (GhcPass 'Parsed) -> CvtM (LHsType (GhcPass 'Parsed))
mk_apps
                      (XTyVar (GhcPass 'Parsed)
-> PromotionFlag
-> LIdP (GhcPass 'Parsed)
-> HsType (GhcPass 'Parsed)
forall pass.
XTyVar pass -> PromotionFlag -> LIdP pass -> HsType pass
HsTyVar XTyVar (GhcPass 'Parsed)
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn PromotionFlag
IsPromoted LIdP (GhcPass 'Parsed)
GenLocated SrcSpanAnnN RdrName
s')
                      ([GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
-> HsArg
     (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
     (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
forall tm ty. tm -> HsArg tm ty
HsValArg GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
t1', GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
-> HsArg
     (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
     (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
forall tm ty. tm -> HsArg tm ty
HsValArg GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
t2'] [HsArg
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))]
-> [HsArg
      (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
      (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))]
-> [HsArg
      (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
      (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))]
forall a. [a] -> [a] -> [a]
++ [HsArg
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))]
tys')
                   }

           PromotedUInfixT Type
t1 Name
s Type
t2
             -> do { GenLocated SrcSpanAnnN RdrName
s' <- Name -> CvtM (GenLocated SrcSpanAnnN RdrName)
cNameN Name
s
                   ; GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
t2' <- Type -> CvtM (LHsType (GhcPass 'Parsed))
cvtType Type
t2
                   ; GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
t <- PromotionFlag
-> Type
-> GenLocated SrcSpanAnnN RdrName
-> LHsType (GhcPass 'Parsed)
-> CvtM (LHsType (GhcPass 'Parsed))
cvtOpAppT PromotionFlag
IsPromoted Type
t1 GenLocated SrcSpanAnnN RdrName
s' LHsType (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
t2'
                   ; HsType (GhcPass 'Parsed)
-> HsTyPats (GhcPass 'Parsed) -> CvtM (LHsType (GhcPass 'Parsed))
mk_apps (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
-> HsType (GhcPass 'Parsed)
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
t) HsTyPats (GhcPass 'Parsed)
[HsArg
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))]
tys'
                   } -- Note [Converting UInfix]

           ParensT Type
t
             -> do { GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
t' <- Type -> CvtM (LHsType (GhcPass 'Parsed))
cvtType Type
t
                   ; HsType (GhcPass 'Parsed)
-> HsTyPats (GhcPass 'Parsed) -> CvtM (LHsType (GhcPass 'Parsed))
mk_apps (XParTy (GhcPass 'Parsed)
-> LHsType (GhcPass 'Parsed) -> HsType (GhcPass 'Parsed)
forall pass. XParTy pass -> LHsType pass -> HsType pass
HsParTy XParTy (GhcPass 'Parsed)
EpAnn AnnParen
forall a. EpAnn a
noAnn LHsType (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
t') HsTyPats (GhcPass 'Parsed)
[HsArg
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))]
tys'
                   }

           PromotedT Name
nm -> do { GenLocated SrcSpanAnnN RdrName
nm' <- Name -> CvtM (GenLocated SrcSpanAnnN RdrName)
cNameN Name
nm
                              ; HsType (GhcPass 'Parsed)
-> HsTyPats (GhcPass 'Parsed) -> CvtM (LHsType (GhcPass 'Parsed))
mk_apps (XTyVar (GhcPass 'Parsed)
-> PromotionFlag
-> LIdP (GhcPass 'Parsed)
-> HsType (GhcPass 'Parsed)
forall pass.
XTyVar pass -> PromotionFlag -> LIdP pass -> HsType pass
HsTyVar XTyVar (GhcPass 'Parsed)
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn PromotionFlag
IsPromoted LIdP (GhcPass 'Parsed)
GenLocated SrcSpanAnnN RdrName
nm')
                                        HsTyPats (GhcPass 'Parsed)
[HsArg
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))]
tys' }
                 -- Promoted data constructor; hence cName

           PromotedTupleT Int
n
              | Just [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
normals <- Maybe [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
m_normals
              , [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
normals [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))] -> Int -> Bool
forall a. [a] -> Int -> Bool
`lengthIs` Int
n   -- Saturated
              -> HsType (GhcPass 'Parsed)
-> CvtM (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (XExplicitTupleTy (GhcPass 'Parsed)
-> [LHsType (GhcPass 'Parsed)] -> HsType (GhcPass 'Parsed)
forall pass. XExplicitTupleTy pass -> [LHsType pass] -> HsType pass
HsExplicitTupleTy XExplicitTupleTy (GhcPass 'Parsed)
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn [LHsType (GhcPass 'Parsed)]
[GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
normals)
              | Bool
otherwise
              -> do { GenLocated SrcSpanAnnN RdrName
tuple_tc <- RdrName -> CvtM (GenLocated SrcSpanAnnN RdrName)
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (RdrName -> CvtM (GenLocated SrcSpanAnnN RdrName))
-> RdrName -> CvtM (GenLocated SrcSpanAnnN RdrName)
forall a b. (a -> b) -> a -> b
$ DataCon -> RdrName
forall thing. NamedThing thing => thing -> RdrName
getRdrName (DataCon -> RdrName) -> DataCon -> RdrName
forall a b. (a -> b) -> a -> b
$ Boxity -> Int -> DataCon
tupleDataCon Boxity
Boxed Int
n
                    ; HsType (GhcPass 'Parsed)
-> HsTyPats (GhcPass 'Parsed) -> CvtM (LHsType (GhcPass 'Parsed))
mk_apps (XTyVar (GhcPass 'Parsed)
-> PromotionFlag
-> LIdP (GhcPass 'Parsed)
-> HsType (GhcPass 'Parsed)
forall pass.
XTyVar pass -> PromotionFlag -> LIdP pass -> HsType pass
HsTyVar XTyVar (GhcPass 'Parsed)
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn PromotionFlag
IsPromoted LIdP (GhcPass 'Parsed)
GenLocated SrcSpanAnnN RdrName
tuple_tc) HsTyPats (GhcPass 'Parsed)
[HsArg
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))]
tys' }

           Type
PromotedNilT
             -> HsType (GhcPass 'Parsed)
-> HsTyPats (GhcPass 'Parsed) -> CvtM (LHsType (GhcPass 'Parsed))
mk_apps (XExplicitListTy (GhcPass 'Parsed)
-> PromotionFlag
-> [LHsType (GhcPass 'Parsed)]
-> HsType (GhcPass 'Parsed)
forall pass.
XExplicitListTy pass
-> PromotionFlag -> [LHsType pass] -> HsType pass
HsExplicitListTy XExplicitListTy (GhcPass 'Parsed)
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn PromotionFlag
IsPromoted []) HsTyPats (GhcPass 'Parsed)
[HsArg
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))]
tys'

           Type
PromotedConsT  -- See Note [Representing concrete syntax in types]
                          -- in Language.Haskell.TH.Syntax
              | Just [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
normals <- Maybe [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
m_normals
              , [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
ty1, L SrcSpanAnnA
_ (HsExplicitListTy XExplicitListTy (GhcPass 'Parsed)
_ PromotionFlag
ip [LHsType (GhcPass 'Parsed)]
tys2)] <- [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
normals
              -> HsType (GhcPass 'Parsed)
-> CvtM (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (XExplicitListTy (GhcPass 'Parsed)
-> PromotionFlag
-> [LHsType (GhcPass 'Parsed)]
-> HsType (GhcPass 'Parsed)
forall pass.
XExplicitListTy pass
-> PromotionFlag -> [LHsType pass] -> HsType pass
HsExplicitListTy XExplicitListTy (GhcPass 'Parsed)
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn PromotionFlag
ip (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
ty1GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
-> [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
-> [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
forall a. a -> [a] -> [a]
:[LHsType (GhcPass 'Parsed)]
[GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
tys2))
              | Bool
otherwise
              -> do { GenLocated SrcSpanAnnN RdrName
cons_tc <- RdrName -> CvtM (GenLocated SrcSpanAnnN RdrName)
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (RdrName -> CvtM (GenLocated SrcSpanAnnN RdrName))
-> RdrName -> CvtM (GenLocated SrcSpanAnnN RdrName)
forall a b. (a -> b) -> a -> b
$ DataCon -> RdrName
forall thing. NamedThing thing => thing -> RdrName
getRdrName DataCon
consDataCon
                    ; HsType (GhcPass 'Parsed)
-> HsTyPats (GhcPass 'Parsed) -> CvtM (LHsType (GhcPass 'Parsed))
mk_apps (XTyVar (GhcPass 'Parsed)
-> PromotionFlag
-> LIdP (GhcPass 'Parsed)
-> HsType (GhcPass 'Parsed)
forall pass.
XTyVar pass -> PromotionFlag -> LIdP pass -> HsType pass
HsTyVar XTyVar (GhcPass 'Parsed)
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn PromotionFlag
IsPromoted LIdP (GhcPass 'Parsed)
GenLocated SrcSpanAnnN RdrName
cons_tc) HsTyPats (GhcPass 'Parsed)
[HsArg
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))]
tys' }

           Type
StarT
             -> do { GenLocated SrcSpanAnnN RdrName
type_tc <- RdrName -> CvtM (GenLocated SrcSpanAnnN RdrName)
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (RdrName -> CvtM (GenLocated SrcSpanAnnN RdrName))
-> RdrName -> CvtM (GenLocated SrcSpanAnnN RdrName)
forall a b. (a -> b) -> a -> b
$ TyCon -> RdrName
forall thing. NamedThing thing => thing -> RdrName
getRdrName TyCon
liftedTypeKindTyCon
                   ; HsType (GhcPass 'Parsed)
-> HsTyPats (GhcPass 'Parsed) -> CvtM (LHsType (GhcPass 'Parsed))
mk_apps (XTyVar (GhcPass 'Parsed)
-> PromotionFlag
-> LIdP (GhcPass 'Parsed)
-> HsType (GhcPass 'Parsed)
forall pass.
XTyVar pass -> PromotionFlag -> LIdP pass -> HsType pass
HsTyVar XTyVar (GhcPass 'Parsed)
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn PromotionFlag
NotPromoted LIdP (GhcPass 'Parsed)
GenLocated SrcSpanAnnN RdrName
type_tc) HsTyPats (GhcPass 'Parsed)
[HsArg
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))]
tys' }

           Type
ConstraintT
             -> do { GenLocated SrcSpanAnnN RdrName
constraint_tc <- RdrName -> CvtM (GenLocated SrcSpanAnnN RdrName)
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (RdrName -> CvtM (GenLocated SrcSpanAnnN RdrName))
-> RdrName -> CvtM (GenLocated SrcSpanAnnN RdrName)
forall a b. (a -> b) -> a -> b
$ TyCon -> RdrName
forall thing. NamedThing thing => thing -> RdrName
getRdrName TyCon
constraintKindTyCon
                   ; HsType (GhcPass 'Parsed)
-> HsTyPats (GhcPass 'Parsed) -> CvtM (LHsType (GhcPass 'Parsed))
mk_apps (XTyVar (GhcPass 'Parsed)
-> PromotionFlag
-> LIdP (GhcPass 'Parsed)
-> HsType (GhcPass 'Parsed)
forall pass.
XTyVar pass -> PromotionFlag -> LIdP pass -> HsType pass
HsTyVar XTyVar (GhcPass 'Parsed)
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn PromotionFlag
NotPromoted LIdP (GhcPass 'Parsed)
GenLocated SrcSpanAnnN RdrName
constraint_tc) HsTyPats (GhcPass 'Parsed)
[HsArg
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))]
tys' }

           Type
EqualityT
             | Just [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
normals <- Maybe [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
m_normals
             , [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
x',GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
y'] <- [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
normals ->
                   let px :: LHsType (GhcPass 'Parsed)
px = PprPrec -> LHsType (GhcPass 'Parsed) -> LHsType (GhcPass 'Parsed)
forall (p :: Pass).
PprPrec -> LHsType (GhcPass p) -> LHsType (GhcPass p)
parenthesizeHsType PprPrec
opPrec LHsType (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
x'
                       py :: LHsType (GhcPass 'Parsed)
py = PprPrec -> LHsType (GhcPass 'Parsed) -> LHsType (GhcPass 'Parsed)
forall (p :: Pass).
PprPrec -> LHsType (GhcPass p) -> LHsType (GhcPass p)
parenthesizeHsType PprPrec
opPrec LHsType (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
y'
                   in do { GenLocated SrcSpanAnnN RdrName
eq_tc <- RdrName -> CvtM (GenLocated SrcSpanAnnN RdrName)
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA RdrName
eqTyCon_RDR
                         ; HsType (GhcPass 'Parsed)
-> CvtM (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (XOpTy (GhcPass 'Parsed)
-> PromotionFlag
-> LHsType (GhcPass 'Parsed)
-> LIdP (GhcPass 'Parsed)
-> LHsType (GhcPass 'Parsed)
-> HsType (GhcPass 'Parsed)
forall pass.
XOpTy pass
-> PromotionFlag
-> LHsType pass
-> LIdP pass
-> LHsType pass
-> HsType pass
HsOpTy XOpTy (GhcPass 'Parsed)
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn PromotionFlag
NotPromoted LHsType (GhcPass 'Parsed)
px LIdP (GhcPass 'Parsed)
GenLocated SrcSpanAnnN RdrName
eq_tc LHsType (GhcPass 'Parsed)
py) }
               -- The long-term goal is to remove the above case entirely and
               -- subsume it under the case for InfixT. See #15815, comment:6,
               -- for more details.

             | Bool
otherwise ->
                   do { GenLocated SrcSpanAnnN RdrName
eq_tc <- RdrName -> CvtM (GenLocated SrcSpanAnnN RdrName)
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA RdrName
eqTyCon_RDR
                      ; HsType (GhcPass 'Parsed)
-> HsTyPats (GhcPass 'Parsed) -> CvtM (LHsType (GhcPass 'Parsed))
mk_apps (XTyVar (GhcPass 'Parsed)
-> PromotionFlag
-> LIdP (GhcPass 'Parsed)
-> HsType (GhcPass 'Parsed)
forall pass.
XTyVar pass -> PromotionFlag -> LIdP pass -> HsType pass
HsTyVar XTyVar (GhcPass 'Parsed)
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn PromotionFlag
NotPromoted LIdP (GhcPass 'Parsed)
GenLocated SrcSpanAnnN RdrName
eq_tc) HsTyPats (GhcPass 'Parsed)
[HsArg
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))]
tys' }
           ImplicitParamT String
n Type
t
             -> do { Located HsIPName
n' <- CvtM HsIPName -> CvtM (Located HsIPName)
forall a. CvtM a -> CvtM (Located a)
wrapL (CvtM HsIPName -> CvtM (Located HsIPName))
-> CvtM HsIPName -> CvtM (Located HsIPName)
forall a b. (a -> b) -> a -> b
$ String -> CvtM HsIPName
ipName String
n
                   ; GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
t' <- Type -> CvtM (LHsType (GhcPass 'Parsed))
cvtType Type
t
                   ; HsType (GhcPass 'Parsed)
-> CvtM (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (XIParamTy (GhcPass 'Parsed)
-> XRec (GhcPass 'Parsed) HsIPName
-> LHsType (GhcPass 'Parsed)
-> HsType (GhcPass 'Parsed)
forall pass.
XIParamTy pass -> XRec pass HsIPName -> LHsType pass -> HsType pass
HsIParamTy XIParamTy (GhcPass 'Parsed)
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn (Located HsIPName -> LocatedAn NoEpAnns HsIPName
forall e ann. Located e -> LocatedAn ann e
reLocA Located HsIPName
n') LHsType (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
t')
                   }

           Type
_ -> SDoc -> CvtM (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
forall a. SDoc -> CvtM a
failWith (String -> SDoc
text String
"Malformed " SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
ty_str SDoc -> SDoc -> SDoc
<+> String -> SDoc
text (Type -> String
forall a. Show a => a -> String
show Type
ty))
    }

hsTypeToArrow :: LHsType GhcPs -> HsArrow GhcPs
hsTypeToArrow :: LHsType (GhcPass 'Parsed) -> HsArrow (GhcPass 'Parsed)
hsTypeToArrow LHsType (GhcPass 'Parsed)
w = case GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
-> HsType (GhcPass 'Parsed)
forall l e. GenLocated l e -> e
unLoc LHsType (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
w of
                     HsTyVar XTyVar (GhcPass 'Parsed)
_ PromotionFlag
_ (L SrcSpanAnnN
_ (RdrName -> Maybe Name
isExact_maybe -> Just Name
n))
                        | Name
n Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
oneDataConName -> HsLinearArrowTokens (GhcPass 'Parsed) -> HsArrow (GhcPass 'Parsed)
forall pass. HsLinearArrowTokens pass -> HsArrow pass
HsLinearArrow (LHsToken "%1" (GhcPass 'Parsed)
-> LHsUniToken "->" "\8594" (GhcPass 'Parsed)
-> HsLinearArrowTokens (GhcPass 'Parsed)
forall pass.
LHsToken "%1" pass
-> LHsUniToken "->" "\8594" pass -> HsLinearArrowTokens pass
HsPct1 LHsToken "%1" (GhcPass 'Parsed)
GenLocated TokenLocation (HsToken "%1")
forall (tok :: Symbol). GenLocated TokenLocation (HsToken tok)
noHsTok LHsUniToken "->" "\8594" (GhcPass 'Parsed)
GenLocated TokenLocation (HsUniToken "->" "\8594")
forall (tok :: Symbol) (utok :: Symbol).
GenLocated TokenLocation (HsUniToken tok utok)
noHsUniTok)
                        | Name
n Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
manyDataConName -> LHsUniToken "->" "\8594" (GhcPass 'Parsed)
-> HsArrow (GhcPass 'Parsed)
forall pass. LHsUniToken "->" "\8594" pass -> HsArrow pass
HsUnrestrictedArrow LHsUniToken "->" "\8594" (GhcPass 'Parsed)
GenLocated TokenLocation (HsUniToken "->" "\8594")
forall (tok :: Symbol) (utok :: Symbol).
GenLocated TokenLocation (HsUniToken tok utok)
noHsUniTok
                     HsType (GhcPass 'Parsed)
_ -> LHsToken "%" (GhcPass 'Parsed)
-> LHsType (GhcPass 'Parsed)
-> LHsUniToken "->" "\8594" (GhcPass 'Parsed)
-> HsArrow (GhcPass 'Parsed)
forall pass.
LHsToken "%" pass
-> LHsType pass -> LHsUniToken "->" "\8594" pass -> HsArrow pass
HsExplicitMult LHsToken "%" (GhcPass 'Parsed)
GenLocated TokenLocation (HsToken "%")
forall (tok :: Symbol). GenLocated TokenLocation (HsToken tok)
noHsTok LHsType (GhcPass 'Parsed)
w LHsUniToken "->" "\8594" (GhcPass 'Parsed)
GenLocated TokenLocation (HsUniToken "->" "\8594")
forall (tok :: Symbol) (utok :: Symbol).
GenLocated TokenLocation (HsUniToken tok utok)
noHsUniTok

-- ConT/InfixT can contain both data constructor (i.e., promoted) names and
-- other (i.e, unpromoted) names, as opposed to PromotedT, which can only
-- contain data constructor names. See #15572/#17394. We use this function to
-- determine whether to mark a name as promoted/unpromoted when dealing with
-- ConT/InfixT.
name_promotedness :: RdrName -> Hs.PromotionFlag
name_promotedness :: RdrName -> PromotionFlag
name_promotedness RdrName
nm
  | RdrName -> Bool
isRdrDataCon RdrName
nm = PromotionFlag
IsPromoted
  | Bool
otherwise       = PromotionFlag
NotPromoted

-- | Constructs an application of a type to arguments passed in a list.
mk_apps :: HsType GhcPs -> [LHsTypeArg GhcPs] -> CvtM (LHsType GhcPs)
mk_apps :: HsType (GhcPass 'Parsed)
-> HsTyPats (GhcPass 'Parsed) -> CvtM (LHsType (GhcPass 'Parsed))
mk_apps HsType (GhcPass 'Parsed)
head_ty HsTyPats (GhcPass 'Parsed)
type_args = do
  GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
head_ty' <- HsType (GhcPass 'Parsed)
-> CvtM (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA HsType (GhcPass 'Parsed)
head_ty
  -- We must parenthesize the function type in case of an explicit
  -- signature. For instance, in `(Maybe :: Type -> Type) Int`, there
  -- _must_ be parentheses around `Maybe :: Type -> Type`.
  let phead_ty :: LHsType GhcPs
      phead_ty :: LHsType (GhcPass 'Parsed)
phead_ty = PprPrec -> LHsType (GhcPass 'Parsed) -> LHsType (GhcPass 'Parsed)
forall (p :: Pass).
PprPrec -> LHsType (GhcPass p) -> LHsType (GhcPass p)
parenthesizeHsType PprPrec
sigPrec LHsType (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
head_ty'

      go :: [LHsTypeArg GhcPs] -> CvtM (LHsType GhcPs)
      go :: HsTyPats (GhcPass 'Parsed) -> CvtM (LHsType (GhcPass 'Parsed))
go [] = GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
-> CvtM (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
forall a. a -> CvtM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
head_ty'
      go (LHsTypeArg (GhcPass 'Parsed)
arg:HsTyPats (GhcPass 'Parsed)
args) =
        case LHsTypeArg (GhcPass 'Parsed)
arg of
          HsValArg LHsType (GhcPass 'Parsed)
ty  -> do GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
p_ty <- GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
-> CvtM (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
forall {p :: Pass}.
GenLocated SrcSpanAnnA (HsType (GhcPass p))
-> CvtM (GenLocated SrcSpanAnnA (HsType (GhcPass p)))
add_parens LHsType (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
ty
                             HsType (GhcPass 'Parsed)
-> HsTyPats (GhcPass 'Parsed) -> CvtM (LHsType (GhcPass 'Parsed))
mk_apps (XAppTy (GhcPass 'Parsed)
-> LHsType (GhcPass 'Parsed)
-> LHsType (GhcPass 'Parsed)
-> HsType (GhcPass 'Parsed)
forall pass.
XAppTy pass -> LHsType pass -> LHsType pass -> HsType pass
HsAppTy XAppTy (GhcPass 'Parsed)
NoExtField
noExtField LHsType (GhcPass 'Parsed)
phead_ty LHsType (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
p_ty) HsTyPats (GhcPass 'Parsed)
args
          HsTypeArg SrcSpan
l LHsType (GhcPass 'Parsed)
ki -> do GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
p_ki <- GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
-> CvtM (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
forall {p :: Pass}.
GenLocated SrcSpanAnnA (HsType (GhcPass p))
-> CvtM (GenLocated SrcSpanAnnA (HsType (GhcPass p)))
add_parens LHsType (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
ki
                               HsType (GhcPass 'Parsed)
-> HsTyPats (GhcPass 'Parsed) -> CvtM (LHsType (GhcPass 'Parsed))
mk_apps (XAppKindTy (GhcPass 'Parsed)
-> LHsType (GhcPass 'Parsed)
-> LHsType (GhcPass 'Parsed)
-> HsType (GhcPass 'Parsed)
forall pass.
XAppKindTy pass -> LHsType pass -> LHsType pass -> HsType pass
HsAppKindTy XAppKindTy (GhcPass 'Parsed)
SrcSpan
l LHsType (GhcPass 'Parsed)
phead_ty LHsType (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
p_ki) HsTyPats (GhcPass 'Parsed)
args
          HsArgPar SrcSpan
_   -> HsType (GhcPass 'Parsed)
-> HsTyPats (GhcPass 'Parsed) -> CvtM (LHsType (GhcPass 'Parsed))
mk_apps (XParTy (GhcPass 'Parsed)
-> LHsType (GhcPass 'Parsed) -> HsType (GhcPass 'Parsed)
forall pass. XParTy pass -> LHsType pass -> HsType pass
HsParTy XParTy (GhcPass 'Parsed)
EpAnn AnnParen
forall a. EpAnn a
noAnn LHsType (GhcPass 'Parsed)
phead_ty) HsTyPats (GhcPass 'Parsed)
args

  HsTyPats (GhcPass 'Parsed) -> CvtM (LHsType (GhcPass 'Parsed))
go HsTyPats (GhcPass 'Parsed)
type_args
   where
    -- See Note [Adding parens for splices]
    add_parens :: GenLocated SrcSpanAnnA (HsType (GhcPass p))
-> CvtM (GenLocated SrcSpanAnnA (HsType (GhcPass p)))
add_parens lt :: GenLocated SrcSpanAnnA (HsType (GhcPass p))
lt@(L SrcSpanAnnA
_ HsType (GhcPass p)
t)
      | PprPrec -> HsType (GhcPass p) -> Bool
forall (p :: Pass). PprPrec -> HsType (GhcPass p) -> Bool
hsTypeNeedsParens PprPrec
appPrec HsType (GhcPass p)
t = HsType (GhcPass p)
-> CvtM (GenLocated SrcSpanAnnA (HsType (GhcPass p)))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (XParTy (GhcPass p) -> LHsType (GhcPass p) -> HsType (GhcPass p)
forall pass. XParTy pass -> LHsType pass -> HsType pass
HsParTy XParTy (GhcPass p)
EpAnn AnnParen
forall a. EpAnn a
noAnn LHsType (GhcPass p)
GenLocated SrcSpanAnnA (HsType (GhcPass p))
lt)
      | Bool
otherwise                   = GenLocated SrcSpanAnnA (HsType (GhcPass p))
-> CvtM (GenLocated SrcSpanAnnA (HsType (GhcPass p)))
forall a. a -> CvtM a
forall (m :: * -> *) a. Monad m => a -> m a
return GenLocated SrcSpanAnnA (HsType (GhcPass p))
lt

wrap_tyarg :: LHsTypeArg GhcPs -> LHsTypeArg GhcPs
wrap_tyarg :: LHsTypeArg (GhcPass 'Parsed) -> LHsTypeArg (GhcPass 'Parsed)
wrap_tyarg (HsValArg LHsType (GhcPass 'Parsed)
ty)    = LHsType (GhcPass 'Parsed) -> LHsTypeArg (GhcPass 'Parsed)
forall tm ty. tm -> HsArg tm ty
HsValArg  (LHsType (GhcPass 'Parsed) -> LHsTypeArg (GhcPass 'Parsed))
-> LHsType (GhcPass 'Parsed) -> LHsTypeArg (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$ PprPrec -> LHsType (GhcPass 'Parsed) -> LHsType (GhcPass 'Parsed)
forall (p :: Pass).
PprPrec -> LHsType (GhcPass p) -> LHsType (GhcPass p)
parenthesizeHsType PprPrec
appPrec LHsType (GhcPass 'Parsed)
ty
wrap_tyarg (HsTypeArg SrcSpan
l LHsType (GhcPass 'Parsed)
ki) = SrcSpan
-> LHsType (GhcPass 'Parsed) -> LHsTypeArg (GhcPass 'Parsed)
forall tm ty. SrcSpan -> ty -> HsArg tm ty
HsTypeArg SrcSpan
l (LHsType (GhcPass 'Parsed) -> LHsTypeArg (GhcPass 'Parsed))
-> LHsType (GhcPass 'Parsed) -> LHsTypeArg (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$ PprPrec -> LHsType (GhcPass 'Parsed) -> LHsType (GhcPass 'Parsed)
forall (p :: Pass).
PprPrec -> LHsType (GhcPass p) -> LHsType (GhcPass p)
parenthesizeHsType PprPrec
appPrec LHsType (GhcPass 'Parsed)
ki
wrap_tyarg ta :: LHsTypeArg (GhcPass 'Parsed)
ta@(HsArgPar {}) = LHsTypeArg (GhcPass 'Parsed)
ta -- Already parenthesized

-- ---------------------------------------------------------------------
-- Note [Adding parens for splices]
{-
The hsSyn representation of parsed source explicitly contains all the original
parens, as written in the source.

When a Template Haskell (TH) splice is evaluated, the original splice is first
renamed and type checked and then finally converted to core in
GHC.HsToCore.Quote. This core is then run in the TH engine, and the result
comes back as a TH AST.

In the process, all parens are stripped out, as they are not needed.

This Convert module then converts the TH AST back to hsSyn AST.

In order to pretty-print this hsSyn AST, parens need to be adde back at certain
points so that the code is readable with its original meaning.

So scattered through "GHC.ThToHs" are various points where parens are added.

See (among other closed issues) https://gitlab.haskell.org/ghc/ghc/issues/14289
-}
-- ---------------------------------------------------------------------

split_ty_app :: TH.Type -> CvtM (TH.Type, [LHsTypeArg GhcPs])
split_ty_app :: Type -> CvtM (Type, HsTyPats (GhcPass 'Parsed))
split_ty_app Type
ty = Type
-> [HsArg
      (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
      (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))]
-> CvtM
     (Type,
      [HsArg
         (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
         (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))])
go Type
ty []
  where
    go :: Type
-> [HsArg
      (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
      (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))]
-> CvtM
     (Type,
      [HsArg
         (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
         (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))])
go (AppT Type
f Type
a) [HsArg
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))]
as' = do { GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
a' <- Type -> CvtM (LHsType (GhcPass 'Parsed))
cvtType Type
a; Type
-> [HsArg
      (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
      (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))]
-> CvtM
     (Type,
      [HsArg
         (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
         (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))])
go Type
f (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
-> HsArg
     (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
     (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
forall tm ty. tm -> HsArg tm ty
HsValArg GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
a'HsArg
  (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
  (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
-> [HsArg
      (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
      (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))]
-> [HsArg
      (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
      (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))]
forall a. a -> [a] -> [a]
:[HsArg
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))]
as') }
    go (AppKindT Type
ty Type
ki) [HsArg
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))]
as' = do { GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
ki' <- Type -> CvtM (LHsType (GhcPass 'Parsed))
cvtKind Type
ki
                                 ; Type
-> [HsArg
      (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
      (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))]
-> CvtM
     (Type,
      [HsArg
         (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
         (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))])
go Type
ty (SrcSpan
-> GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
-> HsArg
     (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
     (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
forall tm ty. SrcSpan -> ty -> HsArg tm ty
HsTypeArg SrcSpan
noSrcSpan GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
ki'HsArg
  (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
  (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
-> [HsArg
      (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
      (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))]
-> [HsArg
      (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
      (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))]
forall a. a -> [a] -> [a]
:[HsArg
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))]
as') }
    go (ParensT Type
t) [HsArg
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))]
as' = do { SrcSpan
loc <- CvtM SrcSpan
getL; Type
-> [HsArg
      (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
      (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))]
-> CvtM
     (Type,
      [HsArg
         (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
         (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))])
go Type
t (SrcSpan
-> HsArg
     (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
     (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
forall tm ty. SrcSpan -> HsArg tm ty
HsArgPar SrcSpan
locHsArg
  (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
  (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
-> [HsArg
      (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
      (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))]
-> [HsArg
      (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
      (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))]
forall a. a -> [a] -> [a]
: [HsArg
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))]
as') }
    go Type
f [HsArg
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))]
as           = (Type,
 [HsArg
    (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
    (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))])
-> CvtM
     (Type,
      [HsArg
         (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
         (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))])
forall a. a -> CvtM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Type
f,[HsArg
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
   (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))]
as)

cvtTyLit :: TH.TyLit -> HsTyLit
cvtTyLit :: TyLit -> HsTyLit
cvtTyLit (TH.NumTyLit Integer
i) = SourceText -> Integer -> HsTyLit
HsNumTy SourceText
NoSourceText Integer
i
cvtTyLit (TH.StrTyLit String
s) = SourceText -> CLabelString -> HsTyLit
HsStrTy SourceText
NoSourceText (String -> CLabelString
fsLit String
s)
cvtTyLit (TH.CharTyLit Char
c) = SourceText -> Char -> HsTyLit
HsCharTy SourceText
NoSourceText Char
c

{- | @cvtOpAppT x op y@ converts @op@ and @y@ and produces the operator
application @x `op` y@. The produced tree of infix types will be right-biased,
provided @y@ is.

See the @cvtOpApp@ documentation for how this function works.
-}
cvtOpAppT :: PromotionFlag -> TH.Type -> LocatedN RdrName -> LHsType GhcPs -> CvtM (LHsType GhcPs)
cvtOpAppT :: PromotionFlag
-> Type
-> GenLocated SrcSpanAnnN RdrName
-> LHsType (GhcPass 'Parsed)
-> CvtM (LHsType (GhcPass 'Parsed))
cvtOpAppT PromotionFlag
prom (UInfixT Type
x Name
op2 Type
y) GenLocated SrcSpanAnnN RdrName
op1 LHsType (GhcPass 'Parsed)
z
  = do { GenLocated SrcSpanAnnN RdrName
op2' <- Name -> CvtM (GenLocated SrcSpanAnnN RdrName)
tconNameN Name
op2
       ; GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
l <- PromotionFlag
-> Type
-> GenLocated SrcSpanAnnN RdrName
-> LHsType (GhcPass 'Parsed)
-> CvtM (LHsType (GhcPass 'Parsed))
cvtOpAppT PromotionFlag
prom Type
y GenLocated SrcSpanAnnN RdrName
op1 LHsType (GhcPass 'Parsed)
z
       ; PromotionFlag
-> Type
-> GenLocated SrcSpanAnnN RdrName
-> LHsType (GhcPass 'Parsed)
-> CvtM (LHsType (GhcPass 'Parsed))
cvtOpAppT PromotionFlag
NotPromoted Type
x GenLocated SrcSpanAnnN RdrName
op2' LHsType (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
l }
cvtOpAppT PromotionFlag
prom (PromotedUInfixT Type
x Name
op2 Type
y) GenLocated SrcSpanAnnN RdrName
op1 LHsType (GhcPass 'Parsed)
z
  = do { GenLocated SrcSpanAnnN RdrName
op2' <- Name -> CvtM (GenLocated SrcSpanAnnN RdrName)
cNameN Name
op2
       ; GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
l <- PromotionFlag
-> Type
-> GenLocated SrcSpanAnnN RdrName
-> LHsType (GhcPass 'Parsed)
-> CvtM (LHsType (GhcPass 'Parsed))
cvtOpAppT PromotionFlag
prom Type
y GenLocated SrcSpanAnnN RdrName
op1 LHsType (GhcPass 'Parsed)
z
       ; PromotionFlag
-> Type
-> GenLocated SrcSpanAnnN RdrName
-> LHsType (GhcPass 'Parsed)
-> CvtM (LHsType (GhcPass 'Parsed))
cvtOpAppT PromotionFlag
IsPromoted Type
x GenLocated SrcSpanAnnN RdrName
op2' LHsType (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
l }
cvtOpAppT PromotionFlag
prom Type
x GenLocated SrcSpanAnnN RdrName
op LHsType (GhcPass 'Parsed)
y
  = do { GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
x' <- Type -> CvtM (LHsType (GhcPass 'Parsed))
cvtType Type
x
       ; HsType (GhcPass 'Parsed)
-> CvtM (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (PromotionFlag
-> LHsType (GhcPass 'Parsed)
-> LocatedN (IdP (GhcPass 'Parsed))
-> LHsType (GhcPass 'Parsed)
-> HsType (GhcPass 'Parsed)
forall (p :: Pass).
(Anno (IdGhcP p) ~ SrcSpanAnnN) =>
PromotionFlag
-> LHsType (GhcPass p)
-> LocatedN (IdP (GhcPass p))
-> LHsType (GhcPass p)
-> HsType (GhcPass p)
mkHsOpTy PromotionFlag
prom LHsType (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
x' LocatedN (IdP (GhcPass 'Parsed))
GenLocated SrcSpanAnnN RdrName
op LHsType (GhcPass 'Parsed)
y) }

cvtKind :: TH.Kind -> CvtM (LHsKind GhcPs)
cvtKind :: Type -> CvtM (LHsType (GhcPass 'Parsed))
cvtKind = String -> Type -> CvtM (LHsType (GhcPass 'Parsed))
cvtTypeKind String
"kind"

cvtSigKind :: TH.Kind -> CvtM (LHsSigType GhcPs)
cvtSigKind :: Type -> CvtM (LHsSigType (GhcPass 'Parsed))
cvtSigKind = String -> Type -> CvtM (LHsSigType (GhcPass 'Parsed))
cvtSigTypeKind String
"kind"

-- | Convert Maybe Kind to a type family result signature. Used with data
-- families where naming of the result is not possible (thus only kind or no
-- signature is possible).
cvtMaybeKindToFamilyResultSig :: Maybe TH.Kind
                              -> CvtM (LFamilyResultSig GhcPs)
cvtMaybeKindToFamilyResultSig :: Maybe Type -> CvtM (LFamilyResultSig (GhcPass 'Parsed))
cvtMaybeKindToFamilyResultSig Maybe Type
Nothing   = FamilyResultSig (GhcPass 'Parsed)
-> CvtM
     (GenLocated (SrcAnn NoEpAnns) (FamilyResultSig (GhcPass 'Parsed)))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (XNoSig (GhcPass 'Parsed) -> FamilyResultSig (GhcPass 'Parsed)
forall pass. XNoSig pass -> FamilyResultSig pass
Hs.NoSig XNoSig (GhcPass 'Parsed)
NoExtField
noExtField)
cvtMaybeKindToFamilyResultSig (Just Type
ki) = do { GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
ki' <- Type -> CvtM (LHsType (GhcPass 'Parsed))
cvtKind Type
ki
                                             ; FamilyResultSig (GhcPass 'Parsed)
-> CvtM
     (GenLocated (SrcAnn NoEpAnns) (FamilyResultSig (GhcPass 'Parsed)))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (XCKindSig (GhcPass 'Parsed)
-> LHsType (GhcPass 'Parsed) -> FamilyResultSig (GhcPass 'Parsed)
forall pass. XCKindSig pass -> LHsKind pass -> FamilyResultSig pass
Hs.KindSig XCKindSig (GhcPass 'Parsed)
NoExtField
noExtField LHsType (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
ki') }

-- | Convert type family result signature. Used with both open and closed type
-- families.
cvtFamilyResultSig :: TH.FamilyResultSig -> CvtM (Hs.LFamilyResultSig GhcPs)
cvtFamilyResultSig :: FamilyResultSig -> CvtM (LFamilyResultSig (GhcPass 'Parsed))
cvtFamilyResultSig FamilyResultSig
TH.NoSig           = FamilyResultSig (GhcPass 'Parsed)
-> CvtM
     (GenLocated (SrcAnn NoEpAnns) (FamilyResultSig (GhcPass 'Parsed)))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (XNoSig (GhcPass 'Parsed) -> FamilyResultSig (GhcPass 'Parsed)
forall pass. XNoSig pass -> FamilyResultSig pass
Hs.NoSig XNoSig (GhcPass 'Parsed)
NoExtField
noExtField)
cvtFamilyResultSig (TH.KindSig Type
ki)    = do { GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
ki' <- Type -> CvtM (LHsType (GhcPass 'Parsed))
cvtKind Type
ki
                                           ; FamilyResultSig (GhcPass 'Parsed)
-> CvtM
     (GenLocated (SrcAnn NoEpAnns) (FamilyResultSig (GhcPass 'Parsed)))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (XCKindSig (GhcPass 'Parsed)
-> LHsType (GhcPass 'Parsed) -> FamilyResultSig (GhcPass 'Parsed)
forall pass. XCKindSig pass -> LHsKind pass -> FamilyResultSig pass
Hs.KindSig XCKindSig (GhcPass 'Parsed)
NoExtField
noExtField  LHsType (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
ki') }
cvtFamilyResultSig (TH.TyVarSig TyVarBndr ()
bndr) = do { GenLocated SrcSpanAnnA (HsTyVarBndr () (GhcPass 'Parsed))
tv <- TyVarBndr () -> CvtM (LHsTyVarBndr () (GhcPass 'Parsed))
forall flag flag'.
CvtFlag flag flag' =>
TyVarBndr flag -> CvtM (LHsTyVarBndr flag' (GhcPass 'Parsed))
cvt_tv TyVarBndr ()
bndr
                                           ; FamilyResultSig (GhcPass 'Parsed)
-> CvtM
     (GenLocated (SrcAnn NoEpAnns) (FamilyResultSig (GhcPass 'Parsed)))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (XTyVarSig (GhcPass 'Parsed)
-> LHsTyVarBndr () (GhcPass 'Parsed)
-> FamilyResultSig (GhcPass 'Parsed)
forall pass.
XTyVarSig pass -> LHsTyVarBndr () pass -> FamilyResultSig pass
Hs.TyVarSig XTyVarSig (GhcPass 'Parsed)
NoExtField
noExtField LHsTyVarBndr () (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsTyVarBndr () (GhcPass 'Parsed))
tv) }

-- | Convert injectivity annotation of a type family.
cvtInjectivityAnnotation :: TH.InjectivityAnn
                         -> CvtM (Hs.LInjectivityAnn GhcPs)
cvtInjectivityAnnotation :: InjectivityAnn -> CvtM (LInjectivityAnn (GhcPass 'Parsed))
cvtInjectivityAnnotation (TH.InjectivityAnn Name
annLHS [Name]
annRHS)
  = do { GenLocated SrcSpanAnnN RdrName
annLHS' <- Name -> CvtM (GenLocated SrcSpanAnnN RdrName)
tNameN Name
annLHS
       ; [GenLocated SrcSpanAnnN RdrName]
annRHS' <- (Name -> CvtM (GenLocated SrcSpanAnnN RdrName))
-> [Name] -> CvtM [GenLocated SrcSpanAnnN RdrName]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Name -> CvtM (GenLocated SrcSpanAnnN RdrName)
tNameN [Name]
annRHS
       ; InjectivityAnn (GhcPass 'Parsed)
-> CvtM
     (GenLocated (SrcAnn NoEpAnns) (InjectivityAnn (GhcPass 'Parsed)))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA (XCInjectivityAnn (GhcPass 'Parsed)
-> LIdP (GhcPass 'Parsed)
-> [LIdP (GhcPass 'Parsed)]
-> InjectivityAnn (GhcPass 'Parsed)
forall pass.
XCInjectivityAnn pass
-> LIdP pass -> [LIdP pass] -> InjectivityAnn pass
Hs.InjectivityAnn XCInjectivityAnn (GhcPass 'Parsed)
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn LIdP (GhcPass 'Parsed)
GenLocated SrcSpanAnnN RdrName
annLHS' [LIdP (GhcPass 'Parsed)]
[GenLocated SrcSpanAnnN RdrName]
annRHS') }

cvtPatSynSigTy :: TH.Type -> CvtM (LHsSigType GhcPs)
-- pattern synonym types are of peculiar shapes, which is why we treat
-- them separately from regular types;
-- see Note [Pattern synonym type signatures and Template Haskell]
cvtPatSynSigTy :: Type -> CvtM (LHsSigType (GhcPass 'Parsed))
cvtPatSynSigTy (ForallT [TyVarBndr Specificity]
univs [Type]
reqs (ForallT [TyVarBndr Specificity]
exis [Type]
provs Type
ty))
  | [TyVarBndr Specificity] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TyVarBndr Specificity]
exis, [Type] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Type]
provs = Type -> CvtM (LHsSigType (GhcPass 'Parsed))
cvtSigType ([TyVarBndr Specificity] -> [Type] -> Type -> Type
ForallT [TyVarBndr Specificity]
univs [Type]
reqs Type
ty)
  | [TyVarBndr Specificity] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TyVarBndr Specificity]
univs, [Type] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Type]
reqs = do { GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
ty' <- Type -> CvtM (LHsType (GhcPass 'Parsed))
cvtType ([TyVarBndr Specificity] -> [Type] -> Type -> Type
ForallT [TyVarBndr Specificity]
exis [Type]
provs Type
ty)
                               ; GenLocated
  SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
ctxt' <- [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
-> CvtM
     (GenLocated
        SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))])
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA []
                               ; HsSigType (GhcPass 'Parsed)
cxtTy <- (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
 -> HsSigType (GhcPass 'Parsed))
-> HsType (GhcPass 'Parsed) -> CvtM (HsSigType (GhcPass 'Parsed))
forall ann a b. (LocatedAn ann a -> b) -> a -> CvtM b
wrapParLA LHsType (GhcPass 'Parsed) -> HsSigType (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
-> HsSigType (GhcPass 'Parsed)
mkHsImplicitSigType (HsType (GhcPass 'Parsed) -> CvtM (HsSigType (GhcPass 'Parsed)))
-> HsType (GhcPass 'Parsed) -> CvtM (HsSigType (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$
                                          HsQualTy { hst_ctxt :: LHsContext (GhcPass 'Parsed)
hst_ctxt = LHsContext (GhcPass 'Parsed)
GenLocated
  SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
ctxt'
                                                   , hst_xqual :: XQualTy (GhcPass 'Parsed)
hst_xqual = XQualTy (GhcPass 'Parsed)
NoExtField
noExtField
                                                   , hst_body :: LHsType (GhcPass 'Parsed)
hst_body = LHsType (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
ty' }
                               ; HsSigType (GhcPass 'Parsed)
-> CvtM (GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Parsed)))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA HsSigType (GhcPass 'Parsed)
cxtTy }
  | [Type] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Type]
reqs             = do { [GenLocated
   SrcSpanAnnA (HsTyVarBndr Specificity (GhcPass 'Parsed))]
univs' <- [TyVarBndr Specificity]
-> CvtM [LHsTyVarBndr Specificity (GhcPass 'Parsed)]
forall flag flag'.
CvtFlag flag flag' =>
[TyVarBndr flag] -> CvtM [LHsTyVarBndr flag' (GhcPass 'Parsed)]
cvtTvs [TyVarBndr Specificity]
univs
                               ; GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
ty'    <- Type -> CvtM (LHsType (GhcPass 'Parsed))
cvtType ([TyVarBndr Specificity] -> [Type] -> Type -> Type
ForallT [TyVarBndr Specificity]
exis [Type]
provs Type
ty)
                               ; LocatedAn AnnContext [LHsType (GhcPass 'Parsed)]
ctxt'  <- [LHsType (GhcPass 'Parsed)]
-> CvtM (LocatedAn AnnContext [LHsType (GhcPass 'Parsed)])
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA []
                               ; let cxtTy :: HsType (GhcPass 'Parsed)
cxtTy = HsQualTy { hst_ctxt :: LHsContext (GhcPass 'Parsed)
hst_ctxt = LHsContext (GhcPass 'Parsed)
LocatedAn AnnContext [LHsType (GhcPass 'Parsed)]
ctxt'
                                                      , hst_xqual :: XQualTy (GhcPass 'Parsed)
hst_xqual = XQualTy (GhcPass 'Parsed)
NoExtField
noExtField
                                                      , hst_body :: LHsType (GhcPass 'Parsed)
hst_body = LHsType (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
ty' }
                               ; HsSigType (GhcPass 'Parsed)
forTy <- (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
 -> HsSigType (GhcPass 'Parsed))
-> HsType (GhcPass 'Parsed) -> CvtM (HsSigType (GhcPass 'Parsed))
forall ann a b. (LocatedAn ann a -> b) -> a -> CvtM b
wrapParLA (EpAnnForallTy
-> [LHsTyVarBndr Specificity (GhcPass 'Parsed)]
-> LHsType (GhcPass 'Parsed)
-> HsSigType (GhcPass 'Parsed)
mkHsExplicitSigType EpAnnForallTy
forall a. EpAnn a
noAnn [LHsTyVarBndr Specificity (GhcPass 'Parsed)]
[GenLocated
   SrcSpanAnnA (HsTyVarBndr Specificity (GhcPass 'Parsed))]
univs') HsType (GhcPass 'Parsed)
cxtTy
                               ; HsSigType (GhcPass 'Parsed)
-> CvtM (GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Parsed)))
forall e ann. e -> CvtM (LocatedAn ann e)
returnLA HsSigType (GhcPass 'Parsed)
forTy }
  | Bool
otherwise             = Type -> CvtM (LHsSigType (GhcPass 'Parsed))
cvtSigType ([TyVarBndr Specificity] -> [Type] -> Type -> Type
ForallT [TyVarBndr Specificity]
univs [Type]
reqs ([TyVarBndr Specificity] -> [Type] -> Type -> Type
ForallT [TyVarBndr Specificity]
exis [Type]
provs Type
ty))
cvtPatSynSigTy Type
ty         = Type -> CvtM (LHsSigType (GhcPass 'Parsed))
cvtSigType Type
ty

-----------------------------------------------------------
cvtFixity :: TH.Fixity -> Hs.Fixity
cvtFixity :: Fixity -> Fixity
cvtFixity (TH.Fixity Int
prec FixityDirection
dir) = SourceText -> Int -> FixityDirection -> Fixity
Hs.Fixity SourceText
NoSourceText Int
prec (FixityDirection -> FixityDirection
cvt_dir FixityDirection
dir)
   where
     cvt_dir :: FixityDirection -> FixityDirection
cvt_dir FixityDirection
TH.InfixL = FixityDirection
Hs.InfixL
     cvt_dir FixityDirection
TH.InfixR = FixityDirection
Hs.InfixR
     cvt_dir FixityDirection
TH.InfixN = FixityDirection
Hs.InfixN

-----------------------------------------------------------


-----------------------------------------------------------
-- some useful things

overloadedLit :: Lit -> Bool
-- True for literals that Haskell treats as overloaded
overloadedLit :: Lit -> Bool
overloadedLit (IntegerL  Integer
_) = Bool
True
overloadedLit (RationalL Rational
_) = Bool
True
overloadedLit Lit
_             = Bool
False

-- Checks that are performed when converting unboxed sum expressions and
-- patterns alike.
unboxedSumChecks :: TH.SumAlt -> TH.SumArity -> CvtM ()
unboxedSumChecks :: Int -> Int -> CvtM ()
unboxedSumChecks Int
alt Int
arity
    | Int
alt Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
arity
    = SDoc -> CvtM ()
forall a. SDoc -> CvtM a
failWith (SDoc -> CvtM ()) -> SDoc -> CvtM ()
forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"Sum alternative"    SDoc -> SDoc -> SDoc
<+> String -> SDoc
text (Int -> String
forall a. Show a => a -> String
show Int
alt)
             SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"exceeds its arity," SDoc -> SDoc -> SDoc
<+> String -> SDoc
text (Int -> String
forall a. Show a => a -> String
show Int
arity)
    | Int
alt Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
    = SDoc -> CvtM ()
forall a. SDoc -> CvtM a
failWith (SDoc -> CvtM ()) -> SDoc -> CvtM ()
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
vcat [ String -> SDoc
text String
"Illegal sum alternative:" SDoc -> SDoc -> SDoc
<+> String -> SDoc
text (Int -> String
forall a. Show a => a -> String
show Int
alt)
                      , Int -> SDoc -> SDoc
nest Int
2 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"Sum alternatives must start from 1" ]
    | Int
arity Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2
    = SDoc -> CvtM ()
forall a. SDoc -> CvtM a
failWith (SDoc -> CvtM ()) -> SDoc -> CvtM ()
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
vcat [ String -> SDoc
text String
"Illegal sum arity:" SDoc -> SDoc -> SDoc
<+> String -> SDoc
text (Int -> String
forall a. Show a => a -> String
show Int
arity)
                      , Int -> SDoc -> SDoc
nest Int
2 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"Sums must have an arity of at least 2" ]
    | Bool
otherwise
    = () -> CvtM ()
forall a. a -> CvtM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | If passed an empty list of 'LHsTyVarBndr's, this simply returns the
-- third argument (an 'LHsType'). Otherwise, return an 'HsForAllTy'
-- using the provided 'LHsQTyVars' and 'LHsType'.
mkHsForAllTy :: SrcSpanAnnA
             -- ^ The location of the returned 'LHsType' if it needs an
             --   explicit forall
             -> HsForAllTelescope GhcPs
             -- ^ The converted type variable binders
             -> LHsType GhcPs
             -- ^ The converted rho type
             -> LHsType GhcPs
             -- ^ The complete type, quantified with a forall if necessary
mkHsForAllTy :: SrcSpanAnnA
-> HsForAllTelescope (GhcPass 'Parsed)
-> LHsType (GhcPass 'Parsed)
-> LHsType (GhcPass 'Parsed)
mkHsForAllTy SrcSpanAnnA
loc HsForAllTelescope (GhcPass 'Parsed)
tele LHsType (GhcPass 'Parsed)
rho_ty
  | Bool
no_tvs    = LHsType (GhcPass 'Parsed)
rho_ty
  | Bool
otherwise = SrcSpanAnnA
-> HsType (GhcPass 'Parsed)
-> GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc (HsType (GhcPass 'Parsed)
 -> GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
-> HsType (GhcPass 'Parsed)
-> GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ HsForAllTy { hst_tele :: HsForAllTelescope (GhcPass 'Parsed)
hst_tele = HsForAllTelescope (GhcPass 'Parsed)
tele
                                   , hst_xforall :: XForAllTy (GhcPass 'Parsed)
hst_xforall = XForAllTy (GhcPass 'Parsed)
NoExtField
noExtField
                                   , hst_body :: LHsType (GhcPass 'Parsed)
hst_body = LHsType (GhcPass 'Parsed)
rho_ty }
  where
    no_tvs :: Bool
no_tvs = case HsForAllTelescope (GhcPass 'Parsed)
tele of
      HsForAllVis   { hsf_vis_bndrs :: forall pass. HsForAllTelescope pass -> [LHsTyVarBndr () pass]
hsf_vis_bndrs   = [LHsTyVarBndr () (GhcPass 'Parsed)]
bndrs } -> [GenLocated SrcSpanAnnA (HsTyVarBndr () (GhcPass 'Parsed))] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LHsTyVarBndr () (GhcPass 'Parsed)]
[GenLocated SrcSpanAnnA (HsTyVarBndr () (GhcPass 'Parsed))]
bndrs
      HsForAllInvis { hsf_invis_bndrs :: forall pass.
HsForAllTelescope pass -> [LHsTyVarBndr Specificity pass]
hsf_invis_bndrs = [LHsTyVarBndr Specificity (GhcPass 'Parsed)]
bndrs } -> [GenLocated
   SrcSpanAnnA (HsTyVarBndr Specificity (GhcPass 'Parsed))]
-> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LHsTyVarBndr Specificity (GhcPass 'Parsed)]
[GenLocated
   SrcSpanAnnA (HsTyVarBndr Specificity (GhcPass 'Parsed))]
bndrs

-- | If passed an empty 'TH.Cxt', this simply returns the third argument
-- (an 'LHsType'). Otherwise, return an 'HsQualTy' using the provided
-- 'LHsContext' and 'LHsType'.

-- It's important that we don't build an HsQualTy if the context is empty,
-- as the pretty-printer for HsType _always_ prints contexts, even if
-- they're empty. See #13183.
mkHsQualTy :: TH.Cxt
           -- ^ The original Template Haskell context
           -> SrcSpanAnnA
           -- ^ The location of the returned 'LHsType' if it needs an
           --   explicit context
           -> LHsContext GhcPs
           -- ^ The converted context
           -> LHsType GhcPs
           -- ^ The converted tau type
           -> LHsType GhcPs
           -- ^ The complete type, qualified with a context if necessary
mkHsQualTy :: [Type]
-> SrcSpanAnnA
-> LHsContext (GhcPass 'Parsed)
-> LHsType (GhcPass 'Parsed)
-> LHsType (GhcPass 'Parsed)
mkHsQualTy [Type]
ctxt SrcSpanAnnA
loc LHsContext (GhcPass 'Parsed)
ctxt' LHsType (GhcPass 'Parsed)
ty
  | [Type] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Type]
ctxt = LHsType (GhcPass 'Parsed)
ty
  | Bool
otherwise = SrcSpanAnnA
-> HsType (GhcPass 'Parsed)
-> GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc (HsType (GhcPass 'Parsed)
 -> GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
-> HsType (GhcPass 'Parsed)
-> GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ HsQualTy { hst_xqual :: XQualTy (GhcPass 'Parsed)
hst_xqual = XQualTy (GhcPass 'Parsed)
NoExtField
noExtField
                                 , hst_ctxt :: LHsContext (GhcPass 'Parsed)
hst_ctxt  = LHsContext (GhcPass 'Parsed)
ctxt'
                                 , hst_body :: LHsType (GhcPass 'Parsed)
hst_body  = LHsType (GhcPass 'Parsed)
ty }

-- | @'mkHsContextMaybe' lc@ returns 'Nothing' if @lc@ is empty and @'Just' lc@
-- otherwise.
--
-- This is much like 'mkHsQualTy', except that it returns a
-- @'Maybe' ('LHsContext' 'GhcPs')@. This is used specifically for constructing
-- superclasses, datatype contexts (#20011), and contexts in GADT constructor
-- types (#20590). We wish to avoid using @'Just' []@ in the case of an empty
-- contexts, as the pretty-printer always prints 'Just' contexts, even if
-- they're empty.
mkHsContextMaybe :: LHsContext GhcPs -> Maybe (LHsContext GhcPs)
mkHsContextMaybe :: LHsContext (GhcPass 'Parsed)
-> Maybe (LHsContext (GhcPass 'Parsed))
mkHsContextMaybe lctxt :: LHsContext (GhcPass 'Parsed)
lctxt@(L SrcSpanAnnC
_ [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
ctxt)
  | [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
ctxt = Maybe (LHsContext (GhcPass 'Parsed))
Maybe
  (GenLocated
     SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))])
forall a. Maybe a
Nothing
  | Bool
otherwise = GenLocated
  SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
-> Maybe
     (GenLocated
        SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))])
forall a. a -> Maybe a
Just LHsContext (GhcPass 'Parsed)
GenLocated
  SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
lctxt

mkHsOuterFamEqnTyVarBndrs :: Maybe [LHsTyVarBndr () GhcPs] -> HsOuterFamEqnTyVarBndrs GhcPs
mkHsOuterFamEqnTyVarBndrs :: Maybe [LHsTyVarBndr () (GhcPass 'Parsed)]
-> HsOuterFamEqnTyVarBndrs (GhcPass 'Parsed)
mkHsOuterFamEqnTyVarBndrs = HsOuterFamEqnTyVarBndrs (GhcPass 'Parsed)
-> ([GenLocated SrcSpanAnnA (HsTyVarBndr () (GhcPass 'Parsed))]
    -> HsOuterFamEqnTyVarBndrs (GhcPass 'Parsed))
-> Maybe
     [GenLocated SrcSpanAnnA (HsTyVarBndr () (GhcPass 'Parsed))]
-> HsOuterFamEqnTyVarBndrs (GhcPass 'Parsed)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe HsOuterFamEqnTyVarBndrs (GhcPass 'Parsed)
forall flag. HsOuterTyVarBndrs flag (GhcPass 'Parsed)
mkHsOuterImplicit (EpAnnForallTy
-> [LHsTyVarBndr () (GhcPass 'Parsed)]
-> HsOuterFamEqnTyVarBndrs (GhcPass 'Parsed)
forall flag.
EpAnnForallTy
-> [LHsTyVarBndr flag (GhcPass 'Parsed)]
-> HsOuterTyVarBndrs flag (GhcPass 'Parsed)
mkHsOuterExplicit EpAnnForallTy
forall a. EpAnn a
noAnn)

--------------------------------------------------------------------
--      Turning Name back into RdrName
--------------------------------------------------------------------

-- variable names
vNameN, cNameN, vcNameN, tNameN, tconNameN :: TH.Name -> CvtM (LocatedN RdrName)
vNameL                                     :: TH.Name -> CvtM (LocatedA RdrName)
vName,  cName,  vcName,  tName,  tconName  :: TH.Name -> CvtM RdrName

-- Variable names
vNameN :: Name -> CvtM (GenLocated SrcSpanAnnN RdrName)
vNameN Name
n = CvtM RdrName -> CvtM (GenLocated SrcSpanAnnN RdrName)
forall a. CvtM a -> CvtM (LocatedN a)
wrapLN (Name -> CvtM RdrName
vName Name
n)
vNameL :: Name -> CvtM (LocatedA RdrName)
vNameL Name
n = CvtM RdrName -> CvtM (LocatedA RdrName)
forall a. CvtM a -> CvtM (LocatedA a)
wrapLA (Name -> CvtM RdrName
vName Name
n)
vName :: Name -> CvtM RdrName
vName Name
n = NameSpace -> Name -> CvtM RdrName
cvtName NameSpace
OccName.varName Name
n

-- Constructor function names; this is Haskell source, hence srcDataName
cNameN :: Name -> CvtM (GenLocated SrcSpanAnnN RdrName)
cNameN Name
n = CvtM RdrName -> CvtM (GenLocated SrcSpanAnnN RdrName)
forall a. CvtM a -> CvtM (LocatedN a)
wrapLN (Name -> CvtM RdrName
cName Name
n)
cName :: Name -> CvtM RdrName
cName Name
n = NameSpace -> Name -> CvtM RdrName
cvtName NameSpace
OccName.dataName Name
n

-- Variable *or* constructor names; check by looking at the first char
vcNameN :: Name -> CvtM (GenLocated SrcSpanAnnN RdrName)
vcNameN Name
n = CvtM RdrName -> CvtM (GenLocated SrcSpanAnnN RdrName)
forall a. CvtM a -> CvtM (LocatedN a)
wrapLN (Name -> CvtM RdrName
vcName Name
n)
vcName :: Name -> CvtM RdrName
vcName Name
n = if Name -> Bool
isVarName Name
n then Name -> CvtM RdrName
vName Name
n else Name -> CvtM RdrName
cName Name
n

-- Type variable names
tNameN :: Name -> CvtM (GenLocated SrcSpanAnnN RdrName)
tNameN Name
n = CvtM RdrName -> CvtM (GenLocated SrcSpanAnnN RdrName)
forall a. CvtM a -> CvtM (LocatedN a)
wrapLN (Name -> CvtM RdrName
tName Name
n)
tName :: Name -> CvtM RdrName
tName Name
n = NameSpace -> Name -> CvtM RdrName
cvtName NameSpace
OccName.tvName Name
n

-- Type Constructor names
tconNameN :: Name -> CvtM (GenLocated SrcSpanAnnN RdrName)
tconNameN Name
n = CvtM RdrName -> CvtM (GenLocated SrcSpanAnnN RdrName)
forall a. CvtM a -> CvtM (LocatedN a)
wrapLN (Name -> CvtM RdrName
tconName Name
n)
tconName :: Name -> CvtM RdrName
tconName Name
n = NameSpace -> Name -> CvtM RdrName
cvtName NameSpace
OccName.tcClsName Name
n

ipName :: String -> CvtM HsIPName
ipName :: String -> CvtM HsIPName
ipName String
n
  = do { Bool -> CvtM () -> CvtM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (String -> Bool
okVarOcc String
n) (SDoc -> CvtM ()
forall a. SDoc -> CvtM a
failWith (NameSpace -> String -> SDoc
badOcc NameSpace
OccName.varName String
n))
       ; HsIPName -> CvtM HsIPName
forall a. a -> CvtM a
forall (m :: * -> *) a. Monad m => a -> m a
return (CLabelString -> HsIPName
HsIPName (String -> CLabelString
fsLit String
n)) }

cvtName :: OccName.NameSpace -> TH.Name -> CvtM RdrName
cvtName :: NameSpace -> Name -> CvtM RdrName
cvtName NameSpace
ctxt_ns (TH.Name OccName
occ NameFlavour
flavour)
  | Bool -> Bool
not (NameSpace -> String -> Bool
okOcc NameSpace
ctxt_ns String
occ_str) = SDoc -> CvtM RdrName
forall a. SDoc -> CvtM a
failWith (NameSpace -> String -> SDoc
badOcc NameSpace
ctxt_ns String
occ_str)
  | Bool
otherwise
  = do { SrcSpan
loc <- CvtM SrcSpan
getL
       ; let rdr_name :: RdrName
rdr_name = SrcSpan -> NameSpace -> String -> NameFlavour -> RdrName
thRdrName SrcSpan
loc NameSpace
ctxt_ns String
occ_str NameFlavour
flavour
       ; RdrName -> CvtM ()
forall a. a -> CvtM ()
force RdrName
rdr_name
       ; RdrName -> CvtM RdrName
forall a. a -> CvtM a
forall (m :: * -> *) a. Monad m => a -> m a
return RdrName
rdr_name }
  where
    occ_str :: String
occ_str = OccName -> String
TH.occString OccName
occ

okOcc :: OccName.NameSpace -> String -> Bool
okOcc :: NameSpace -> String -> Bool
okOcc NameSpace
ns String
str
  | NameSpace -> Bool
OccName.isVarNameSpace NameSpace
ns     = String -> Bool
okVarOcc String
str
  | NameSpace -> Bool
OccName.isDataConNameSpace NameSpace
ns = String -> Bool
okConOcc String
str
  | Bool
otherwise                     = String -> Bool
okTcOcc  String
str

-- Determine the name space of a name in a type
--
isVarName :: TH.Name -> Bool
isVarName :: Name -> Bool
isVarName (TH.Name OccName
occ NameFlavour
_)
  = case OccName -> String
TH.occString OccName
occ of
      String
""    -> Bool
False
      (Char
c:String
_) -> Char -> Bool
startsVarId Char
c Bool -> Bool -> Bool
|| Char -> Bool
startsVarSym Char
c

badOcc :: OccName.NameSpace -> String -> SDoc
badOcc :: NameSpace -> String -> SDoc
badOcc NameSpace
ctxt_ns String
occ
  = String -> SDoc
text String
"Illegal" SDoc -> SDoc -> SDoc
<+> NameSpace -> SDoc
pprNameSpace NameSpace
ctxt_ns
        SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"name:" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (String -> SDoc
text String
occ)

thRdrName :: SrcSpan -> OccName.NameSpace -> String -> TH.NameFlavour -> RdrName
-- This turns a TH Name into a RdrName; used for both binders and occurrences
-- See Note [Binders in Template Haskell]
-- The passed-in name space tells what the context is expecting;
--      use it unless the TH name knows what name-space it comes
--      from, in which case use the latter
--
-- We pass in a SrcSpan (gotten from the monad) because this function
-- is used for *binders* and if we make an Exact Name we want it
-- to have a binding site inside it.  (cf #5434)
--
-- ToDo: we may generate silly RdrNames, by passing a name space
--       that doesn't match the string, like VarName ":+",
--       which will give confusing error messages later
--
-- The strict applications ensure that any buried exceptions get forced
thRdrName :: SrcSpan -> NameSpace -> String -> NameFlavour -> RdrName
thRdrName SrcSpan
loc NameSpace
ctxt_ns String
th_occ NameFlavour
th_name
  = case NameFlavour
th_name of
     TH.NameG NameSpace
th_ns PkgName
pkg ModName
mod -> String -> NameSpace -> PkgName -> ModName -> RdrName
thOrigRdrName String
th_occ NameSpace
th_ns PkgName
pkg ModName
mod
     TH.NameQ ModName
mod  -> (ModuleName -> OccName -> RdrName
mkRdrQual  (ModuleName -> OccName -> RdrName)
-> ModuleName -> OccName -> RdrName
forall a b. (a -> b) -> a -> b
$! ModName -> ModuleName
mk_mod ModName
mod) (OccName -> RdrName) -> OccName -> RdrName
forall a b. (a -> b) -> a -> b
$! OccName
occ
     TH.NameL Integer
uniq -> Name -> RdrName
nameRdrName (Name -> RdrName) -> Name -> RdrName
forall a b. (a -> b) -> a -> b
$! (((Unique -> OccName -> SrcSpan -> Name
Name.mkInternalName (Unique -> OccName -> SrcSpan -> Name)
-> Unique -> OccName -> SrcSpan -> Name
forall a b. (a -> b) -> a -> b
$! Int -> Unique
mk_uniq (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
uniq)) (OccName -> SrcSpan -> Name) -> OccName -> SrcSpan -> Name
forall a b. (a -> b) -> a -> b
$! OccName
occ) SrcSpan
loc)
     TH.NameU Integer
uniq -> Name -> RdrName
nameRdrName (Name -> RdrName) -> Name -> RdrName
forall a b. (a -> b) -> a -> b
$! (((Unique -> OccName -> SrcSpan -> Name
Name.mkSystemNameAt (Unique -> OccName -> SrcSpan -> Name)
-> Unique -> OccName -> SrcSpan -> Name
forall a b. (a -> b) -> a -> b
$! Int -> Unique
mk_uniq (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
uniq)) (OccName -> SrcSpan -> Name) -> OccName -> SrcSpan -> Name
forall a b. (a -> b) -> a -> b
$! OccName
occ) SrcSpan
loc)
     NameFlavour
TH.NameS | Just Name
name <- OccName -> Maybe Name
isBuiltInOcc_maybe OccName
occ -> Name -> RdrName
nameRdrName (Name -> RdrName) -> Name -> RdrName
forall a b. (a -> b) -> a -> b
$! Name
name
              | Bool
otherwise                           -> OccName -> RdrName
mkRdrUnqual (OccName -> RdrName) -> OccName -> RdrName
forall a b. (a -> b) -> a -> b
$! OccName
occ
              -- We check for built-in syntax here, because the TH
              -- user might have written a (NameS "(,,)"), for example
  where
    occ :: OccName.OccName
    occ :: OccName
occ = NameSpace -> String -> OccName
mk_occ NameSpace
ctxt_ns String
th_occ

-- Return an unqualified exact RdrName if we're dealing with built-in syntax.
-- See #13776.
thOrigRdrName :: String -> TH.NameSpace -> PkgName -> ModName -> RdrName
thOrigRdrName :: String -> NameSpace -> PkgName -> ModName -> RdrName
thOrigRdrName String
occ NameSpace
th_ns PkgName
pkg ModName
mod =
  let occ' :: OccName
occ' = NameSpace -> String -> OccName
mk_occ (NameSpace -> NameSpace
mk_ghc_ns NameSpace
th_ns) String
occ
  in case OccName -> Maybe Name
isBuiltInOcc_maybe OccName
occ' of
       Just Name
name -> Name -> RdrName
nameRdrName Name
name
       Maybe Name
Nothing   -> (Module -> OccName -> RdrName
mkOrig (Module -> OccName -> RdrName) -> Module -> OccName -> RdrName
forall a b. (a -> b) -> a -> b
$! (Unit -> ModuleName -> Module
forall u. u -> ModuleName -> GenModule u
mkModule (PkgName -> Unit
mk_pkg PkgName
pkg) (ModName -> ModuleName
mk_mod ModName
mod))) (OccName -> RdrName) -> OccName -> RdrName
forall a b. (a -> b) -> a -> b
$! OccName
occ'

thRdrNameGuesses :: TH.Name -> [RdrName]
thRdrNameGuesses :: Name -> [RdrName]
thRdrNameGuesses (TH.Name OccName
occ NameFlavour
flavour)
  -- This special case for NameG ensures that we don't generate duplicates in the output list
  | TH.NameG NameSpace
th_ns PkgName
pkg ModName
mod <- NameFlavour
flavour = [ String -> NameSpace -> PkgName -> ModName -> RdrName
thOrigRdrName String
occ_str NameSpace
th_ns PkgName
pkg ModName
mod]
  | Bool
otherwise                         = [ SrcSpan -> NameSpace -> String -> NameFlavour -> RdrName
thRdrName SrcSpan
noSrcSpan NameSpace
gns String
occ_str NameFlavour
flavour
                                        | NameSpace
gns <- [NameSpace]
guessed_nss]
  where
    -- guessed_ns are the name spaces guessed from looking at the TH name
    guessed_nss :: [NameSpace]
guessed_nss
      | CLabelString -> Bool
isLexCon (String -> CLabelString
mkFastString String
occ_str) = [NameSpace
OccName.tcName,  NameSpace
OccName.dataName]
      | Bool
otherwise                       = [NameSpace
OccName.varName, NameSpace
OccName.tvName]
    occ_str :: String
occ_str = OccName -> String
TH.occString OccName
occ

-- The packing and unpacking is rather turgid :-(
mk_occ :: OccName.NameSpace -> String -> OccName.OccName
mk_occ :: NameSpace -> String -> OccName
mk_occ NameSpace
ns String
occ = NameSpace -> String -> OccName
OccName.mkOccName NameSpace
ns String
occ

mk_ghc_ns :: TH.NameSpace -> OccName.NameSpace
mk_ghc_ns :: NameSpace -> NameSpace
mk_ghc_ns NameSpace
TH.DataName  = NameSpace
OccName.dataName
mk_ghc_ns NameSpace
TH.TcClsName = NameSpace
OccName.tcClsName
mk_ghc_ns NameSpace
TH.VarName   = NameSpace
OccName.varName

mk_mod :: TH.ModName -> ModuleName
mk_mod :: ModName -> ModuleName
mk_mod ModName
mod = String -> ModuleName
mkModuleName (ModName -> String
TH.modString ModName
mod)

mk_pkg :: TH.PkgName -> Unit
mk_pkg :: PkgName -> Unit
mk_pkg PkgName
pkg = String -> Unit
stringToUnit (PkgName -> String
TH.pkgString PkgName
pkg)

mk_uniq :: Int -> Unique
mk_uniq :: Int -> Unique
mk_uniq Int
u = Int -> Unique
mkUniqueGrimily Int
u

{-
Note [Binders in Template Haskell]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider this TH term construction:
  do { x1 <- TH.newName "x"   -- newName :: String -> Q TH.Name
     ; x2 <- TH.newName "x"   -- Builds a NameU
     ; x3 <- TH.newName "x"

     ; let x = mkName "x"     -- mkName :: String -> TH.Name
                              -- Builds a NameS

     ; return (LamE (..pattern [x1,x2]..) $
               LamE (VarPat x3) $
               ..tuple (x1,x2,x3,x)) }

It represents the term   \[x1,x2]. \x3. (x1,x2,x3,x)

a) We don't want to complain about "x" being bound twice in
   the pattern [x1,x2]
b) We don't want x3 to shadow the x1,x2
c) We *do* want 'x' (dynamically bound with mkName) to bind
   to the innermost binding of "x", namely x3.
d) When pretty printing, we want to print a unique with x1,x2
   etc, else they'll all print as "x" which isn't very helpful

When we convert all this to HsSyn, the TH.Names are converted with
thRdrName.  To achieve (b) we want the binders to be Exact RdrNames.
Achieving (a) is a bit awkward, because
   - We must check for duplicate and shadowed names on Names,
     not RdrNames, *after* renaming.
     See Note [Collect binders only after renaming] in GHC.Hs.Utils

   - But to achieve (a) we must distinguish between the Exact
     RdrNames arising from TH and the Unqual RdrNames that would
     come from a user writing \[x,x] -> blah

So in Convert.thRdrName we translate
   TH Name                          RdrName
   --------------------------------------------------------
   NameU (arising from newName) --> Exact (Name{ System })
   NameS (arising from mkName)  --> Unqual

Notice that the NameUs generate *System* Names.  Then, when
figuring out shadowing and duplicates, we can filter out
System Names.

This use of System Names fits with other uses of System Names, eg for
temporary variables "a". Since there are lots of things called "a" we
usually want to print the name with the unique, and that is indeed
the way System Names are printed.

There's a small complication of course; see Note [Looking up Exact
RdrNames] in GHC.Rename.Env.
-}

{-
Note [Pattern synonym type signatures and Template Haskell]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

In general, the type signature of a pattern synonym

  pattern P x1 x2 .. xn = <some-pattern>

is of the form

   forall univs. reqs => forall exis. provs => t1 -> t2 -> ... -> tn -> t

with the following parts:

   1) the (possibly empty lists of) universally quantified type
      variables `univs` and required constraints `reqs` on them.
   2) the (possibly empty lists of) existentially quantified type
      variables `exis` and the provided constraints `provs` on them.
   3) the types `t1`, `t2`, .., `tn` of the pattern synonym's arguments x1,
      x2, .., xn, respectively
   4) the type `t` of <some-pattern>, mentioning only universals from `univs`.

Due to the two forall quantifiers and constraint contexts (either of
which might be empty), pattern synonym type signatures are treated
specially in `GHC.HsToCore.Quote`, `GHC.ThToHs`, and
`GHC.Tc.Gen.Splice`:

   (a) When desugaring a pattern synonym from HsSyn to TH.Dec in
       `GHC.HsToCore.Quote`, we represent its *full* type signature in TH, i.e.:

           ForallT univs reqs (ForallT exis provs ty)
              (where ty is the AST representation of t1 -> t2 -> ... -> tn -> t)

   (b) When converting pattern synonyms from TH.Dec to HsSyn in
       `GHC.ThToHs`, we convert their TH type signatures back to an
       appropriate Haskell pattern synonym type of the form

         forall univs. reqs => forall exis. provs => t1 -> t2 -> ... -> tn -> t

       where initial empty `univs` type variables or an empty `reqs`
       constraint context are represented *explicitly* as `() =>`.

   (c) When reifying a pattern synonym in `GHC.Tc.Gen.Splice`, we always
       return its *full* type, i.e.:

           ForallT univs reqs (ForallT exis provs ty)
              (where ty is the AST representation of t1 -> t2 -> ... -> tn -> t)

The key point is to always represent a pattern synonym's *full* type
in cases (a) and (c) to make it clear which of the two forall
quantifiers and/or constraint contexts are specified, and which are
not. See GHC's user's guide on pattern synonyms for more information
about pattern synonym type signatures.

-}